Télécharger ecnuag.eso

Retour à la liste

Numérotation des lignes :

ecnuag
  1. C ECNUAG SOURCE CB215821 15/05/04 21:15:03 8516
  2. SUBROUTINE ECNUAG(INUA)
  3. C----------------------------------------------------------------------
  4. C IMPRESSION D'UN OBJET DE TYPE NUAGE
  5. C----------------------------------------------------------------------
  6. IMPLICIT INTEGER(I-N)
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMNUAGE
  10. -INC CCNOYAU
  11. CHARACTER*(8) ITYPE,INOM,IWR(5)
  12. CHARACTER*4 FAUX,VRAI
  13. CHARACTER*8 IWRI
  14. REAL*8 XRR(5)
  15. INTEGER INRE(5)
  16. LOGICAL BRET
  17. MNUAGE=INUA
  18. SEGACT MNUAGE
  19. NVAR=NUAPOI(/1)
  20.  
  21. IF (NVAR .EQ. 0) THEN
  22. NBCOUP = 0
  23. ELSE
  24. ITYPE=NUATYP(1)
  25. IF( ITYPE.EQ.'FLOTTANT') THEN
  26. NUAVFL=NUAPOI(1)
  27. SEGACT NUAVFL
  28. NBCOUP=NUAFLO(/1)
  29. ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  30. NUAVLO=NUAPOI(1)
  31. SEGACT NUAVLO
  32. NBCOUP=NUALOG(/1)
  33. ELSEIF(ITYPE.EQ.'MOT ') THEN
  34. NUAVMO=NUAPOI(1)
  35. SEGACT NUAVMO
  36. NBCOUP=NUAMOT(/2)
  37. ELSE
  38. NUAVIN=NUAPOI(1)
  39. SEGACT NUAVIN
  40. NBCOUP=NUAINT(/1)
  41. ENDIF
  42. ENDIF
  43.  
  44. INTERR(1) = MNUAGE
  45. INTERR(2) = NVAR
  46. INTERR(3)=NBCOUP
  47. CALL ERREUR(-287)
  48.  
  49. IF (NVAR .EQ. 0) THEN
  50. SEGDES MNUAGE
  51. RETURN
  52. ENDIF
  53.  
  54. 513 FORMAT(5(2X,I8))
  55. 514 FORMAT(5(1X,1PE9.2))
  56. 515 FORMAT(5(2X,A8))
  57.  
  58. DO 1 IV = 1,NVAR
  59. MOTERR(1:8) = NUANOM(IV)
  60. MOTERR(9:16)= NUATYP(IV)
  61. INTERR(1) = IV
  62. CALL ERREUR(-288)
  63.  
  64. ITYPE=NUATYP(IV)
  65. IF( ITYPE.EQ.'FLOTTANT') THEN
  66. NUAVFL=NUAPOI(IV)
  67. SEGACT NUAVFL
  68. NBCOUP=NUAFLO(/1)
  69. NN = 0
  70. DO 12 K = 1,NBCOUP,5
  71. NI = MIN ( 5 , NBCOUP - NN)
  72. DO 13 NW = 1, NI
  73. XRR(NW)=NUAFLO(K-1+NW)
  74. 13 CONTINUE
  75. WRITE(IOIMP,514) (XRR(IK),IK=1,NI)
  76. NN = NN + 5
  77. 12 CONTINUE
  78. SEGDES NUAVFL
  79.  
  80. ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  81. NUAVLO=NUAPOI(IV)
  82. SEGACT NUAVLO
  83. NBCOUP=NUALOG(/1)
  84. NN = 0
  85. DO 121 K = 1,NBCOUP,5
  86. NI = MIN ( 5 , NBCOUP - NN)
  87. DO 131 NW = 1, NI
  88. IWR(NW) = 'FAUX'
  89. IF( NUALOG(K-1+NW)) IWR(NW) ='VRAI'
  90. 131 CONTINUE
  91. WRITE(IOIMP,515) (IWR(IK),IK=1,NI)
  92. NN = NN + 5
  93. 121 CONTINUE
  94. SEGDES NUAVLO
  95.  
  96. ELSEIF(ITYPE.EQ.'MOT ') THEN
  97. NUAVMO=NUAPOI(IV)
  98. SEGACT NUAVMO
  99. NBCOUP=NUAMOT(/2)
  100. NN = 0
  101. DO 122 K = 1,NBCOUP,5
  102. NI = MIN ( 5 , NBCOUP - NN)
  103. DO 132 NW = 1, NI
  104. IWR(NW) = NUAMOT(K-1+NW)
  105. 132 CONTINUE
  106. WRITE(IOIMP,515) (IWR(IK),IK=1,NI)
  107. NN = NN + 5
  108. 122 CONTINUE
  109. SEGDES NUAVMO
  110.  
  111. ELSE
  112. NUAVIN=NUAPOI(IV)
  113. SEGACT NUAVIN
  114. NBCOUP=NUAINT(/1)
  115. NN = 0
  116. DO 123 K = 1,NBCOUP,5
  117. NI = MIN ( 5 , NBCOUP - NN)
  118. DO 133 NW = 1, NI
  119. INRE(NW) = NUAINT(K-1+NW)
  120. 133 CONTINUE
  121. WRITE(IOIMP,513) (INRE(IK),IK=1,NI)
  122. NN = NN + 5
  123. 123 CONTINUE
  124. SEGDES NUAVIN
  125. ENDIF
  126. 1 CONTINUE
  127.  
  128. SEGDES MNUAGE
  129. RETURN
  130. END
  131.  
  132.  
  133.  

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