Télécharger creob.eso

Retour à la liste

Numérotation des lignes :

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

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