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  25/01/13    21:15:03     12124          
  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*MOD
  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.                 IRET = NBPTS
  449.               ENDIF
  450.  
  451. *-- la 2e table ne pointe pas vers un CHPOINT, MCHAML, MMODLE ou un MAILLAGE ----
  452.             ELSE
  453.               CALL ERREUR(694)
  454.               GOTO 599
  455.             ENDIF
  456.  
  457.  
  458. C----------------------------------------------------------------------
  459. C Cas des chargements elementaires LREE1-LOBJ1
  460. C----------------------------------------------------------------------
  461.  
  462.           ELSEIF (CHATYP.EQ.'LISTOBJE') THEN
  463.  
  464. C---------- Recherche intervalle de temps contenant T1
  465.             IVALI1 = 0
  466.             IVALI2 = 1
  467.             MLREEL = IPO2
  468.             SEGACT, MLREEL
  469.             MLOBJE = IPO1
  470.             SEGACT, MLOBJE
  471.             JMA1 = PROG(/1)
  472.             DO 405 JJ = 1,JMA1
  473.               XVALR1 = PROG(IVALI1+1)
  474.               IF(JMA1.EQ.1) THEN
  475.                 XVALR2 = T1
  476.               ELSE
  477.                 XVALR2 = PROG(IVALI2+1)
  478.               ENDIF
  479.               IF(IVALI1.EQ.0) THEN
  480.                 IF (T1.LE.XVALR1) THEN
  481.                   DREL = 0.D0
  482.                   GOTO 407
  483.                 ENDIF
  484.               ENDIF
  485.               IF(IVALI2.EQ.(JMA1-1)) THEN
  486.                 IF (T1.GE.XVALR2) THEN
  487.                   DREL = 1.D0
  488.                   GOTO 407
  489.                 ENDIF
  490.               ENDIF
  491.               IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 406
  492.               IVALI1 = IVALI1 + 1
  493.               IVALI2 = IVALI2 + 1
  494.  405        CONTINUE
  495.  
  496. C---------- SP : sans doute sans objet aujourd'hui (extrapolation permise)
  497. *---------- Le temps %r1 sort de la table du %i1eme chargement
  498.             INTERR(1)=IC
  499.             REAERR(1)=T1
  500.             CALL ERREUR(342)
  501.             GOTO 599
  502.  
  503. C---------- On a trouve les piquets de temps encadrants T1
  504.  406        CONTINUE
  505.             DREL = (T1 - XVALR1)/(XVALR2 - XVALR1)
  506.  
  507.  407        CONTINUE
  508.             IOBR1  = LISOBJ(IVALI1+1)
  509.             IOBR2  = LISOBJ(IVALI2+1)
  510.             MTYP1  = TYPOBJ
  511.  
  512. C---------- Cas du CHPOINT :
  513.             IF (MTYP1.EQ.'CHPOINT ') THEN
  514.               CALL ECROBJ('CHPOINT ',IOBR1)
  515.               CALL ECROBJ('CHPOINT ',IOBR2)
  516.               CALL ECRREE(1.D0 - DREL)
  517.               CALL ECRREE(DREL)
  518.               CALL COLI
  519.               CALL LIROBJ('CHPOINT ',IRET,1,IRETOU)
  520.               IF (IRETOU.EQ.0) GOTO 599
  521. C------------- calcul du deplacement eventuel du champ ----------
  522.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  523.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  524.                 MTYPR = CHAMOB(IC)
  525.                 IPOENT = IRET
  526.                 CHATY2 = MTYP1
  527.                 IPOENU = ICHPO4
  528.                 IPOENV = ICHPO5
  529.                 IPOENW = ICHPO6
  530.                 IPOENX = ICHPO7
  531.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  532.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  533.                 IF (IERR.NE.0) RETURN
  534.                 IRET = IPOSOR
  535.               ENDIF
  536.               CHARIN = CHANOM(IC)
  537.               TAPOBJ = 'CHPOINT '
  538.               IOBRE = IRET
  539.               TAPIND = 'MOT     '
  540.               CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN,
  541.      $             LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  542.  
  543. C------------- Cas du MCHAML :
  544.             ELSEIF (MTYP1.EQ.'MCHAML  ') THEN
  545.               IF (CHANOM(IC).EQ.'MATE') THEN
  546.                 IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  547.                   IRET = IOBR2
  548.                 ELSE
  549.                   IRET = IOBR1
  550.                 ENDIF
  551.               ELSE
  552.                 CALL ECROBJ('MCHAML  ',IOBR1)
  553.                 CALL ECROBJ('MCHAML',IOBR2)
  554.                 CALL ECRREE(1.D0 - DREL)
  555.                 CALL ECRREE(DREL)
  556.                 CALL COLI
  557.                 CALL LIROBJ('MCHAML  ',IRET,1,IRETOU)
  558.                 IF (IRETOU.EQ.0) GOTO 599
  559. C------------- calcul du deplacement eventuel du champ ----------
  560.                 IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  561.      &              CHAMOB(IC).EQ.'TRAJ') THEN
  562.                   MTYPR = CHAMOB(IC)
  563.                   IPOENT = IRET
  564.                   CHATY2 = MTYP1
  565.                   IPOENU = ICHPO4
  566.                   IPOENV = ICHPO5
  567.                   IPOENW = ICHPO6
  568.                   IPOENX = ICHPO7
  569.                   CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  570.      $                 IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  571.                   IF (IERR.NE.0) RETURN
  572.                   IRET = IPOSOR
  573.                 ENDIF
  574.               ENDIF
  575.               CHARIN = CHANOM(IC)
  576.               TAPOBJ = 'MCHAML  '
  577.               IOBRE = IRET
  578.               TAPIND = 'MOT     '
  579.               CALL ECCTAB(ITA1,TAPIND,IVALIN,XVALIN,CHARIN,
  580.      $             LOGIN,IOBIN,TAPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  581.  
  582. C------------- Cas du MODELE :
  583.             ELSEIF (MTYP1.EQ.'MMODEL  ') THEN
  584.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  585.                 IRET = IOBR2
  586.               ELSE
  587.                 IRET = IOBR1
  588.               ENDIF
  589.  
  590. C------------- Cas du MAILLAGE :
  591.             ELSEIF (MTYP1.EQ.'MAILLAGE') THEN
  592.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  593.                 IRET = IOBR2
  594.               ELSE
  595.                 IRET = IOBR1
  596.               ENDIF
  597.  
  598. C------------- Cas de la RIGIDITE :
  599.             ELSEIF (MTYP1.EQ.'RIGIDITE') THEN
  600.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  601.                 IRET = IOBR2
  602.               ELSE
  603.                 IRET = IOBR1
  604.               ENDIF
  605.  
  606. C------------- Cas du POINT :
  607.             ELSEIF (MTYP1.EQ.'POINT   ') THEN
  608.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  609.                 IRET = IOBR2
  610.               ELSE IF (ABS(DREL-0.D0).LE.XZPREC) THEN
  611.                 IRET = IOBR1
  612.               ELSE
  613.                 SEGACT,MCOORD*MOD
  614. C     write(6,*) 'IOBR1, IOBR2,DREL=',IOBR1,IOBR2,DREL
  615.                 NBPTS = NBPTS+1
  616.                 SEGADJ,MCOORD
  617.                 IDIMP1 = IDIM + 1
  618.                 XP1 = XCOOR((IOBR1-1)*IDIMP1+1)
  619.                 YP1 = XCOOR((IOBR1-1)*IDIMP1+2)
  620.                 ZP1 = XCOOR((IOBR1-1)*IDIMP1+3)
  621.                 XP2 = XCOOR((IOBR2-1)*IDIMP1+1)
  622.                 YP2 = XCOOR((IOBR2-1)*IDIMP1+2)
  623.                 ZP2 = XCOOR((IOBR2-1)*IDIMP1+3)
  624.                 XCOOR((NBPTS-1)*IDIMP1+1) = DREL*XP2+(1.D0-DREL)*XP1
  625.                 XCOOR((NBPTS-1)*IDIMP1+2) = DREL*YP2+(1.D0-DREL)*YP1
  626.                 XCOOR((NBPTS-1)*IDIMP1+3) = DREL*ZP2+(1.D0-DREL)*ZP1
  627.                 SEGDES,MCOORD
  628.                 IRET = NBPTS
  629.               ENDIF
  630.  
  631. C--------- le LISTOBJE ne contient pas de CHPOINT, MCHAML, MMODLE ou MAILLAGE
  632.             ELSE
  633.               CALL ERREUR(694)
  634.               GOTO 599
  635.             ENDIF
  636.  
  637.           ELSE
  638. C-------- Pas de type connu trouve
  639.             CALL ERREUR(695)
  640.             GOTO 599
  641.           ENDIF
  642.  501    CONTINUE
  643.         CALL ECROBJ('TABLE   ',ITA1)
  644.         RETURN
  645.  598    IF(IC.NE.0) THEN
  646.           DO 555 J = 1, IC
  647.             IRETT = MTABIV(J)
  648.             CALL DTCHPO(IRETT)
  649.  555      CONTINUE
  650.         ENDIF
  651.  599    CONTINUE
  652.         SEGSUP MTABLE
  653.         RETURN
  654.  
  655.  
  656.  
  657.       ELSE
  658.  
  659. *-----------------------------------------------------------------------
  660. *- cas ou on veut instancier un seul chargement elementaire de nom MOT -
  661. *-------------------------------------------------------------------------
  662. * cas ou on veut instancier tout le chargement et le ranger dans un seul champ
  663. *-------------------------------------------------------------------------
  664.  
  665.         ISU = 0
  666.  
  667. *-------------- boucle sur les chargements élémentaires ---------------
  668.  
  669.         DO 502 IC = 1, NCHAR
  670.  
  671.           IF (MOT1.NE.'    ') THEN
  672.             IF (mcharg.CHANOM(IC).NE.MOT1) GOTO 502
  673.           ENDIF
  674.  
  675. *--------- on ne considère que les objets de sous type force -----------
  676.  
  677.           IF(CHANAT(IC).EQ.'DEPLACEM') THEN
  678.             MOTERR(1:8)='CHARGEME'
  679.             MOTERR(9:16)='DEPLACEM'
  680.             CALL ERREUR(131)
  681.             GOTO 690
  682.           ENDIF
  683.  
  684.           ICHARG=KCHARG(IC)
  685. C          SEGACT ICHARG
  686.           IPO1 = ICHPO1
  687.           IPO2 = ICHPO2
  688.  
  689. *--- cas des chargements elementaires CHPOINT (ou MCHAML) + EVOL -------
  690.  
  691.           IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML  ')) THEN
  692. C           Cas particulier du chargement constant : on retourne le champ
  693. C           sans aucune interpolation
  694.             IF (ICHPO2.EQ.0) THEN
  695.               IRET=ICHPO1
  696.               TAPOBJ=CHATYP
  697. C           Cas general : interpolation dans l'evolution
  698.             ELSE
  699.               MLREEL=ICHPO2
  700.               SEGACT MLREEL
  701.               NF=PROG(/1)
  702.  
  703. *------- Le temps %r1 sort de la table du %i1ème chargement -------------
  704.  
  705. C SP : on s'autorise a sortir de l'intervale de definition de l'evolution.
  706. C      L'interpolation de l'amplitude est geree par INTER1.
  707. C              T2 = T1 + ABS(T1*0.000001D0)
  708. C              T3 = T1 - ABS(T1*0.000001D0)
  709. C              IF(PROG(1).GT.T2.OR.PROG(NF).LT.T3) THEN
  710. C                 INTERR(1)=IC
  711. C                 REAERR(1)=T1
  712. C                 CALL ERREUR(342)
  713. C                 GOTO 690
  714. C              ENDIF
  715.  
  716. C------------- calcul du deplacement eventuel du champ ----------
  717.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  718.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  719.                 MTYPR = CHAMOB(IC)
  720.                 IPOENT = IPO1
  721.                 CHATY2 = CHATYP
  722.                 IPOENU = ICHPO4
  723.                 IPOENV = ICHPO5
  724.                 IPOENW = ICHPO6
  725.                 IPOENX = ICHPO7
  726.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  727.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  728.                 IF(IERR.NE.0) RETURN
  729.                 IPO1 = IPOSOR
  730.               ENDIF
  731.  
  732. C----- interpole la valeur de l'evolution FT1 au temps T1
  733.               ICHATX=ICHPO2
  734.               ICHAFX=ICHPO3
  735.               CALL INTER1(ICHATX,ICHAFX,T1,FT1)
  736. C
  737. C----- Cas du chargement de nom TRAJ :
  738.               IF (CHANOM(IC).EQ.'TRAJ') THEN
  739.                 IF (MOT1.EQ.'TRAJ'.OR.NCHAR.EQ.1) THEN
  740. C     write(6,*) 'TIRE : chargement de nom TRAJ' 
  741.                   CALL IPLCUR(IPO1,FT1,IPOIN1)
  742.                   IF (IERR.NE.0) RETURN
  743.                   CALL ECROBJ('POINT   ',IPOIN1)
  744.                   RETURN
  745.                 ELSE
  746. C               Si d'autres chargements : incompatible
  747.                   CALL ERREUR(695)
  748.                   GOTO 690
  749.                 ENDIF
  750.               ENDIF
  751.  
  752. C----- Autres cas : realise la multiplication du CHPOINT ou du MCHAML -----------
  753.               IOPERA = 2
  754.               IARGU  = 2
  755.               I11    = 0
  756.               IRET   = 0
  757.               IF(CHATYP.EQ.'CHPOINT ') THEN
  758.                 CALL ACTOBJ('CHPOINT ',IPO1,1)
  759.                 CALL OPCHP1(IPO1,IOPERA,IARGU,I11,FT1,IRET,IRETOU)
  760.                 IF(IRETOU .EQ. 0)THEN
  761.                   CALL ERREUR(26)
  762.                   RETURN
  763.                 ENDIF
  764.               ELSE
  765.                 CALL ACTOBJ('MCHAML  ',IPO1,1)
  766.                 CALL OPCHE1(IPO1,IOPERA,IARGU,I11,FT1,IRET,IRETOU)
  767.                 IF(IRETOU .EQ. 0)THEN
  768.                   CALL ERREUR(26)
  769.                   RETURN
  770.                 ENDIF
  771.               ENDIF
  772.             ENDIF
  773.  
  774.             IF(IRET.EQ.0) GOTO 690
  775.             IF(ISU.EQ.0) THEN
  776.               IRETT = IRET
  777.               ISU = 1
  778.               CHATY2 = CHATYP
  779.             ELSE
  780.  
  781. *------------- Chargements elementaires incompatibles ---------------
  782.  
  783.               IF(CHATYP.NE.CHATY2) THEN
  784.                 CALL ERREUR(695)
  785.                 GOTO 690
  786.               ELSE
  787.                 IF(CHATYP.EQ.'CHPOINT ') THEN
  788.                   CALL FUCHPO(IRETT,IRET,IRETOU)
  789. C                 CALL DTCHPO(IRET)
  790.                   IF(IRETOU.EQ.0) THEN
  791.                     IF(IRETT.NE.0) THEN
  792.                       CALL DTCHPO(IRETT)
  793.                     ENDIF
  794.                     GOTO 690
  795.                   ENDIF
  796. C                 CALL DTCHPO(IRETT)
  797.                   IRETT=IRETOU
  798.                 ELSEIF (CHATYP.EQ.'MCHAML  ') THEN
  799.                   CALL ADCHEL(IRETT,IRET,IRETOU,1)
  800.                   IF (IERR.NE.0) RETURN
  801.                   IRETT=IRETOU
  802.                 ENDIF
  803.                 CHATY2 = CHATYP
  804.               ENDIF
  805.             ENDIF
  806.  
  807. C----------------------------------------------------------------------
  808. C Cas du chargement elementaire TABLE1-TABLE2
  809. C----------------------------------------------------------------------
  810.  
  811.           ELSEIF (CHATYP.EQ.'TABLE   ') THEN
  812.             IVALI1 = 0
  813.             IVALI2 = 1
  814.             mtab1=ipo1
  815.             segact mtab1
  816.             jma1=mtab1.mlotab
  817.             DO 605 JJ = 1,JMA1
  818.               TAPOB1 =MTAB1. MTABTV(IVALI1+1)
  819.               TAPOB2 =MTAB1. MTABTV(IVALI2+1)
  820.               XVALR1=MTAB1.RMTABV(IVALI1+1)
  821.               IF (JMA1.EQ.1) THEN
  822.                 XVALR2 = T1
  823.               ELSE
  824.                 XVALR2=MTAB1.RMTABV(IVALI2+1)
  825.               ENDIF
  826.               IF (IVALI1.EQ.0) THEN
  827.                 IF (T1.LE.XVALR1) THEN
  828.                   DREL = 0.D0
  829.                   GOTO 607
  830.                 ENDIF
  831.               ENDIF
  832.               IF (IVALI2.EQ.(JMA1-1)) THEN
  833.                 IF (T1.GE.XVALR2) THEN
  834.                   DREL = 1.D0
  835.                   GOTO 607
  836.                 ENDIF
  837.               ENDIF
  838.               IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 606
  839.  6059         CONTINUE
  840.               IVALI1 = IVALI1 + 1
  841.               IVALI2 = IVALI2 + 1
  842.  605        CONTINUE
  843.  
  844. *------- Le temps %r1 sort de la table du %i1ème chargement -------------
  845.  
  846.             INTERR(1)=IC
  847.             REAERR(1)=T1
  848.             CALL ERREUR(342)
  849.             GOTO 690
  850.  
  851.  606        CONTINUE
  852.  
  853. *---------- la premiere table ne pointe pas vers des reels ----------
  854.  
  855.             IF((TAPOB1.NE.TAPOB2).OR.(TAPOB1.NE.'FLOTTANT')) THEN
  856.               CALL ERREUR(692)
  857.               GOTO 690
  858.             ENDIF
  859.             DREL = (T1 - XVALR1)/(XVALR2 - XVALR1)
  860.  607        CONTINUE
  861.             SEGDES MTAB1
  862.             MTAB2=IPO2
  863.             SEGACT MTAB2
  864.             TAPOB1 =MTAB2. MTABTV(IVALI1+1)
  865.             TAPOB2 =MTAB2.  MTABTV(IVALI2+1)
  866.             IOBR1 = MTAB2. MTABIV(IVALI1+1)
  867.             IF (JMA1.EQ.1) THEN
  868.               IRET = IOBR1
  869.               GOTO 668
  870.             ENDIF
  871.             IOBR2=MTAB2. MTABIV(IVALI2+1)
  872.             SEGDES MTAB2
  873.  
  874. *------ la deuxieme table ne pointe pas vers de champs de meme type ----
  875.  
  876.             IF(TAPOB1.NE.TAPOB2) THEN
  877.              write(6,*) ' ivali1 ' , ivali1 , ' ivali2 ' , ivali2
  878.              write(6,*) ' tapob1 ' , tapob1,' tapob2 ',tapob2
  879.               CALL ERREUR(693)
  880.               GOTO 690
  881.             ENDIF
  882.  
  883.             IF(TAPOB1.EQ.'CHPOINT ') THEN
  884.               CALL ECROBJ('CHPOINT ',IOBR1)
  885.               CALL ECROBJ('CHPOINT ',IOBR2)
  886.               CALL ECRREE(1.D0 - DREL)
  887.               CALL ECRREE(DREL)
  888.               CALL COLI
  889.               CALL LIROBJ('CHPOINT ',IRET,1,IRETOU)
  890.               IF(IRETOU.EQ.0) GOTO 690
  891. C------------- calcul du deplacement eventuel du champ ----------
  892.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  893.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  894.                 MTYPR = CHAMOB(IC)
  895.                 IPOENT = IRET
  896.                 CHATY2 = TAPOB1
  897.                 IPOENU = ICHPO4
  898.                 IPOENV = ICHPO5
  899.                 IPOENW = ICHPO6
  900.                 IPOENX = ICHPO7
  901.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  902.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  903.                 IF(IERR.NE.0) RETURN
  904.                 IRET = IPOSOR
  905.               ENDIF
  906.  
  907.             ELSEIF (TAPOB1.EQ.'MCHAML  ') THEN
  908.               IF (CHANOM(IC).EQ.'MATE') THEN
  909.                 IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  910.                   IRET = IOBR2
  911.                 ELSE
  912.                   IRET = IOBR1
  913.                 ENDIF
  914.               ELSE
  915.                 CALL ECROBJ('MCHAML  ',IOBR1)
  916.                 CALL ECROBJ('MCHAML  ',IOBR2)
  917.                 CALL ECRREE(1.D0 - DREL)
  918.                 CALL ECRREE(DREL)
  919.                 CALL COLI
  920.                 CALL LIROBJ('MCHAML  ',IRET,1,IRETOU)
  921.                 IF(IRETOU.EQ.0) GOTO 690
  922. C------------- calcul du deplacement eventuel du champ ----------
  923.                 IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  924.      &              CHAMOB(IC).EQ.'TRAJ') THEN
  925.                   MTYPR = CHAMOB(IC)
  926.                   IPOENT = IRET
  927.                   CHATY2 = TAPOB1
  928.                   IPOENU = ICHPO4
  929.                   IPOENV = ICHPO5
  930.                   IPOENW = ICHPO6
  931.                   IPOENX = ICHPO7
  932.                   CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  933.      $                 IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  934.                   IF(IERR.NE.0) RETURN
  935.                   IRET = IPOSOR
  936.                 ENDIF
  937.               ENDIF
  938.  
  939. C------------- Cas du MODELE :
  940.             ELSEIF (TAPOB1.EQ.'MMODEL  ') THEN
  941.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  942.                 IRET = IOBR2
  943.               ELSE
  944.                 IRET = IOBR1
  945.               ENDIF
  946.  
  947. C------------- Cas du MAILLAGE :
  948.             ELSEIF (TAPOB1.EQ.'MAILLAGE') THEN
  949.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  950.                 IRET = IOBR2
  951.               ELSE
  952.                 IRET = IOBR1
  953.               ENDIF
  954.  
  955. C------------- Cas de la RIGIDITE :
  956.             ELSEIF (TAPOB1.EQ.'RIGIDITE') THEN
  957.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  958.                 IRET = IOBR2
  959.               ELSE
  960.                 IRET = IOBR1
  961.               ENDIF
  962.  
  963. C------------ Cas du POINT :
  964.             ELSEIF (TAPOB1.EQ.'POINT   ') THEN
  965.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  966.                 IRET = IOBR2
  967.               ELSE IF (ABS(DREL-0.D0).LE.XZPREC) THEN
  968.                 IRET = IOBR1
  969.               ELSE
  970.                 SEGACT,MCOORD*MOD
  971. C     write(6,*) 'IOBR1, IOBR2,DREL=',IOBR1,IOBR2,DREL
  972.                 NBPTS = NBPTS+1
  973.                 SEGADJ,MCOORD
  974.                 IDIMP1 = IDIM + 1
  975.                 XP1 = XCOOR((IOBR1-1)*IDIMP1+1)
  976.                 YP1 = XCOOR((IOBR1-1)*IDIMP1+2)
  977.                 ZP1 = XCOOR((IOBR1-1)*IDIMP1+3)
  978.                 XP2 = XCOOR((IOBR2-1)*IDIMP1+1)
  979.                 YP2 = XCOOR((IOBR2-1)*IDIMP1+2)
  980.                 ZP2 = XCOOR((IOBR2-1)*IDIMP1+3)
  981.                 XCOOR((NBPTS-1)*IDIMP1+1) = DREL*XP2+(1.D0-DREL)*XP1
  982.                 XCOOR((NBPTS-1)*IDIMP1+2) = DREL*YP2+(1.D0-DREL)*YP1
  983.                 XCOOR((NBPTS-1)*IDIMP1+3) = DREL*ZP2+(1.D0-DREL)*ZP1
  984.                 SEGDES,MCOORD
  985.                 IRET = NBPTS
  986.               ENDIF
  987. *-- la 2e table ne pointe pas vers un CHPOINT, MCHAML, MMODLE ou un MAILLAGE ----
  988.             ELSE
  989.               CALL ERREUR(694)
  990.               GOTO 690
  991.             ENDIF
  992.  
  993.  668        CONTINUE
  994.             IF (ISU.EQ.0) THEN
  995.               IRETT = IRET
  996.               ISU = 1
  997.               CHATY2 = TAPOB1
  998.             ELSE
  999.  
  1000. *------------- Chargements elementaires incompatibles ---------------
  1001.  
  1002.               IF(TAPOB1.NE.CHATY2) THEN
  1003.                 CALL ERREUR(695)
  1004.                 GOTO 690
  1005.               ELSE
  1006.                 IF(TAPOB1.EQ.'CHPOINT ') THEN
  1007.                   CALL FUCHPO(IRETT,IRET,IRETOU)
  1008. C                 CALL DTCHPO(IRET)
  1009.                   IF(IRETOU.EQ.0) THEN
  1010.                     IF(IRETT.NE.0) THEN
  1011.                       CALL DTCHPO(IRETT)
  1012.                     ENDIF
  1013.                     GOTO 690
  1014.                   ENDIF
  1015. C                 CALL DTCHPO(IRETT)
  1016.                   IRETT=IRETOU
  1017.                 ELSEIF (TAPOB1.EQ.'MCHAML  ') THEN
  1018.                   CALL ADCHEL(IRETT,IRET,IRETOU,1)
  1019.                   IF (IERR.NE.0) RETURN
  1020.                   IRETT=IRETOU
  1021.                 ELSEIF (TAPOB1.EQ.'MMODEL  ') THEN
  1022.                   CALL FUSMOD(IRETT,IRET,IRETOU)
  1023.                   IF (IERR.NE.0) RETURN
  1024.                   IRETT=IRETOU
  1025.                 ELSEIF (TAPOB1.EQ.'MAILLAGE  ') THEN
  1026.                   CALL FUSE(IRETT,IRET,IRETOU,.false.)
  1027.                   IF (IERR.NE.0) RETURN
  1028.                   IRETT=IRETOU
  1029.                 ELSEIF (TAPOB1.EQ.'RIGIDITE') THEN
  1030.                   CALL FUSRIG(IRETT,IRET,IRETOU)
  1031.                   IF (IERR.NE.0) RETURN
  1032.                   IRETT=IRETOU
  1033.                 ENDIF
  1034.                 CHATY2 = TAPOB1
  1035.               ENDIF
  1036.             ENDIF
  1037.  
  1038. C----------------------------------------------------------------------
  1039. C Cas des chargements elementaires LREE1-LOBJ1
  1040. C----------------------------------------------------------------------
  1041.  
  1042.           ELSEIF (CHATYP.EQ.'LISTOBJE') THEN
  1043.  
  1044. C---------- Recherche intervalle de temps contenant T1
  1045.             IVALI1 = 0
  1046.             IVALI2 = 1
  1047.             MLREEL = IPO2
  1048.             SEGACT, MLREEL
  1049.             MLOBJE = IPO1
  1050.             SEGACT, MLOBJE
  1051.             JMA1 = PROG(/1)
  1052.             DO 305 JJ = 1,JMA1
  1053.               XVALR1 = PROG(IVALI1+1)
  1054.               IF(JMA1.EQ.1) THEN
  1055.                 XVALR2 = T1
  1056.               ELSE
  1057.                 XVALR2 = PROG(IVALI2+1)
  1058.               ENDIF
  1059.               IF(IVALI1.EQ.0) THEN
  1060.                 IF (T1.LE.XVALR1) THEN
  1061.                   DREL = 0.D0
  1062.                   GOTO 307
  1063.                 ENDIF
  1064.               ENDIF
  1065.               IF(IVALI2.EQ.(JMA1-1)) THEN
  1066.                 IF (T1.GE.XVALR2) THEN
  1067.                   DREL = 1.D0
  1068.                   GOTO 307
  1069.                 ENDIF
  1070.               ENDIF
  1071.               IF((XVALR1.LE.T1).AND.(T1.LE.XVALR2)) GOTO 306
  1072.               IVALI1 = IVALI1 + 1
  1073.               IVALI2 = IVALI2 + 1
  1074.  305        CONTINUE
  1075.  
  1076. C---------- SP : sans doute sans objet aujourd'hui (extrapolation permise)
  1077. *---------- Le temps %r1 sort de la table du %i1eme chargement
  1078.             INTERR(1)=IC
  1079.             REAERR(1)=T1
  1080.             CALL ERREUR(342)
  1081.             GOTO 690
  1082.  
  1083. C---------- On a trouve les piquets de temps encadrants T1
  1084.  306        CONTINUE
  1085.             DREL = (T1 - XVALR1)/(XVALR2 - XVALR1)
  1086.  
  1087. C---------- Interpolation du chargement a T1
  1088.  307        CONTINUE
  1089.             IOBR1  = LISOBJ(IVALI1+1)
  1090.             IF (JMA1.EQ.1) THEN
  1091.               IRET = IOBR1
  1092.               GOTO 669
  1093.             ENDIF
  1094.             IOBR2  = LISOBJ(IVALI2+1)
  1095.             MTYP1  = TYPOBJ
  1096.  
  1097. C---------- Cas du CHPOINT :
  1098.             IF (MTYP1.EQ.'CHPOINT ') THEN
  1099.               CALL ECROBJ('CHPOINT ',IOBR1)
  1100.               CALL ECROBJ('CHPOINT ',IOBR2)
  1101.               CALL ECRREE(1.D0 - DREL)
  1102.               CALL ECRREE(DREL)
  1103.               CALL COLI
  1104.               CALL LIROBJ('CHPOINT ',IRET,1,IRETOU)
  1105.               IF (IRETOU.EQ.0) GOTO 690
  1106. C------------- calcul du deplacement eventuel du champ ----------
  1107.               IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  1108.      &            CHAMOB(IC).EQ.'TRAJ') THEN
  1109.                 MTYPR = CHAMOB(IC)
  1110.                 IPOENT = IRET
  1111.                 CHATY2 = MTYP1
  1112.                 IPOENU = ICHPO4
  1113.                 IPOENV = ICHPO5
  1114.                 IPOENW = ICHPO6
  1115.                 IPOENX = ICHPO7
  1116.                 CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  1117.      $               IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  1118.                 IF (IERR.NE.0) RETURN
  1119.                 IRET = IPOSOR
  1120.               ENDIF
  1121.  
  1122. C------------- Cas du MCHAML :
  1123.             ELSEIF (MTYP1.EQ.'MCHAML  ') THEN
  1124.               IF (CHANOM(IC).EQ.'MATE') THEN
  1125.                 IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1126.                   IRET = IOBR2
  1127.                 ELSE
  1128.                   IRET = IOBR1
  1129.                 ENDIF
  1130.               ELSE
  1131.                 CALL ECROBJ('MCHAML  ',IOBR1)
  1132.                 CALL ECROBJ('MCHAML',IOBR2)
  1133.                 CALL ECRREE(1.D0 - DREL)
  1134.                 CALL ECRREE(DREL)
  1135.                 CALL COLI
  1136.                 CALL LIROBJ('MCHAML  ',IRET,1,IRETOU)
  1137.                 IF (IRETOU.EQ.0) GOTO 690
  1138. C------------- calcul du deplacement eventuel du champ ----------
  1139.                 IF (CHAMOB(IC).EQ.'TRAN'.OR.CHAMOB(IC).EQ.'ROTA'.OR.
  1140.      &              CHAMOB(IC).EQ.'TRAJ') THEN
  1141.                   MTYPR = CHAMOB(IC)
  1142.                   IPOENT = IRET
  1143.                   CHATY2 = MTYP1
  1144.                   IPOENU = ICHPO4
  1145.                   IPOENV = ICHPO5
  1146.                   IPOENW = ICHPO6
  1147.                   IPOENX = ICHPO7
  1148.                   CALL TIDEP1(T1,IPOENT,CHATY2,MTYPR,
  1149.      $                 IPOENU,IPOENV,IPOENW,IPOENX,IPOSOR)
  1150.                   IF (IERR.NE.0) RETURN
  1151.                   IRET = IPOSOR
  1152.                 ENDIF
  1153.               ENDIF
  1154.  
  1155. C------------- Cas du MODELE :
  1156.             ELSEIF (MTYP1.EQ.'MMODEL  ') THEN
  1157.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1158.                 IRET = IOBR2
  1159.               ELSE
  1160.                 IRET = IOBR1
  1161.               ENDIF
  1162.  
  1163. C------------- Cas du MAILLAGE :
  1164.             ELSEIF (MTYP1.EQ.'MAILLAGE') THEN
  1165.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1166.                 IRET = IOBR2
  1167.               ELSE
  1168.                 IRET = IOBR1
  1169.               ENDIF
  1170.  
  1171. C------------- Cas de la RIGIDITE :
  1172.             ELSEIF (MTYP1.EQ.'RIGIDITE') THEN
  1173.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1174.                 IRET = IOBR2
  1175.               ELSE
  1176.                 IRET = IOBR1
  1177.               ENDIF
  1178.  
  1179. C------------- Cas du POINT :
  1180.             ELSEIF (MTYP1.EQ.'POINT   ') THEN
  1181.               IF (ABS(DREL-1.D0).LE.XZPREC) THEN
  1182.                 IRET = IOBR2
  1183.               ELSE IF (ABS(DREL-0.D0).LE.XZPREC) THEN
  1184.                 IRET = IOBR1
  1185.               ELSE
  1186.                 SEGACT,MCOORD*MOD
  1187. C     write(6,*) 'NBPTS,IOBR1, IOBR2,DREL=',NBPTS,IOBR1,IOBR2,DREL
  1188.                 NBPTS = NBPTS+1
  1189.                 SEGADJ,MCOORD
  1190.                 IDIMP1 = IDIM + 1
  1191.                 XP1 = XCOOR((IOBR1-1)*IDIMP1+1)
  1192.                 YP1 = XCOOR((IOBR1-1)*IDIMP1+2)
  1193.                 ZP1 = XCOOR((IOBR1-1)*IDIMP1+3)
  1194.                 XP2 = XCOOR((IOBR2-1)*IDIMP1+1)
  1195.                 YP2 = XCOOR((IOBR2-1)*IDIMP1+2)
  1196.                 ZP2 = XCOOR((IOBR2-1)*IDIMP1+3)
  1197.                 XCOOR((NBPTS-1)*IDIMP1+1) = DREL*XP2+(1.D0-DREL)*XP1
  1198.                 XCOOR((NBPTS-1)*IDIMP1+2) = DREL*YP2+(1.D0-DREL)*YP1
  1199.                 XCOOR((NBPTS-1)*IDIMP1+3) = DREL*ZP2+(1.D0-DREL)*ZP1
  1200.                 SEGDES,MCOORD
  1201.                 IRET = NBPTS
  1202.               ENDIF
  1203.  
  1204. C--------- le LISTOBJE ne contient pas de CHPOINT, MCHAML, MMODLE ou MAILLAGE
  1205.             ELSE
  1206.               CALL ERREUR(694)
  1207.               GOTO 690
  1208.             ENDIF
  1209.  
  1210.  669        CONTINUE
  1211.             IF (ISU.EQ.0) THEN
  1212.               IRETT = IRET
  1213.               ISU = 1
  1214.               CHATY2 = MTYP1
  1215.             ELSE
  1216.  
  1217. *------------- Chargements elementaires incompatibles ---------------
  1218.  
  1219.               IF(MTYP1.NE.CHATY2) THEN
  1220.                 CALL ERREUR(695)
  1221.                 GOTO 690
  1222.               ELSE
  1223.                 IF(MTYP1.EQ.'CHPOINT ') THEN
  1224.                   CALL FUCHPO(IRETT,IRET,IRETOU)
  1225.                   IF(IRETOU.EQ.0) THEN
  1226.                     IF(IRETT.NE.0) THEN
  1227.                       CALL DTCHPO(IRETT)
  1228.                     ENDIF
  1229.                     GOTO 690
  1230.                   ENDIF
  1231. C                 CALL DTCHPO(IRETT)
  1232.                   IRETT=IRETOU
  1233.                 ELSEIF (MTYP1.EQ.'MCHAML  ') THEN
  1234.                   CALL ADCHEL(IRETT,IRET,IRETOU,1)
  1235.                   IF (IERR.NE.0) RETURN
  1236.                   IRETT=IRETOU
  1237.                 ELSEIF (MTYP1.EQ.'MMODEL  ') THEN
  1238.                   CALL FUSMOD(IRETT,IRET,IRETOU)
  1239.                   IF (IERR.NE.0) RETURN
  1240.                   IRETT=IRETOU
  1241.                 ELSEIF (MTYP1.EQ.'MAILLAGE  ') THEN
  1242.                   CALL FUSE(IRETT,IRET,IRETOU,.false.)
  1243.                   IF (IERR.NE.0) RETURN
  1244.                   IRETT=IRETOU
  1245.                 ELSEIF (MTYP1.EQ.'RIGIDITE') THEN
  1246.                   CALL FUSRIG(IRETT,IRET,IRETOU)
  1247.                   IF (IERR.NE.0) RETURN
  1248.                   IRETT=IRETOU
  1249.                 ENDIF
  1250.                 CHATY2 = MTYP1
  1251.               ENDIF
  1252.             ENDIF
  1253.  
  1254.           ELSE
  1255. C---------- Fin ELSEIF sur CHATYP : pas de type connu trouve
  1256.             CALL ERREUR(695)
  1257.             GOTO 690
  1258.           ENDIF
  1259.  
  1260.  502    CONTINUE
  1261.  
  1262.         IF(IRETT.EQ.0) THEN
  1263.           IF (MOT1.NE.'    ') THEN
  1264.             MOTERR(1:4) = MOT1
  1265.             CALL ERREUR(685)
  1266.           ELSE
  1267.             CALL ERREUR(696)
  1268.           ENDIF
  1269.           RETURN
  1270.         ENDIF
  1271.  
  1272.         IF (CHATY2.EQ.'CHPOINT ') THEN
  1273.           CALL ACTOBJ('CHPOINT ',IRETT,1)
  1274.           CALL ECROBJ('CHPOINT ',IRETT)
  1275.         ELSEIF (CHATY2.EQ.'MCHAML  ') THEN
  1276.           CALL ACTOBJ('MCHAML  ',IRETT,1)
  1277.           CALL ECROBJ('MCHAML  ',IRETT)
  1278.         ELSEIF (CHATY2.EQ.'MMODEL  ') THEN
  1279.           CALL ACTOBJ('MMODEL  ',IRETT,1)
  1280.           CALL ECROBJ('MMODEL  ',IRETT)
  1281.         ELSEIF (CHATY2.EQ.'MAILLAGE') THEN
  1282.           CALL ACTOBJ('MAILLAGE',IRETT,1)
  1283.           CALL ECROBJ('MAILLAGE',IRETT)
  1284.         ELSEIF (CHATY2.EQ.'RIGIDITE') THEN
  1285.           CALL ACTOBJ('RIGIDITE',IRETT,1)
  1286.           CALL ECROBJ('RIGIDITE',IRETT)
  1287.         ELSEIF (CHATY2.EQ.'POINT   ') THEN
  1288.           CALL ECROBJ('POINT   ',IRETT)
  1289.         ELSE
  1290.           CALL ERREUR(694)
  1291.         ENDIF
  1292.         RETURN
  1293.  690    CONTINUE
  1294.         RETURN
  1295.       ENDIF
  1296.  
  1297.  
  1298. C----------------------------
  1299. C  CAS DE L'OBJET SOLUTION
  1300. C-----------------------------
  1301.  
  1302.  200  CONTINUE
  1303.       ISOLIT=0
  1304.       CALL LIRCHA(MCHA,0,IRETOU)
  1305.       IF(IRETOU.EQ.0) GO TO 300
  1306. C
  1307.       CALL LIROBJ('SOLUTION ',KSOLU,1,IRETOU)
  1308.       IF(IERR.NE.0) GOTO 5000
  1309.       MSOLUT=KSOLU
  1310. C
  1311. C *** ON VA CHERCHER LE CHAMP DE TYPE MCHA  DANS LE MSOLUT
  1312.       SEGACT MSOLUT
  1313. C
  1314. C *** LECTURE DE FN,MN,QX,QY OU QZ ?
  1315.       CALL PLACE(MOFREQ,LFREQ,IPLAC,MCHA)
  1316.       IF(IPLAC.NE.0) THEN
  1317.          ICHA=4
  1318.          GOTO 50
  1319.       ENDIF
  1320. C *** OPTION GRAND DEPLACEMENT ?
  1321.       CALL PLACE (MOGDEP,LGDEP,IGDEP,MCHA)
  1322.       IF(IGDEP .NE. 0) THEN
  1323.          ICHA = 10 + IGDEP
  1324.          GOTO 50
  1325.       ENDIF
  1326. C *** LECTURE DES DEPLACEMENTS,DES CONTRAINTES ...
  1327.       MOTERR(1:8)=ITYSOL
  1328.       CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT)
  1329.       IF(ICHA.EQ.0) THEN
  1330.          MOTERR(1:8)='SOLUTION'
  1331.          MOTERR(9:26)=ITYSOL
  1332.          MOTERR(30:38)=MCHA
  1333.          CALL ERREUR(235)
  1334. C        ERREUR DANS LE TYPE DE CHAMP
  1335.          GOTO 5000
  1336.       ENDIF
  1337. C                  TYPE = VITE   +  ROBO
  1338. C
  1339.       IF(ICHA.EQ.8) THEN
  1340.          CALL LIRMOT ( MOROBO,1,IROBO,0 )
  1341.          IF( IROBO.NE.0 ) THEN
  1342.             ICHA2 = ICHA
  1343.             ICHA = 5
  1344.          ENDIF
  1345.       ENDIF
  1346. C                  TYPE = ACCE   +  ROBO
  1347. C
  1348.       IF(ICHA.EQ.9) THEN
  1349.          CALL LIRMOT ( MOROBO,1,IROBO,0 )
  1350.          IF( IROBO.NE.0 ) THEN
  1351.             ICHA3 = ICHA
  1352.             ICHA2 = ICHA - 1
  1353.             ICHA = 5
  1354.          ENDIF
  1355.       ENDIF
  1356. C=============================
  1357.    50 MSOLEN=MSOLIS(ICHA)
  1358.       IF(MSOLEN.EQ.0) THEN
  1359.          MOTERR(1:8)='SOLUTION'
  1360.          MOTERR(9:26)=ITYSOL
  1361.          MOTERR(30:38)=MCHA
  1362.          CALL ERREUR(235)
  1363.          GOTO 5000
  1364.       ENDIF
  1365.       ISOLIT=MSOLIT(ICHA)
  1366.       SEGACT MSOLEN
  1367.       LTE=ISOLEN(/1)
  1368. C
  1369. C  **** CALCUL DE IRG LE RANG DE L'OBJET CHERCHE
  1370. C
  1371.       IRG=0
  1372.       CALL LIRMOT(MOOPT,LMOOPT,IMOT,0)
  1373. C  ------------------------------ON PREND LA DERNIERE VALEUR---------
  1374.       IF(IMOT.NE.0) GOTO 700
  1375.         IRG=LTE
  1376.         GOTO 152
  1377. C
  1378. C  --------------------------------- RECHERCHE D'UN TEMPS-----------
  1379.   700 IF(IMOT.NE.1)GOTO 701
  1380.       MSOLRE=MSOLIS(1)
  1381.       IF(MSOLRE.EQ.0) GOTO 140
  1382.       SEGACT MSOLRE
  1383.       CALL LIRREE (XXX,1,IRETOU)
  1384.       IF(IERR.NE.0) GOTO 5000
  1385.       T1=XXX
  1386.       IF(T1.EQ.0.) THEN
  1387.           IF(SOLRE(1).EQ.0.) THEN
  1388.             IRG=1
  1389.             SEGDES MSOLRE
  1390.             GOTO 152
  1391.           ENDIF
  1392.           GOTO 140
  1393.       ENDIF
  1394.       DO 153 J=1,LTE
  1395.       T2=SOLRE(J)
  1396.       TR=ABS((T2-T1)/T1)
  1397.       IF(TR.LT.PRECI) THEN
  1398.            IRG=J
  1399.            SEGDES MSOLRE
  1400.            GOTO 152
  1401.       ENDIF
  1402.       IF(T2.GT.T1) GOTO 140
  1403.   153 CONTINUE
  1404.   140 CONTINUE
  1405.       SEGDES MSOLRE
  1406.       MOTERR(9:16)='FLOTTANT'
  1407.       GOTO 145
  1408. C -------------------------------------RECHERCHE D'UN CAS-----------
  1409.  701  CONTINUE
  1410.       IF(IMOT.NE.2)GOTO 702
  1411.       MSOLE1=MSOLIS(2)
  1412.       IF(MSOLE1.EQ.0) GOTO 141
  1413.       SEGACT MSOLE1
  1414.       CALL LIRENT(L1,1,IRETOU)
  1415.       IF(IERR.NE.0) GOTO 5000
  1416.       DO 154 J=1,LTE
  1417.       IF(L1.EQ.MSOLE1.ISOLEN(J))THEN
  1418.           IRG=J
  1419.           SEGDES MSOLE1
  1420.           GOTO 152
  1421.       ENDIF
  1422.  154  CONTINUE
  1423.  141  CONTINUE
  1424.       SEGDES MSOLE1
  1425.       MOTERR(9:16)='ENTIER  '
  1426.       GOTO 145
  1427. C -------------------------------------- RECHERCHE D'UN RANG-----------
  1428.  702  IF(IMOT.NE.3) GOTO 703
  1429.       CALL LIRENT(IRG,1,IRETOU)
  1430.       IF(IERR.NE.0) GOTO 5000
  1431.       IF(IRG.GT.LTE.OR.IRG.LT.1) THEN
  1432.          MOTERR(1:8) = ITYSOL
  1433.          CALL ERREUR(203)
  1434.          GOTO 5000
  1435.       ENDIF
  1436.       GOTO  152
  1437. C ---------------------------------------RECHERCHE D UN NUMERO DE MODE--
  1438.  703  IF(IMOT.NE.4) GOTO 5000
  1439.       CALL LIRENT(INUME,1,IRETOU)
  1440.       IF(IERR.NE.0) GOTO 5000
  1441.       IRG=INUME
  1442. C
  1443. C
  1444. C
  1445. C
  1446. C
  1447.       GOTO 152
  1448. C --------------------------------ERREUR-------------------------
  1449.  145  CONTINUE
  1450.       MOTERR(1:8)='SOLUTION'
  1451.       CALL ERREUR(135)
  1452.       GOTO 5000
  1453. C ------------------------------------------------------------------
  1454.  152  CONTINUE
  1455.       IRET = ISOLEN(IRG)
  1456.       SEGDES MSOLEN
  1457.       IF ( IRET.EQ.0 ) THEN
  1458.          MOTERR(1:8) = ITYSOL
  1459.          MOTERR(9:12)= MCHA
  1460.          INTERR(1) = IRG
  1461.          CALL ERREUR(234)
  1462.          GOTO 5000
  1463.       ENDIF
  1464. C                  TYPE = ACCE   +  ROBO
  1465. C                         VITE
  1466.       IF ( ICHA2.NE.0 ) THEN
  1467.          MSOLEN = MSOLIS(ICHA2)
  1468.          IF(MSOLEN.EQ.0) THEN
  1469.             MOTERR(1:8)='SOLUTION'
  1470.             MOTERR(9:26)=ITYSOL
  1471.             MOTERR(30:38)=MCHA
  1472.             CALL ERREUR(235)
  1473.             GOTO 5000
  1474.          ENDIF
  1475.          ISOLI2 = MSOLIT(ICHA2)
  1476.          IF ( ISOLI2.NE.ISOLIT ) GOTO 5000
  1477.          SEGACT MSOLEN
  1478.          IRET2 = ISOLEN(IRG)
  1479.          SEGDES MSOLEN
  1480.          IF ( IRET2.EQ.0 ) THEN
  1481.             MOTERR(1:8) = ITYSOL
  1482.             MOTERR(9:12) = MCHA
  1483.             INTERR(1) = IRG
  1484.             CALL ERREUR(234)
  1485.             GOTO 5000
  1486.          ENDIF
  1487.       ENDIF
  1488. C                  TYPE = ACCE   +  ROBO
  1489. C
  1490.       IF ( ICHA3.NE.0 ) THEN
  1491.          MSOLEN = MSOLIS(ICHA3)
  1492.          IF(MSOLEN.EQ.0) THEN
  1493.             MOTERR(1:8)='SOLUTION'
  1494.             MOTERR(9:26)=ITYSOL
  1495.             MOTERR(30:38)=MCHA
  1496.             CALL ERREUR(235)
  1497.             GOTO 5000
  1498.          ENDIF
  1499.          ISOLI3 = MSOLIT(ICHA3)
  1500.          IF ( ISOLI3.NE.ISOLIT ) GOTO 5000
  1501.          SEGACT MSOLEN
  1502.          IRET3 = ISOLEN(IRG)
  1503.          SEGDES MSOLEN
  1504.          IF ( IRET3.EQ.0 ) THEN
  1505.             MOTERR(1:8) = ITYSOL
  1506.             MOTERR(9:12) = MCHA
  1507.             INTERR(1) = IRG
  1508.             CALL ERREUR(234)
  1509.             GOTO 5000
  1510.          ENDIF
  1511.       ENDIF
  1512. C
  1513. C **** FREQUENCE* /MGEN /QX /QY /QZ   / POIN  **************************
  1514. C POIN
  1515.       IF ( IPLAC.EQ.6)   THEN
  1516.         IF(ITYSOL.NE.'DYNAMIQU') THEN
  1517.            MELEME = MSOLIS(3)
  1518.            SEGACT MELEME
  1519.            IPOINN = NUM(1,IRG)
  1520. *          CALL ECRENT(IPOINN)
  1521.            SEGDES MELEME
  1522.            CALL ECROBJ ('POINT',IPOINN)
  1523.            GOTO 5000
  1524.         ELSE
  1525.             MOTERR(1:8)='SOLUTION'
  1526.             MOTERR(9:12) = ITYSOL
  1527.             INTERR(1) = IRG
  1528.             CALL ERREUR(131)
  1529.             GOTO 5000
  1530.         ENDIF
  1531.       ENDIF
  1532.       IF ( ICHA.EQ.4 ) THEN
  1533.          MMODE = IRET
  1534.          SEGACT MMODE
  1535.          RET = FMMODD(IPLAC)
  1536.          SEGDES MMODE
  1537.          CALL ECRREE(RET)
  1538.          GOTO 5000
  1539.       ENDIF
  1540. C
  1541. C *** LE MSOLUT EST UN MODE  ---------------------------------------
  1542. C
  1543.       IF ( ITYSOL.NE.'MODE    ') GOTO 800
  1544.       MSOLEN = MSOLIS(4)
  1545.       SEGACT MSOLEN
  1546.       MMODE = ISOLEN(IRG)
  1547.       SEGDES MSOLEN
  1548.       CALL TITMOD(MMODE,ITEX)
  1549.       GOTO 899
  1550. C
  1551.   800 CONTINUE
  1552.       IF ( IMOT.NE.1 ) GOTO 801
  1553.       WRITE(ITEX(1:24),FMT='(A4,8X,1PE12.5)') MCHA,T1
  1554.       ITEX(5:12) = '      T='
  1555.       GOTO 899
  1556.   801 CONTINUE
  1557.   899 CONTINUE
  1558. C
  1559. C *** LA SORTIE PORTE SUR DES CHPOINTS---------------------------
  1560. C
  1561.       IF ( ISOLIT.NE.2 ) GOTO 600
  1562.       IF ( ICHA2.EQ.0 ) THEN
  1563.          IF (ITEX.NE.'  ') THEN
  1564.             MCHPOI = IRET
  1565.             SEGACT MCHPOI*MOD
  1566.             MOCHDE = ITEX
  1567.          ENDIF
  1568.          GOTO 699
  1569.       ENDIF
  1570. C                  TYPE = VITE   +  ROBO
  1571. C
  1572.       IF ( ICHA3.EQ.0 ) THEN
  1573.          N1 = 2
  1574.          SEGINI MLCHPO
  1575.          ICHPOI(1) = IRET
  1576.          ICHPOI(2) = IRET2
  1577.          IF (ITEX.NE.'  ') THEN
  1578.             MCHPOI = IRET
  1579.             SEGACT MCHPOI*MOD
  1580.             MOCHDE = ITEX
  1581.          ENDIF
  1582.          ISOLIT = 34
  1583.          IRET = MLCHPO
  1584.          GOTO 699
  1585.       ENDIF
  1586. C                  TYPE = ACCE   +  ROBO
  1587. C
  1588.       N1 = 3
  1589.       SEGINI MLCHPO
  1590.       ICHPOI(1) = IRET
  1591.       ICHPOI(2) = IRET2
  1592.       ICHPOI(3) = IRET3
  1593.       IF (ITEX.NE.'  ') THEN
  1594.          MCHPOI = IRET
  1595.          SEGACT MCHPOI*MOD
  1596.          MOCHDE = ITEX
  1597.       ENDIF
  1598.       ISOLIT = 34
  1599.       IRET = MLCHPO
  1600.       GOTO 699
  1601. C
  1602.   600 CONTINUE
  1603.       IF ( ISOLIT.NE.5 ) GOTO 601
  1604.       WRITE(IOIMP,*) 'TIRE :CAS ISOLIT=5 N EST PLUS BRANCHE'
  1605. C
  1606.   601 CONTINUE
  1607.   699 CONTINUE
  1608.       CTYP = '        '
  1609.       CALL TYPFIL (CTYP,ISOLIT)
  1610.       CALL ACTOBJ (CTYP,IRET,1)
  1611.       CALL ECROBJ (CTYP,IRET)
  1612.  5000 CONTINUE
  1613.       RETURN
  1614. C
  1615. C    PAS D OPERANDE CORRECTE TROUVE
  1616. C
  1617.  300  CALL QUETYP(MOTERR(1:8),0,IRETOU)
  1618.       IF(IRETOU.NE.0) THEN
  1619.          CALL ERREUR (39)
  1620.       ELSE
  1621.          CALL ERREUR(533)
  1622.       ENDIF
  1623.       RETURN
  1624.  
  1625.       END
  1626.  
  1627.  
  1628.  
  1629.  
  1630.  
  1631.  
  1632.  
  1633.  
  1634.  
  1635.  
  1636.  
  1637.  
  1638.  
  1639.  
  1640.  
  1641.  
  1642.  

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