Download creob.eso

Back to the list

   1 : C CREOB     SOURCE    FANDEUR   08/01/16    21:15:01     6022           
   2 :       SUBROUTINE CREOB (ITYPE,NOMM1,NOMM2,ITLACC)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C=======================================================================
   6 : C   BUT        : RECREER LES OBJETS
   7 : C   APPELE PAR : LIPIL
   8 : C              :
   9 : C   ECRIT PAR FARVACQUE    -REPRIS PAR LENA
  10 : C
  11 : C=======================================================================
  12 : C=======================================================================
  13 : -INC CCOPTIO
  14 : C
  15 : C
  16 :       SEGMENT/ITLACC/(ITLAC(0))
  17 :       SEGMENT/NOMM1/(NOM1(NOBJN1))
  18 :       SEGMENT NOMM2
  19 :        CHARACTER*(8) NOM2(NOBJN1)
  20 :       ENDSEGMENT
  21 : C
  22 :       CHARACTER*(*) ITYPE
  23 : 
  24 :       CHARACTER*8 NOMM
  25 :       CHARACTER*512 CK
  26 :       REAL*8 XK
  27 :       LOGICAL BK
  28 : 
  29 : C--------------------------------------------------------------------
  30 :       SEGACT NOMM1,NOMM2
  31 :       IMAX1=ITLAC(/1)
  32 :       NOBJN=NOM1(/1)
  33 : C ------------------------------------------------------------------
  34 : C     *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
  35 : C
  36 :       IF(NOBJN.EQ.0) GOTO 1
  37 : 
  38 :       DO 1094 I=1,NOBJN
  39 :          IERT=0
  40 :          J=NOM1(I)
  41 :          NOMM=NOM2(I)
  42 :          IF (J.GT.IMAX1) THEN
  43 :             WRITE(IOIMP,808) ITYPE,NOM2(I)
  44 :             GO TO 1094
  45 :          ENDIF
  46 : 
  47 :          K=ITLAC(J)
  48 :          IF(IIMPI.NE.0) WRITE(IOIMP,801)ITYPE,NOM2(I),J,K
  49 : 
  50 :          IF(ITYPE.EQ.'ENTIER  '.OR.ITYPE.EQ.'FLOTTANT'.OR.ITYPE.EQ.
  51 :      $      'LOGIQUE '.OR.ITYPE.EQ.'MOT     ')
  51 :      $      CALL QUEVAL(K,ITYPE,IERT,IK,XK,CK,BK,IOK)
  52 : 
  53 :          IF(IERT.EQ.1) THEN
  53 :             CALL ERREUR(5)
  54 :             GOTO 1
  55 :          ENDIF
  56 : 
  57 :          IF(ITYPE.EQ.'ENTIER  ') THEN
  57 :                CALL NOMENT(NOMM,IK)
  58 :          ELSE IF(ITYPE.EQ.'FLOTTANT') THEN
  58 :                CALL NOMREE(NOMM,XK)
  59 :          ELSE IF(ITYPE.EQ.'LOGIQUE ') THEN
  59 :                CALL NOMLOG(NOMM,BK)
  60 :          ELSE IF(ITYPE.EQ.'MOT     ') THEN
  60 :                CALL NOMCHA(NOMM,CK(1:IK))
  61 :          ELSE
  61 :                CALL NOMOBJ(ITYPE,NOMM,K)
  62 :          ENDIF
  63 :  1094 CONTINUE
  64 : 
  65 :     1 CONTINUE
  66 :       SEGDES NOMM1
  67 :       SEGDES NOMM2
  68 :       RETURN
  69 : C -------------------------------------------------------
  70 :   801 FORMAT(2X,A8,2X,A8,2X,2I6)
  71 :   808 FORMAT(2X,A8,'  * ATTENTION ERREUR SUR L''OBJET ',A8)
  72 :       END
  73 :  
  74 :  

© Cast3M 2003 - All rights reserved.
Disclaimer