Télécharger ecchar.eso

Retour à la liste

ecchar
C ECCHAR    SOURCE    PASCAL    22/06/24    21:15:03     11393          
 
      SUBROUTINE ECCHAR(MCHARG,jentet)
 
C  ===================================================================
C  =  ECRITURE D'UN OBJET CHARGEMENT                                 =
C  =                                                                 =
C  =  CREATION    : 15/10/85                                         =
C  =  PROGRAMMEUR : GUILBAUD                                         =
C  =  EXTENSION   : 11/97                                            =
C  =  PROGRAMMEUR : KICHENIN                                         =
C  ===================================================================
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHARG
-INC SMLREEL
-INC SMCOORD
 
      SEGACT,MCHARG
      NCHAR =KCHARG(/1)
      INTERR(1)=MCHARG
      INTERR(2)=NCHAR
 
* CHARGEMENT de pointeur %i1 qui contient %i2 chargement(s) élémentaire(s)
 
      WRITE(IOIMP,*) ' '
      CALL ERREUR(-111)
      WRITE(IOIMP,*) ' '
      DO 100 N=1,NCHAR
         ICHARG=KCHARG(N)
         SEGACT ICHARG
         IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML  ')) THEN
            INTERR(1)=N
            MOTERR(1:4) = CHANOM(N)
            MOTERR(5:8) = CHALIE(N)
            MOTERR(9:12) = CHAMOB(N)
 
* Chargement élémentaire %i1 : nom %m1:4 , nature %m5:8, deplacement %m9:12
* Description spatiale :
 
            WRITE(IOIMP,*) ' '
            CALL ERREUR(-112)
            IF(CHATYP.EQ.'CHPOINT ') THEN
               IBICHP=ICHPO1
               CALL ECCHPO(IBICHP,jentet)
            ELSEIF(CHATYP.EQ.'MCHAML  ') THEN
               IBICHP=ICHPO1
               CALL ZPCHEL(IBICHP,jentet)
            ENDIF
 
* Description temporelle :
 
            WRITE(IOIMP,*) ' '
            CALL ERREUR(-113)
            MLREEL=ICHPO2
 
* Chargement constant
            IF (ICHPO2.EQ.0) THEN
              CALL ERREUR(-374)
            ELSE
              SEGACT MLREEL
              N1=PROG(/1)
              INTERR(1)=N1
              INTERR(2)=MLREEL
 
* Listreel des temps de pointeur %i2 qui contient les %i1 temps suivants :
 
              CALL ERREUR(-114)
              IF(jentet.EQ.1) n1 = MIN(n1,10)
              IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
    5         FORMAT(5X,10(1X,1PE12.5))
              SEGDES MLREEL
              MLREEL=ICHPO3
              SEGACT MLREEL
              N1=PROG(/1)
              INTERR(1)=MLREEL
              INTERR(2)=N1
 
* Listreel de la fonction de pointeur %i1 qui contient les %i2 valeurs  :
 
              WRITE(IOIMP,*) ' '
              CALL ERREUR(-115)
              if(jentet.eq.1) n1 = min (n1,10)
              IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
              WRITE(IOIMP,*) ' '
              SEGDES MLREEL
            ENDIF
 
          ELSEIF (CHATYP.EQ.'TABLE   ') THEN
            INTERR(1)=N
            MOTERR(1:4) = CHANOM(N)
            MOTERR(5:8) = CHALIE(N)
            MOTERR(9:12) = CHAMOB(N)
 
* Chargement élémentaire %i1 : nom %m1:4 , nature %m5:8, deplacement %m9:12
* Première table :
 
            CALL ERREUR(-294)
            WRITE(IOIMP,*) ' '
            IBITAB = ICHPO1
            CALL ECTABL(IBITAB)
 
* Deuxième table :
 
            WRITE(IOIMP,*) ' '
            CALL ERREUR(-295)
            WRITE(IOIMP,*) ' '
            IBITAB = ICHPO2
            CALL ECTABL(IBITAB)
            WRITE(IOIMP,*) ' '
 
          ELSEIF (CHATYP.EQ.'LISTOBJE') THEN
            INTERR(1)=N
            MOTERR(1:4) = CHANOM(N)
            MOTERR(5:8) = CHALIE(N)
            MOTERR(9:12) = CHAMOB(N)
 
* Listreel :
            CALL ERREUR(-113)
            ILRE1 = ICHPO2
            CALL ECLRE1(ILRE1,JENTET)
 
* Listobje :
            CALL ERREUR(-384)
            ILOB1 = ICHPO1
            CALL ECLOBJ(ILOB1,JENTET)
 
          ELSE
C           Cas impossible a priori
            CALL ERREUR(5)
            RETURN
          ENDIF
 
c------------------ description du deplacement optionnel -------------
* Deplacement de type %m1:11 defini par
         IF (CHAMOB(N).EQ.'TRAN'.OR.CHAMOB(N).EQ.'ROTA'
     & .OR.CHAMOB(N).EQ.'TRAJ') THEN
            IF (CHAMOB(N).EQ.'TRAN')  MOTERR(1:11) = 'TRANSLATION'
            IF (CHAMOB(N).EQ.'ROTA')  MOTERR(1:11) = 'ROTATION   '
            IF (CHAMOB(N).EQ.'TRAJ')  MOTERR(1:11) = 'TRAJECTOIRE'
            CALL ERREUR(-323)
         WRITE(IOIMP,*) ' '
 
           IF ((CHAMOB(N).EQ.'TRAN').OR.(CHAMOB(N).EQ.'ROTA')) THEN
*  LISTE D'UN POINT
           SEGACT MCOORD
           IB=ICHPO4
           IB = IPTPOI(IB)
           ID=(IDIM+1)*(IB-1)
           INTERR(1)=IB
           REAERR(1)=XCOOR(ID+1)
           REAERR(2)=XCOOR(ID+2)
           REAERR(3)=XCOOR(ID+3)
           if (idim.eq.3) REAERR(4)=XCOOR(ID+4)
           IF (IDIM.EQ.2) CALL ERREUR(-7)
           IF (IDIM.EQ.3) CALL ERREUR(-8)
           WRITE(IOIMP,*) ' '
 
             IF((IDIM.EQ.3).AND.(CHAMOB(N).EQ.'ROTA')) THEN
              IB=ICHPO5
              IB = IPTPOI(IB)
              ID=(IDIM+1)*(IB-1)
              INTERR(1)=IB
              REAERR(1)=XCOOR(ID+1)
              REAERR(2)=XCOOR(ID+2)
              REAERR(3)=XCOOR(ID+3)
              REAERR(4)=XCOOR(ID+4)
              CALL ERREUR(-8)
              WRITE(IOIMP,*) ' '
             ENDIF
 
* Description vitesse :
            CALL ERREUR(-324)
            WRITE(IOIMP,*) ' '
            MLREEL=ICHPO6
            SEGACT MLREEL
            N1=PROG(/1)
            INTERR(1)=N1
            INTERR(2)=MLREEL
 
* Listreel de pointeur %i2 qui contient les %i1 temps :
            CALL ERREUR(-114)
            if(jentet.eq.1) n1 = min (n1,10)
            IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
            SEGDES MLREEL
            MLREEL=ICHPO7
            SEGACT MLREEL
            N1=PROG(/1)
            INTERR(1)=MLREEL
            INTERR(2)=N1
 
* Listreel de pointeur %i1 qui contient les %i2 valeurs  :
            WRITE(IOIMP,*) ' '
            CALL ERREUR(-115)
            IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
            WRITE(IOIMP,*) ' '
            SEGDES MLREEL
 
           ELSE IF (CHAMOB(N).EQ.'TRAJ') THEN
* Trajectoire decrite par le CHPOINT
            CALL ERREUR(-325)
            WRITE(IOIMP,*) ' '
            IBICHP=ICHPO4
            CALL ECCHPO(IBICHP,jentet)
           ELSE
           ENDIF
         ENDIF
 
       SEGDES ICHARG
  100 CONTINUE
      SEGDES MCHARG
 
      RETURN
      END
 
 
 
 
 

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