Télécharger charge.eso

Retour à la liste

Numérotation des lignes :

  1. C CHARGE SOURCE PV 17/10/03 21:15:11 9581
  2. SUBROUTINE CHARGE
  3. C
  4. C---------------------------------------------------------------------
  5. C
  6. C CREATION DE L'OBJET CHARGEMENT
  7. C
  8. C SYNTAXE : CHARGE = CHAR (MOT) | MCHAML | EVOL | (|'LIE '|) ...
  9. C | CHPOINT | |'LIBR'|
  10. C | TABLE1 TABLE2 |
  11. C
  12. C ... ( | 'TRAN' VEC1 EVOL2 | ) ;
  13. C | 'ROTA' POIN1 (POIN2 si 3D) EVOL2 |
  14. C | 'TRAJ' TABLE3 TABLE4 |
  15. C
  16. C MOT : Nom du chargement
  17. C TABLE1 : Table des temps indicee par des entiers
  18. C TABLE2 : Table des champs (CHPOINT ou MCHAML) indicee par des
  19. C entiers
  20. C Par defaut le chargement est fixe. 3 options permettent de preciser
  21. C un mouvement relatif du chargement par rapport au corps etudie
  22. C TABLE3 : Table des temps indicee par des entiers
  23. C TABLE4 : Table des points de la trajectoire indicee par
  24. C des entiers
  25. C
  26. C CREATION : 22/02/85
  27. C PROGRAMMEUR : GUILBAUD
  28. C MODIFICATION : 02/09/94
  29. C PROGRAMMEUR : JEANVOINE
  30. C EXTENSION : /02/98 KICH
  31. C-----------------------------------------------------------------------
  32. C
  33. IMPLICIT INTEGER(I-N)
  34. IMPLICIT REAL*8(A-H,O-Z)
  35.  
  36. -INC CCOPTIO
  37.  
  38. -INC SMCHARG
  39. -INC SMCHPOI
  40. -INC SMCHAML
  41. -INC SMTABLE
  42. -INC SMLREEL
  43. -INC SMEVOLL
  44. -INC SMELEME
  45.  
  46. CHARACTER*4 MOT1,MOT2
  47. CHARACTER*8 MOT3,MOT4
  48. IRETO2=0
  49. IRETO3=0
  50. C----------------------- Lecture obligatoire du nom ------------------
  51.  
  52. CALL LIRCHA(MOT1,0,LCHA)
  53. IF (MOT1.EQ.'LIBR'.OR.MOT1.EQ.'LIE '.OR.MOT1.EQ.'STAT'.OR.
  54. $ MOT1.EQ.'TRAN'.OR.MOT1.EQ.'ROTA'.OR.MOT1.EQ.'TRAJ') THEN
  55. MOT2 = MOT1
  56. MOT1 = ' '
  57. ELSE
  58. MOT2 = ' '
  59. ENDIF
  60.  
  61. C--------------- Lecture du MCHAML,CHPOINT ou TABLE -----------------
  62.  
  63. CALL LIROBJ('TABLE ',ITA1,0,IRETO1)
  64. IF(IRETO1.EQ.0) THEN
  65. CALL LIROBJ('CHPOINT ',ICH1,0,IRETO2)
  66. IF(IRETO2.EQ.0) THEN
  67. CALL LIROBJ('MCHAML ',ICH2,0,IRETO3)
  68. IF(IRETO3.EQ.0) THEN
  69. CALL ERREUR(686)
  70. RETURN
  71. ENDIF
  72. ENDIF
  73. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  74. ELSE
  75. CALL LIROBJ('TABLE ',ITA2,1,IRETOU)
  76. ENDIF
  77. IF(IERR.NE.0) RETURN
  78. N=1
  79. SEGINI MCHARG
  80. SEGINI ICHARG
  81. KCHARG(1)=ICHARG
  82. CHANAT='FORCE'
  83. IF (LCHA.NE.0) THEN
  84. if(mot1.eq.'PSUI') then
  85. call erreur(994)
  86. return
  87. endif
  88. CHANOM = MOT1
  89. ELSE
  90. CHANOM = ' '
  91. ENDIF
  92.  
  93. *------------------ cas du CHPOINT ou du MCHAML --------------------
  94.  
  95. IF((IRETO2.EQ.1).OR.(IRETO3.EQ.1)) THEN
  96. SEGACT MEVOLL
  97. IEV1 = IEVOLL(/1)
  98. IF (IEV1.NE.1) THEN
  99. CALL ERREUR(687)
  100. SEGDES MEVOLL
  101. RETURN
  102. ENDIF
  103. KEVOLL=IEVOLL(1)
  104. SEGACT KEVOLL
  105. MLREE1 = IPROGX
  106. MLREE2 = IPROGY
  107. SEGACT MLREE1,MLREE2
  108. IF (MLREE1.PROG(/1) .LT. 2 .OR. MLREE2.PROG(/1) .LT. 2) THEN
  109. * la dimension des LISTREEL doit etre plus grande que 1
  110. SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2
  111. SEGSUP MCHARG,ICHARG
  112. CALL ERREUR(897)
  113. RETURN
  114. ENDIF
  115. SEGDES MLREE1,MLREE2
  116. ICHPO2=IPROGX
  117. ICHPO3=IPROGY
  118. IF(IRETO2.EQ.1) THEN
  119. CHATYP = 'CHPOINT '
  120. ICHPO1 = ICH1
  121. ELSE
  122. CHATYP = 'MCHAML '
  123. ICHPO1 = ICH2
  124. ENDIF
  125. IF (CHATYP.EQ.'CHPOINT ') THEN
  126. MCHPOI = ICH1
  127. SEGACT,MCHPOI
  128. IF (IPCHP(/1) .GE. 1) THEN
  129. MSOUPO = IPCHP(1)
  130. SEGACT,MSOUPO
  131. IF ((NOCOMP(1).EQ.'FX '.OR.NOCOMP(1).EQ.'FY '.OR.
  132. $ NOCOMP(1).EQ.'FZ '.OR.NOCOMP(1).EQ.'FR '.OR.
  133. $ NOCOMP(1).EQ.'FT '.OR.NOCOMP(1).EQ.'MR '.OR.
  134. $ NOCOMP(1).EQ.'MT '.OR.NOCOMP(1).EQ.'MX '.OR.
  135. $ NOCOMP(1).EQ.'MY '.OR.NOCOMP(1).EQ.'MZ ')
  136. $ .AND.(CHANOM.EQ.' ')) CHANOM = 'MECA'
  137. SEGDES MSOUPO
  138. ENDIF
  139. SEGDES,MCHPOI
  140. ENDIF
  141. SEGDES KEVOLL
  142. SEGDES MEVOLL
  143.  
  144. *------------------------- cas des TABLES -----------------------
  145.  
  146. ELSE
  147. CHATYP = 'TABLE '
  148. ICHPO1 = ITA1
  149. ICHPO2 = ITA2
  150. C dip : ajout de quelques tests sur les tables de chargement
  151. MTAB1 = ITA1
  152. MTAB2 = ITA2
  153. SEGACT,MTAB1,MTAB2
  154. C - les 2 tables doivent avoir la meme dimension
  155. I1 = MTAB1.MLOTAB
  156. I2 = MTAB2.MLOTAB
  157. IF (I1.NE.I2) THEN
  158. MOTERR(1:4)='CHAR'
  159. MOTERR(5:12)='TABLE '
  160. CALL ERREUR(125)
  161. RETURN
  162. ENDIF
  163. DO N=1,I1
  164. C - les indices des 2 tables doivent etre ENTIERs
  165. MOT3=MTAB1.MTABTI(N)
  166. MOT4=MTAB2.MTABTI(N)
  167. IF ((MOT3.NE.'ENTIER ').OR.(MOT4.NE.'ENTIER ')) THEN
  168. CALL ERREUR(647)
  169. RETURN
  170. ENDIF
  171. C - la table 1 doit contenir des FLOTTANTs
  172. MOT3=MTAB1.MTABTV(N)
  173. MOT4=MTAB2.MTABTV(N)
  174. IF (MOT3.NE.'FLOTTANT') THEN
  175. CALL ERREUR(692)
  176. RETURN
  177. ENDIF
  178. C - la table 2 doit contenir des CHPOINTs ou des MCHAMLs
  179. IF ((MOT4.NE.'CHPOINT ').AND.(MOT4.NE.'MCHAML ')) THEN
  180. CALL ERREUR(694)
  181. RETURN
  182. ENDIF
  183. C - les indices doivent etre croissants de 0 a (N-1)
  184. IND1=MTAB1.MTABII(N)
  185. IND2=MTAB2.MTABII(N)
  186. IF ((IND1.NE.(N-1)).OR.(IND2.NE.(N-1))) THEN
  187. CALL ERREUR(647)
  188. RETURN
  189. ENDIF
  190. C - les instants de la table 1 doivent etre croissants
  191. IF (N.EQ.1) THEN
  192. XTPP=MTAB1.RMTABV(N)
  193. ELSE
  194. XTP1=MTAB1.RMTABV(N)
  195. IF (XTP1.LT.XTPP) THEN
  196. CALL ERREUR(285)
  197. RETURN
  198. ENDIF
  199. XTPP=XTP1
  200. ENDIF
  201. ENDDO
  202. SEGDES,MTAB1,MTAB2
  203. ENDIF
  204. C----------------------- Lecture des mots-cle optionnels ------------------
  205. IRETOU = 0
  206. IRETO1 = 0
  207. IRETO2 = 0
  208. IF (MOT2.EQ.' ') CALL LIRCHA(MOT2,0,LCHA)
  209. IF (LCHA.NE.0) THEN
  210. IF (MOT2.EQ.'LIBR') THEN
  211. CHALIE = 'LIBR'
  212. CALL LIRCHA(MOT2,0,LCHA)
  213. ELSEIF(MOT2.EQ.'LIE ') THEN
  214. CHALIE='LIE '
  215. CALL LIRCHA(MOT2,0,LCHA)
  216. ELSE
  217. CHALIE='LIE '
  218. ENDIF
  219. ELSE
  220. CHALIE='LIE '
  221. ENDIF
  222.  
  223. IF (LCHA.NE.0) THEN
  224.  
  225. IF (MOT2.EQ.'TRAN') THEN
  226. CHAMOB = MOT2
  227. CALL LIROBJ('POINT ',IPT1,1,IRETO1)
  228. IF(IERR.NE.0) RETURN
  229. CALL CRELEM(IPT1)
  230. CALL CRECH1(IPT1,1)
  231. SEGDES,IPT1
  232. ICHPO4 = IPT1
  233. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  234. IF(IERR.NE.0) RETURN
  235.  
  236. ELSE IF (MOT2.EQ.'ROTA') THEN
  237. CHAMOB = MOT2
  238. CALL LIROBJ('POINT ',IPT1,1,IRETO1)
  239. IF(IERR.NE.0) RETURN
  240. CALL CRELEM(IPT1)
  241. CALL CRECH1(IPT1,1)
  242. SEGDES,IPT1
  243. ICHPO4 = IPT1
  244. IF (IDIM.GE.3) THEN
  245. CALL LIROBJ('POINT ',IPT2,1,IRETO2)
  246. IF(IERR.NE.0) RETURN
  247. CALL CRELEM(IPT2)
  248. CALL CRECH1(IPT2,1)
  249. SEGDES,IPT2
  250. ICHPO5 = IPT2
  251. ENDIF
  252. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  253. IF(IERR.NE.0) RETURN
  254.  
  255. ELSE IF (MOT2.EQ.'TRAJ') THEN
  256. CHAMOB = MOT2
  257. CALL LIROBJ('CHPOINT ',ITA1,1,IRETO1)
  258. IF(IERR.NE.0) RETURN
  259.  
  260. ELSE
  261. *
  262. GOTO 900
  263. ENDIF
  264.  
  265. ELSE
  266. CHAMOB = 'STAT'
  267. ENDIF
  268. *
  269. IF ((MOT2.EQ.'TRAN').OR.(MOT2.EQ.'ROTA')) THEN
  270. SEGACT MEVOLL
  271. IEV1 = IEVOLL(/1)
  272. IF (IEV1.NE.1) THEN
  273. CALL ERREUR(687)
  274. SEGDES MEVOLL
  275. RETURN
  276. ENDIF
  277. KEVOLL=IEVOLL(1)
  278. SEGACT KEVOLL
  279. MLREE1 = IPROGX
  280. MLREE2 = IPROGY
  281. SEGACT MLREE1,MLREE2
  282. IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN
  283. * la dimension des LISTREEL doit etre plus grande que 1
  284. SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2
  285. SEGSUP ICHARG,MCHARG
  286. CALL ERREUR(897)
  287. RETURN
  288. ENDIF
  289. SEGDES MLREE1,MLREE2
  290. ICHPO6=IPROGX
  291. ICHPO7=IPROGY
  292. SEGDES KEVOLL
  293. SEGDES MEVOLL
  294. ELSE IF (MOT2.EQ.'TRAJ') THEN
  295. MCHPO2 = ITA1
  296. SEGACT MCHPO2
  297. NSOUPO = MCHPO2.IPCHP(/1)
  298. IF (NSOUPO.GT.1) THEN
  299. SEGSUP ICHARG,MCHARG
  300. * le champ doit posseder une seule composante
  301. CALL ERREUR(898)
  302. RETURN
  303. ENDIF
  304. MSOUP2 = MCHPO2.IPCHP(1)
  305. SEGDES MCHPO2
  306. SEGACT MSOUP2
  307. NC = MSOUP2.NOCOMP(/2)
  308. IF (NC.GT.1) THEN
  309. SEGSUP ICHARG,MCHARG
  310. SEGDES MSOUP2
  311. * le champ doit posseder une seule composante
  312. CALL ERREUR(898)
  313. RETURN
  314. ENDIF
  315. IF (MSOUP2.NOCOMP(1).NE.'TEMP') THEN
  316. SEGSUP ICHARG,MCHARG
  317. SEGDES MSOUP2
  318. * le nom de la composante doit etre TEMP
  319. CALL ERREUR(898)
  320. RETURN
  321. ENDIF
  322.  
  323. ICHPO4 = MCHPO2
  324. ICHPO5 = MSOUP2.IGEOC
  325. MPOVA2 = MSOUP2.IPOVAL
  326. SEGDES MSOUP2
  327. SEGACT MPOVA2
  328. JG = MPOVA2.VPOCHA(/1)
  329. SEGINI MLREE2
  330. ICHPO6 = MLREE2
  331. DO IVO = 1,JG
  332. MLREE2.PROG(IVO) = MPOVA2.VPOCHA(IVO,1)
  333. ENDDO
  334. SEGDES MPOVA2
  335. SEGDES MLREE2
  336. ENDIF
  337. *
  338. 900 CONTINUE
  339. SEGDES ICHARG,MCHARG
  340. CALL ECROBJ('CHARGEME',MCHARG)
  341. RETURN
  342. END
  343.  
  344.  
  345.  

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