Télécharger creob.eso

Retour à la liste

Numérotation des lignes :

  1. C CREOB SOURCE PV 18/09/03 21:15:00 9903
  2. SUBROUTINE CREOB (ITYPE,NOMM1,NOMM2,ITLACC,mianc,mranc,mlanc,
  3. > mmanc)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C=======================================================================
  7. C BUT : RECREER LES OBJETS
  8. C APPELE PAR : LIPIL
  9. C :
  10. C ECRIT PAR FARVACQUE -REPRIS PAR LENA
  11. C
  12. C=======================================================================
  13. -INC CCOPTIO
  14. C=======================================================================
  15.  
  16.  
  17. SEGMENT/ITLACC/(ITLAC(0))
  18. SEGMENT/NOMM1/(NOM1(NOBJN1))
  19. SEGMENT NOMM2
  20. CHARACTER*(8) NOM2(NOBJN1)
  21. ENDSEGMENT
  22. C
  23. CHARACTER*(8) ITYPE
  24.  
  25. CHARACTER*8 NOMM
  26. CHARACTER*512 CK
  27. REAL*8 XK
  28. LOGICAL BK
  29.  
  30. C--------------------------------------------------------------------
  31. SEGACT NOMM1,NOMM2
  32. IMAX1=ITLAC(/1)
  33. NOBJN=NOM1(/1)
  34. C ------------------------------------------------------------------
  35. C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS*******************
  36. C
  37. IF(NOBJN.EQ.0) GOTO 1
  38.  
  39. DO 1094 I=1,NOBJN
  40. IERT=0
  41. J=NOM1(I)
  42. NOMM=NOM2(I)
  43. IF (J.GT.IMAX1) THEN
  44. WRITE(IOIMP,808) ITYPE,NOM2(I),imax1,j
  45. GO TO 1094
  46. ENDIF
  47.  
  48. K=ITLAC(J)
  49. if (itype.eq.'ENTIER' ) K=itlac(j+mianc)
  50. if (itype.eq.'FLOTTANT') K=itlac(j+mranc)
  51. if (itype.eq.'LOGIQUE' ) K=itlac(j+mlanc)
  52. if (itype.eq.'MOT ' ) K=itlac(j+mmanc)
  53.  
  54.  
  55.  
  56.  
  57. IF(IIMPI.NE.0) WRITE(IOIMP,801)ITYPE,NOM2(I),J,K
  58.  
  59. IF(ITYPE.EQ.'ENTIER ') then
  60. ik=k
  61. elseif (ITYPE.EQ.'FLOTTANT'.OR.ITYPE.EQ.
  62. $ 'LOGIQUE '.OR.ITYPE.EQ.'MOT ') then
  63. CALL QUEVAL(K,ITYPE,IERT,IK,XK,CK,BK,IOK)
  64. endif
  65. IF(IERT.EQ.1) THEN
  66. CALL ERREUR(5)
  67. GOTO 1
  68. ENDIF
  69.  
  70. IF(ITYPE.EQ.'ENTIER ') THEN
  71. CALL NOMENT(NOMM,IK)
  72. ELSE IF(ITYPE.EQ.'FLOTTANT') THEN
  73. CALL NOMREE(NOMM,XK)
  74. ELSE IF(ITYPE.EQ.'LOGIQUE ') THEN
  75. CALL NOMLOG(NOMM,BK)
  76. ELSE IF(ITYPE.EQ.'MOT ') THEN
  77. CALL NOMCHA(NOMM,CK(1:IK))
  78. ELSE
  79. CALL NOMOBJ(ITYPE,NOMM,K)
  80. ENDIF
  81. 1094 CONTINUE
  82.  
  83. 1 CONTINUE
  84. SEGDES NOMM1
  85. SEGDES NOMM2
  86. RETURN
  87. C -------------------------------------------------------
  88. 801 FORMAT(2X,A8,2X,A8,2X,2I9)
  89. 808 FORMAT(2X,A8,' * ATTENTION ERREUR SUR L''OBJET ',A8,2i4)
  90. END
  91.  
  92.  
  93.  

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