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

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