Télécharger creob.eso

Retour à la liste

Numérotation des lignes :

  1. C CREOB SOURCE PV 17/10/03 21:15:16 9581
  2. SUBROUTINE CREOB (ITYPE,NOMM1,NOMM2,ITLACC,mianc,mranc,mlanc)
  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*(8) 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),imax1,j
  44. GO TO 1094
  45. ENDIF
  46.  
  47. K=ITLAC(J)
  48. if (itype.eq.'ENTIER') K=itlac(j+mianc)
  49. if (itype.eq.'FLOTTANT') K=itlac(j+mranc)
  50. if (itype.eq.'LOGIQUE') K=itlac(j+mlanc)
  51.  
  52.  
  53.  
  54.  
  55. IF(IIMPI.NE.0) WRITE(IOIMP,801)ITYPE,NOM2(I),J,K
  56.  
  57. IF(ITYPE.EQ.'ENTIER ') then
  58. ik=k
  59. elseif (ITYPE.EQ.'FLOTTANT'.OR.ITYPE.EQ.
  60. $ 'LOGIQUE '.OR.ITYPE.EQ.'MOT ') then
  61. CALL QUEVAL(K,ITYPE,IERT,IK,XK,CK,BK,IOK)
  62. endif
  63. IF(IERT.EQ.1) THEN
  64. CALL ERREUR(5)
  65. GOTO 1
  66. ENDIF
  67.  
  68. IF(ITYPE.EQ.'ENTIER ') THEN
  69. CALL NOMENT(NOMM,IK)
  70. ELSE IF(ITYPE.EQ.'FLOTTANT') THEN
  71. CALL NOMREE(NOMM,XK)
  72. ELSE IF(ITYPE.EQ.'LOGIQUE ') THEN
  73. CALL NOMLOG(NOMM,BK)
  74. ELSE IF(ITYPE.EQ.'MOT ') THEN
  75. CALL NOMCHA(NOMM,CK(1:IK))
  76. ELSE
  77. CALL NOMOBJ(ITYPE,NOMM,K)
  78. ENDIF
  79. 1094 CONTINUE
  80.  
  81. 1 CONTINUE
  82. SEGDES NOMM1
  83. SEGDES NOMM2
  84. RETURN
  85. C -------------------------------------------------------
  86. 801 FORMAT(2X,A8,2X,A8,2X,2I6)
  87. 808 FORMAT(2X,A8,' * ATTENTION ERREUR SUR L''OBJET ',A8,2i4)
  88. END
  89.  
  90.  
  91.  
  92.  
  93.  

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