Télécharger la plaquette Cast3M


fr en

Télécharger eclobj.eso

Retour à la liste

Numérotation des lignes : 

eclobj

  1. C ECLOBJ    SOURCE    SP204843  26/02/03    21:15:12     12461          
  2.       SUBROUTINE ECLOBJ(IPLOBJ,IRESU)
  3. ************************************************************************
  4. *
  5. *                             E C L O B J
  6. *                             -----------
  7. *
  8. *     FONCTION: IMPRESSION D'UN OBJET "LISTOBJE"
  9. *     ---------
  10. *
  11. ************************************************************************
  12.  
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16.       PARAMETER (NMOT = 6)
  17.       CHARACTER*24 MFORM
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMLOBJE
  22.  
  23.       NMOT1 = NMOT 
  24.  
  25.       MLOBJE = IPLOBJ
  26.       SEGACT,MLOBJE
  27.       NBOBJ1 = LISOBJ(/1)
  28.       NBREE1 = RLIREE(/1)
  29.       NBELT1 = MAX(NBOBJ1,NBREE1)
  30.  
  31.       INTERR(1) = IPLOBJ
  32.       INTERR(2) = NBELT1
  33.       MOTERR(1:8) = TYPOBJ
  34.  
  35. C     LISTE VIDE
  36.       IF (NBELT1.EQ.0) THEN
  37.         CALL ERREUR(-383)
  38.         GOTO 999 
  39.       ENDIF
  40.  
  41. C     DEFINITION DES FORMATS SELON LE CAS
  42.       IK = 1
  43.       IF (TYPOBJ.EQ.'POINT   ') THEN
  44.         CALL ERREUR(-382)
  45.         NMOT1 = 10
  46.         WRITE (MFORM,FMT='("(",I1,"(1x,I7))")') NMOT1
  47.       ELSE IF (TYPOBJ.EQ.'FLOTTANT') THEN
  48.         IK = 2
  49.         NMOT1 = 10
  50.         CALL ERREUR(-391)
  51.         WRITE (MFORM,FMT='("(",I3,"(1X,1PG12.5))")') NMOT1
  52.       ELSE
  53.         CALL ERREUR(-381)
  54.         WRITE (MFORM,FMT='("(",I1,"(I12))")') NMOT1
  55.       ENDIF
  56. C     WRITE (6,*) MFORM
  57.  
  58. C     OPTION "RESU" ?
  59.       IF (IRESU.EQ.1) NBELT1 = MIN(NBELT1,10)
  60.  
  61. C     BOUCLE SUR LES OBJETS PAR PAQUET DE NMOT1
  62.       I1 = 1 
  63.       N1 = MIN(NBELT1,NMOT1)
  64. 1     CONTINUE
  65.         IF (IK.EQ.1) WRITE(IOIMP,MFORM) (LISOBJ(IP),IP=I1,N1)
  66.         IF (IK.EQ.2) WRITE(IOIMP,MFORM) (RLIREE(IP),IP=I1,N1)
  67.         IF (N1.GE.NBELT1) GOTO 999
  68.         I1 = I1 + NMOT1
  69.         N1 = MIN(NBELT1,N1+NMOT1)
  70.         GOTO 1
  71.  
  72. C     SORTIE
  73. 999   CONTINUE
  74.  
  75.       RETURN
  76.       END
  77.  
  78.  
  79.  
  80.  
  81.  

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