Télécharger ecchar.eso

Retour à la liste

Numérotation des lignes :

  1. C ECCHAR SOURCE PV 17/10/03 21:15:19 9581
  2.  
  3. SUBROUTINE ECCHAR(MCHARG,jentet)
  4.  
  5. C ===================================================================
  6. C = ECRITURE D'UN OBJET CHARGEMENT =
  7. C = =
  8. C = CREATION : 15/10/85 =
  9. C = PROGRAMMEUR : GUILBAUD =
  10. C = EXTENSION : 11/97 =
  11. C = PROGRAMMEUR : KICHENIN =
  12. C ===================================================================
  13.  
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8(A-H,O-Z)
  16.  
  17. -INC CCOPTIO
  18.  
  19. -INC SMCHARG
  20. -INC SMLREEL
  21. -INC SMCOORD
  22.  
  23. SEGACT,MCHARG
  24. NCHAR =KCHARG(/1)
  25. INTERR(1)=MCHARG
  26. INTERR(2)=NCHAR
  27.  
  28. * CHARGEMENT de pointeur %i1 qui contient %i2 chargement(s) élémentaire(s)
  29.  
  30. WRITE(IOIMP,*) ' '
  31. CALL ERREUR(-111)
  32. WRITE(IOIMP,*) ' '
  33. DO 100 N=1,NCHAR
  34. ICHARG=KCHARG(N)
  35. SEGACT ICHARG
  36. IF((CHATYP.EQ.'CHPOINT ').OR.(CHATYP.EQ.'MCHAML ')) THEN
  37. INTERR(1)=N
  38. MOTERR(1:4) = CHANOM(N)
  39. MOTERR(5:8) = CHALIE(N)
  40. MOTERR(9:12) = CHAMOB(N)
  41.  
  42. * Chargement élémentaire %i1 : nom %m1:4 , nature %m5:8, deplacement %m9:12
  43. * Description spatiale :
  44.  
  45. CALL ERREUR(-112)
  46. IF(CHATYP.EQ.'CHPOINT ') THEN
  47. IBICHP=ICHPO1
  48. CALL ECCHPO(IBICHP,jentet)
  49. ELSEIF(CHATYP.EQ.'MCHAML ') THEN
  50. IBICHP=ICHPO1
  51. CALL ZPCHEL(IBICHP,jentet)
  52. ENDIF
  53.  
  54. * Description temporelle :
  55.  
  56. CALL ERREUR(-113)
  57. WRITE(IOIMP,*) ' '
  58. MLREEL=ICHPO2
  59. SEGACT MLREEL
  60. N1=PROG(/1)
  61. INTERR(1)=N1
  62. INTERR(2)=MLREEL
  63.  
  64. * Listreel des temps de pointeur %i2 qui contient les %i1 temps suivants :
  65.  
  66. CALL ERREUR(-114)
  67. if(jentet.eq.1) n1 = min (n1,10)
  68. IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
  69. 5 FORMAT(5X,10(1X,1PE12.5))
  70. SEGDES MLREEL
  71. MLREEL=ICHPO3
  72. SEGACT MLREEL
  73. N1=PROG(/1)
  74. INTERR(1)=MLREEL
  75. INTERR(2)=N1
  76.  
  77. * Listreel de la fonction de pointeur %i1 qui contient les %i2 valeurs :
  78.  
  79. WRITE(IOIMP,*) ' '
  80. CALL ERREUR(-115)
  81. if(jentet.eq.1) n1 = min (n1,10)
  82. IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
  83. WRITE(IOIMP,*) ' '
  84. SEGDES MLREEL
  85.  
  86. ELSEIF (CHATYP.EQ.'TABLE ') THEN
  87. INTERR(1)=N
  88. MOTERR(1:4) = CHANOM(N)
  89. MOTERR(5:8) = CHALIE(N)
  90. MOTERR(9:12) = CHAMOB(N)
  91.  
  92. * Chargement élémentaire %i1 : nom %m1:4 , nature %m5:8, deplacement %m9:12
  93. * Première table :
  94.  
  95. CALL ERREUR(-294)
  96. WRITE(IOIMP,*) ' '
  97. IBITAB = ICHPO1
  98. CALL ECTABL(IBITAB)
  99.  
  100. * Deuxième table :
  101.  
  102. WRITE(IOIMP,*) ' '
  103. CALL ERREUR(-295)
  104. WRITE(IOIMP,*) ' '
  105. IBITAB = ICHPO2
  106. CALL ECTABL(IBITAB)
  107. WRITE(IOIMP,*) ' '
  108. ENDIF
  109.  
  110. c------------------ description du deplacement optionnel -------------
  111. * Deplacement de type %m1:11 defini par
  112. IF (CHAMOB(N).EQ.'TRAN'.OR.CHAMOB(N).EQ.'ROTA'
  113. & .OR.CHAMOB(N).EQ.'TRAJ') THEN
  114. IF (CHAMOB(N).EQ.'TRAN') MOTERR(1:11) = 'TRANSLATION'
  115. IF (CHAMOB(N).EQ.'ROTA') MOTERR(1:11) = 'ROTATION '
  116. IF (CHAMOB(N).EQ.'TRAJ') MOTERR(1:11) = 'TRAJECTOIRE'
  117. CALL ERREUR(-323)
  118. WRITE(IOIMP,*) ' '
  119.  
  120. IF ((CHAMOB(N).EQ.'TRAN').OR.(CHAMOB(N).EQ.'ROTA')) THEN
  121. * LISTE D'UN POINT
  122. SEGACT MCOORD
  123. IB=ICHPO4
  124. IB = IPTPOI(IB)
  125. ID=(IDIM+1)*(IB-1)
  126. INTERR(1)=IB
  127. REAERR(1)=XCOOR(ID+1)
  128. REAERR(2)=XCOOR(ID+2)
  129. REAERR(3)=XCOOR(ID+3)
  130. if (idim.eq.3) REAERR(4)=XCOOR(ID+4)
  131. IF (IDIM.EQ.2) CALL ERREUR(-7)
  132. IF (IDIM.EQ.3) CALL ERREUR(-8)
  133. WRITE(IOIMP,*) ' '
  134.  
  135. IF((IDIM.EQ.3).AND.(CHAMOB(N).EQ.'ROTA')) THEN
  136. IB=ICHPO5
  137. IB = IPTPOI(IB)
  138. ID=(IDIM+1)*(IB-1)
  139. INTERR(1)=IB
  140. REAERR(1)=XCOOR(ID+1)
  141. REAERR(2)=XCOOR(ID+2)
  142. REAERR(3)=XCOOR(ID+3)
  143. REAERR(4)=XCOOR(ID+4)
  144. CALL ERREUR(-8)
  145. WRITE(IOIMP,*) ' '
  146. ENDIF
  147.  
  148. * Description vitesse :
  149. CALL ERREUR(-324)
  150. WRITE(IOIMP,*) ' '
  151. MLREEL=ICHPO6
  152. SEGACT MLREEL
  153. N1=PROG(/1)
  154. INTERR(1)=N1
  155. INTERR(2)=MLREEL
  156.  
  157. * Listreel de pointeur %i2 qui contient les %i1 temps :
  158. CALL ERREUR(-114)
  159. if(jentet.eq.1) n1 = min (n1,10)
  160. IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
  161. SEGDES MLREEL
  162. MLREEL=ICHPO7
  163. SEGACT MLREEL
  164. N1=PROG(/1)
  165. INTERR(1)=MLREEL
  166. INTERR(2)=N1
  167.  
  168. * Listreel de pointeur %i1 qui contient les %i2 valeurs :
  169. WRITE(IOIMP,*) ' '
  170. CALL ERREUR(-115)
  171. IF(N1.NE.0) WRITE(IOIMP,5)(PROG(J),J=1,N1)
  172. WRITE(IOIMP,*) ' '
  173. SEGDES MLREEL
  174.  
  175. ELSE IF (CHAMOB(N).EQ.'TRAJ') THEN
  176. * Trajectoire decrite par le CHPOINT
  177. CALL ERREUR(-325)
  178. WRITE(IOIMP,*) ' '
  179. IBICHP=ICHPO4
  180. CALL ECCHPO(IBICHP,jentet)
  181. ELSE
  182. ENDIF
  183. ENDIF
  184.  
  185. SEGDES ICHARG
  186. 100 CONTINUE
  187. SEGDES MCHARG
  188.  
  189. RETURN
  190. END
  191.  
  192.  
  193.  

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