C CHARGE    SOURCE    PV        09/03/12    21:16:54     6325           
      SUBROUTINE CHARGE
C
C---------------------------------------------------------------------
C
C   CREATION DE L'OBJET CHARGEMENT
C
C   SYNTAXE : CHARGE = CHAR  (MOT) | MCHAML  |  EVOL   |  (|'LIE '|) ...
C                                  | CHPOINT |             |'LIBR'|
C                                  | TABLE1     TABLE2 |
C
C       ... ( | 'TRAN' VEC1 EVOL2                |  ) ; 
C             | 'ROTA' POIN1 (POIN2 si 3D) EVOL2 |
C             | 'TRAJ' TABLE3 TABLE4             |
C
C         MOT : Nom du chargement
C         TABLE1 : Table des temps indicee par des entiers
C         TABLE2 : Table des champs (CHPOINT ou MCHAML) indicee par des
C                  entiers
C   Par defaut le chargement est fixe. 3 options permettent de preciser
C un mouvement relatif du chargement par rapport au corps etudie
C         TABLE3 : Table des temps indicee par des entiers 
C         TABLE4 : Table des points de la trajectoire indicee par 
C                    des entiers
C
C   CREATION : 22/02/85
C   PROGRAMMEUR : GUILBAUD
C   MODIFICATION : 02/09/94
C   PROGRAMMEUR : JEANVOINE
C   EXTENSION : /02/98 KICH
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMCOORD
-INC SMCHARG
-INC SMCHPOI
-INC SMCHAML
-INC SMTABLE
-INC SMLREEL
-INC SMEVOLL
C      SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
C      DIMENSION X(3),Y(4)
      COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,
     #   ZVEC,ANGLE,ICLE

      CHARACTER*4 MOT1,MOT2
      IRETO2=0
      IRETO3=0
C----------------------- Lecture obligatoire du nom ------------------
 
      CALL LIRCHA(MOT1,0,LCHA)
      IF (MOT1.EQ.'LIBR'.OR.MOT1.EQ.'LIE '.OR.MOT1.EQ.'STAT'.OR.
     $ MOT1.EQ.'TRAN'.OR.MOT1.EQ.'ROTA'.OR.MOT1.EQ.'TRAJ') THEN
        MOT2 = MOT1
        MOT1 = '    '
      ELSE
        MOT2 = '    '
      ENDIF

C--------------- Lecture du MCHAML,CHPOINT ou  TABLE -----------------

      CALL LIROBJ('TABLE   ',ITA1,0,IRETO1)
      IF(IRETO1.EQ.0) THEN
         CALL LIROBJ('CHPOINT ',ICH1,0,IRETO2)
         IF(IRETO2.EQ.0) THEN
            CALL LIROBJ('MCHAML ',ICH2,0,IRETO3)
            IF(IRETO3.EQ.0) THEN
               CALL ERREUR(686)
               RETURN
            ENDIF
         ENDIF
         CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
      ELSE
         CALL LIROBJ('TABLE   ',ITA2,1,IRETOU)
      ENDIF
      IF(IERR.NE.0) RETURN
      N=1
      SEGINI MCHARG
      SEGINI ICHARG
      KCHARG(1)=ICHARG
      CHANAT='FORCE'
      IF (LCHA.NE.0) THEN
         if(mot1.eq.'PSUI') then
          call erreur(994)
          return
         endif
         CHANOM = MOT1
      ELSE
         CHANOM = '    '
      ENDIF

*------------------ cas du CHPOINT ou du MCHAML --------------------

      IF((IRETO2.EQ.1).OR.(IRETO3.EQ.1)) THEN
         SEGACT MEVOLL
         IEV1 = IEVOLL(/1)
         IF (IEV1.NE.1) THEN
            CALL ERREUR(687)
            SEGDES MEVOLL
            RETURN
         ENDIF
         KEVOLL=IEVOLL(1)
         SEGACT KEVOLL
         MLREE1 = IPROGX
         MLREE2 = IPROGY
         SEGACT MLREE1,MLREE2
         IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN
* la dimension des LISTREEL doit etre plus grande que 1
            SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2
            SEGSUP MCHARG,ICHARG
            CALL ERREUR(897)
            RETURN 
         ENDIF
         SEGDES MLREE1,MLREE2
         ICHPO2=IPROGX
         ICHPO3=IPROGY
         IF(IRETO2.EQ.1) THEN
            CHATYP = 'CHPOINT '
            ICHPO1 = ICH1
         ELSE
            CHATYP = 'MCHAML  '
            ICHPO1 = ICH2
         ENDIF
         IF (CHATYP.EQ.'CHPOINT ') THEN
           MCHPOI = ICH1
           SEGACT MCHPOI
           MSOUPO = IPCHP(1)
           SEGACT MSOUPO
          IF ((NOCOMP(1).EQ.'FX  '.OR.NOCOMP(1).EQ.'FY  '.OR.
     $         NOCOMP(1).EQ.'FZ  '.OR.NOCOMP(1).EQ.'FR  '.OR.
     $         NOCOMP(1).EQ.'FT  '.OR.NOCOMP(1).EQ.'MR  '.OR.
     $         NOCOMP(1).EQ.'MT  '.OR.NOCOMP(1).EQ.'MX  '.OR.
     $         NOCOMP(1).EQ.'MY  '.OR.NOCOMP(1).EQ.'MZ  ')
     $         .AND.(CHANOM.EQ.'    '))   CHANOM = 'MECA'
           SEGDES MSOUPO,MCHPOI
         ENDIF
         SEGDES KEVOLL
         SEGDES MEVOLL

*------------------------- cas des TABLES -----------------------

      ELSE
         CHATYP = 'TABLE   '
         ICHPO1 = ITA1
         ICHPO2 = ITA2
      ENDIF
C----------------------- Lecture des mots-cle optionnels ------------------
       IRETOU = 0
       IRETO1 = 0 
       IRETO2 = 0
      IF (MOT2.EQ.'    ') CALL LIRCHA(MOT2,0,LCHA)
      IF (LCHA.NE.0) THEN
        IF (MOT2.EQ.'LIBR') THEN
          CHALIE = 'LIBR'
          CALL LIRCHA(MOT2,0,LCHA)
        ELSEIF(MOT2.EQ.'LIE ') THEN
          CHALIE='LIE '
          CALL LIRCHA(MOT2,0,LCHA)
        ELSE
          CHALIE='LIE '
        ENDIF
      ELSE
        CHALIE='LIE '
      ENDIF

      IF (LCHA.NE.0) THEN

         IF (MOT2.EQ.'TRAN') THEN
           CHAMOB = MOT2
           CALL LIROBJ('POINT   ',IPO1,1,IRETO1)
           IF(IERR.NE.0) RETURN
           ICHPO4 = IPO1
           CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
           IF(IERR.NE.0) RETURN
 
         ELSE IF (MOT2.EQ.'ROTA') THEN
           CHAMOB = MOT2
           CALL LIROBJ('POINT   ',IPT1,1,IRETO1)
           IF(IERR.NE.0) RETURN
           ICHPO4 = IPT1
           IF (IDIM.GE.3) THEN
            CALL LIROBJ('POINT   ',IPT2,1,IRETO2)
            IF(IERR.NE.0) RETURN
            ICHPO5 = IPT2
           ENDIF
           CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
           IF(IERR.NE.0) RETURN

         ELSE IF (MOT2.EQ.'TRAJ') THEN
           CHAMOB = MOT2
           CALL LIROBJ('CHPOINT ',ITA1,1,IRETO1)
           IF(IERR.NE.0) RETURN

         ELSE
*
           GOTO 900
         ENDIF
      
      ELSE
         CHAMOB = 'STAT'
      ENDIF
*
      IF ((MOT2.EQ.'TRAN').OR.(MOT2.EQ.'ROTA')) THEN
         SEGACT MEVOLL
         IEV1 = IEVOLL(/1)
         IF (IEV1.NE.1) THEN
            CALL ERREUR(687)
            SEGDES MEVOLL
            RETURN
         ENDIF
         KEVOLL=IEVOLL(1)
         SEGACT KEVOLL
         MLREE1 = IPROGX
         MLREE2 = IPROGY
         SEGACT MLREE1,MLREE2
         IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN
* la dimension des LISTREEL doit etre plus grande que 1
            SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2
            SEGSUP ICHARG,MCHARG
            CALL ERREUR(897)
            RETURN 
         ENDIF
         SEGDES MLREE1,MLREE2
         ICHPO6=IPROGX
         ICHPO7=IPROGY
         SEGDES KEVOLL
         SEGDES MEVOLL
      ELSE IF (MOT2.EQ.'TRAJ') THEN
         MCHPO2 = ITA1
         SEGACT MCHPO2
         NSOUPO = MCHPO2.IPCHP(/1)
         IF (NSOUPO.GT.1) THEN
            SEGSUP ICHARG,MCHARG
* le champ doit posseder une seule composante 
            CALL ERREUR(898)
            RETURN
         ENDIF
         MSOUP2 = MCHPO2.IPCHP(1)
         SEGDES MCHPO2
         SEGACT MSOUP2
         NC = MSOUP2.NOCOMP(/2)
         IF (NC.GT.1) THEN
            SEGSUP ICHARG,MCHARG
            SEGDES MSOUP2
* le champ doit posseder une seule composante 
            CALL ERREUR(898)
            RETURN
         ENDIF
         IF (MSOUP2.NOCOMP(1).NE.'TEMP') THEN
            SEGSUP ICHARG,MCHARG
            SEGDES MSOUP2
* le nom de la composante doit etre TEMP 
            CALL ERREUR(898)
            RETURN
         ENDIF
 
         ICHPO4 = MCHPO2 
         ICHPO5 = MSOUP2.IGEOC
         MPOVA2 = MSOUP2.IPOVAL
         SEGDES MSOUP2
         SEGACT MPOVA2
         JG = MPOVA2.VPOCHA(/1)
         SEGINI MLREE2
         ICHPO6 = MLREE2
         DO IVO = 1,JG
           MLREE2.PROG(IVO) = MPOVA2.VPOCHA(IVO,1)
         ENDDO
         SEGDES MPOVA2
         SEGDES MLREE2
       ENDIF
*
 900  CONTINUE
      SEGDES ICHARG,MCHARG
      CALL ECROBJ('CHARGEME',MCHARG)
      RETURN
      END