Télécharger dimens.eso

Retour à la liste

dimens
C DIMENS    SOURCE    CB215821  22/09/20    21:15:03     11459          
      SUBROUTINE DIMENS
************************************************************************
*
*                             D I M E N S
*                             -----------
*
*            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "DIMENSION"
*
* FONCTION:
* ---------
*
*     FOURNIR LA DIMENSION D'UN OBJET, LA SIGNIFICATION DU MOT
*     "DIMENSION" DEPENDANT DE L'OBJET CONSIDERE.
*
* PHRASE D'APPEL (EN GIBIANE):
* ----------------------------
*
*     LONG = DIMENSION OBJ ;
*
* OPERANDE ET RESULTAT:
* ---------------------
*
*     LONG      'ENTIER  '  DIMENSION DE "OBJ".
*     OBJ       'LISTREEL'  OBJET DONT ON PEUT DEFINIR UNE "DIMENSION".
*           OU  'LISTCHPO'
*           OU  'RIGIDITE'
*           OU  'LISTENTI'
*           OU  'SOLUTION'
*           OU  'LISTMOTS'
*           OU  'TABLE   '
*           OU  'EVOLUTIO'
*           OU  'CHARGEME'
*           OU  'NUAGE   ' ('COMP' ou 'UPLE')
*           OU  'LISTOBJ'
*           OU  'MOT'
*
*
* MODE DE FONCTIONNEMENT:
* -----------------------
*
*     APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE D'OBJET DONT ON
*     CHERCHE LA DIMENSION.
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     QUETYP,ECRENT,DIMEN1,DIMEN2,DIMEN3,DIMEN4,DIMEN5,DIMEN6
*     DIMEN7,DIMEN8,DIMEN9,DIME10
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     1ER OCTOBRE 1984
*     MODIFIE LE 13 OCTOBRE 1987 PAR DENIS ROBERT
*
* LANGAGE:
* --------
*
*     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
*
      CHARACTER*512 CMOT
      CHARACTER*4 MOTCLE(2)
      DATA MOTCLE/'COMP','UPLE'/
*
  10  CONTINUE
       CALL LIROBJ('LISTREEL',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GOTO 20
         CALL DIMEN1 (IPOINT,IDIMEN)
      GOTO 5000
  20  CONTINUE
       CALL LIROBJ('LISTCHPO',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GOTO 30
         CALL DIMEN2 (IPOINT,IDIMEN)
      GOTO 5000
  30  CONTINUE
       CALL LIROBJ('RIGIDITE',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GOTO 40
         CALL DIMEN3 (IPOINT,IDIMEN)
      GOTO 5000
  40  CONTINUE
       CALL LIROBJ('LISTENTI',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GOTO 50
         CALL DIMEN4 (IPOINT,IDIMEN)
      GOTO 5000
  50  CONTINUE
       CALL LIROBJ('SOLUTION',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GOTO 60
         CALL DIMEN5 (IPOINT,IDIMEN)
      GOTO 5000
  60  CONTINUE
       CALL LIROBJ('LISTMOTS',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GOTO 70
         CALL DIMEN6 (IPOINT,IDIMEN)
      GOTO 5000
  70  CONTINUE
       CALL LIROBJ('TABLE   ',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GOTO 80
         CALL DIMEN7 (IPOINT,IDIMEN)
      GOTO 5000
  80  CONTINUE
       CALL LIROBJ('EVOLUTIO',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GO TO 90
         CALL DIMEN8 (IPOINT,IDIMEN)
      GO TO 5000
  90  CONTINUE
       CALL LIROBJ('CHARGEME',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GO TO 100
         CALL DIMEN9 (IPOINT,IDIMEN)
      GO TO 5000
 100  CONTINUE
       CALL LIROBJ('NUAGE   ',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GO TO 110
         CALL LIRMOT(MOTCLE,2,JEMIL,1)
         IF (IERR.NE.0) RETURN
         CALL DIME10 (IPOINT,JEMIL,IDIMEN)
      GO TO 5000
 110  CONTINUE
       CALL LIROBJ('LISTOBJE',IPOINT,0,IRETOU)
         IF (IRETOU.NE.1) GO TO 120
         CALL DIME11 (IPOINT,IDIMEN)
      GO TO 5000
 120  CONTINUE
       CALL LIRCHA(CMOT,0,LMOT)
         IF (LMOT.EQ.0) GO TO 666
         IDIMEN=LMOT
      GO TO 5000
C
C    PAS D OPERANDE CORRECTE TROUVE
C
666   CALL QUETYP(MOTERR(1:8),0,IRETOU)
      IF(IRETOU.NE.0) THEN
         CALL ERREUR (39)
      ELSE
         CALL ERREUR(533)
      ENDIF
      RETURN
*
 5000 CONTINUE
*
      CALL ECRENT(IDIMEN)
      RETURN
*
      END
 
 
 
 
 

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