Télécharger ecchar.eso

Retour à la liste

Numérotation des lignes :

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

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