Télécharger charge.eso

Retour à la liste

Numérotation des lignes :

  1. C CHARGE SOURCE CB215821 16/07/04 21:15:00 9001
  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. -INC CCOPTIO
  35. -INC SMCOORD
  36. -INC SMCHARG
  37. -INC SMCHPOI
  38. -INC SMCHAML
  39. -INC SMTABLE
  40. -INC SMLREEL
  41. -INC SMEVOLL
  42. C SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  43. C DIMENSION X(3),Y(4)
  44. COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,
  45. # ZVEC,ANGLE,ICLE
  46.  
  47. CHARACTER*4 MOT1,MOT2
  48. CHARACTER*8 MOT3,MOT4
  49. IRETO2=0
  50. IRETO3=0
  51. C----------------------- Lecture obligatoire du nom ------------------
  52.  
  53. CALL LIRCHA(MOT1,0,LCHA)
  54. IF (MOT1.EQ.'LIBR'.OR.MOT1.EQ.'LIE '.OR.MOT1.EQ.'STAT'.OR.
  55. $ MOT1.EQ.'TRAN'.OR.MOT1.EQ.'ROTA'.OR.MOT1.EQ.'TRAJ') THEN
  56. MOT2 = MOT1
  57. MOT1 = ' '
  58. ELSE
  59. MOT2 = ' '
  60. ENDIF
  61.  
  62. C--------------- Lecture du MCHAML,CHPOINT ou TABLE -----------------
  63.  
  64. CALL LIROBJ('TABLE ',ITA1,0,IRETO1)
  65. IF(IRETO1.EQ.0) THEN
  66. CALL LIROBJ('CHPOINT ',ICH1,0,IRETO2)
  67. IF(IRETO2.EQ.0) THEN
  68. CALL LIROBJ('MCHAML ',ICH2,0,IRETO3)
  69. IF(IRETO3.EQ.0) THEN
  70. CALL ERREUR(686)
  71. RETURN
  72. ENDIF
  73. ENDIF
  74. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  75. ELSE
  76. CALL LIROBJ('TABLE ',ITA2,1,IRETOU)
  77. ENDIF
  78. IF(IERR.NE.0) RETURN
  79. N=1
  80. SEGINI MCHARG
  81. SEGINI ICHARG
  82. KCHARG(1)=ICHARG
  83. CHANAT='FORCE'
  84. IF (LCHA.NE.0) THEN
  85. if(mot1.eq.'PSUI') then
  86. call erreur(994)
  87. return
  88. endif
  89. CHANOM = MOT1
  90. ELSE
  91. CHANOM = ' '
  92. ENDIF
  93.  
  94. *------------------ cas du CHPOINT ou du MCHAML --------------------
  95.  
  96. IF((IRETO2.EQ.1).OR.(IRETO3.EQ.1)) THEN
  97. SEGACT MEVOLL
  98. IEV1 = IEVOLL(/1)
  99. IF (IEV1.NE.1) THEN
  100. CALL ERREUR(687)
  101. SEGDES MEVOLL
  102. RETURN
  103. ENDIF
  104. KEVOLL=IEVOLL(1)
  105. SEGACT KEVOLL
  106. MLREE1 = IPROGX
  107. MLREE2 = IPROGY
  108. SEGACT MLREE1,MLREE2
  109. IF (MLREE1.PROG(/1) .LT. 2 .OR. MLREE2.PROG(/1) .LT. 2) THEN
  110. * la dimension des LISTREEL doit etre plus grande que 1
  111. SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2
  112. SEGSUP MCHARG,ICHARG
  113. CALL ERREUR(897)
  114. RETURN
  115. ENDIF
  116. SEGDES MLREE1,MLREE2
  117. ICHPO2=IPROGX
  118. ICHPO3=IPROGY
  119. IF(IRETO2.EQ.1) THEN
  120. CHATYP = 'CHPOINT '
  121. ICHPO1 = ICH1
  122. ELSE
  123. CHATYP = 'MCHAML '
  124. ICHPO1 = ICH2
  125. ENDIF
  126. IF (CHATYP.EQ.'CHPOINT ') THEN
  127. MCHPOI = ICH1
  128. SEGACT,MCHPOI
  129. IF (IPCHP(/1) .GE. 1) THEN
  130. MSOUPO = IPCHP(1)
  131. SEGACT,MSOUPO
  132. IF ((NOCOMP(1).EQ.'FX '.OR.NOCOMP(1).EQ.'FY '.OR.
  133. $ NOCOMP(1).EQ.'FZ '.OR.NOCOMP(1).EQ.'FR '.OR.
  134. $ NOCOMP(1).EQ.'FT '.OR.NOCOMP(1).EQ.'MR '.OR.
  135. $ NOCOMP(1).EQ.'MT '.OR.NOCOMP(1).EQ.'MX '.OR.
  136. $ NOCOMP(1).EQ.'MY '.OR.NOCOMP(1).EQ.'MZ ')
  137. $ .AND.(CHANOM.EQ.' ')) CHANOM = 'MECA'
  138. SEGDES MSOUPO
  139. ENDIF
  140. SEGDES,MCHPOI
  141. ENDIF
  142. SEGDES KEVOLL
  143. SEGDES MEVOLL
  144.  
  145. *------------------------- cas des TABLES -----------------------
  146.  
  147. ELSE
  148. CHATYP = 'TABLE '
  149. ICHPO1 = ITA1
  150. ICHPO2 = ITA2
  151. C dip : ajout de quelques tests sur les tables de chargement
  152. MTAB1 = ITA1
  153. MTAB2 = ITA2
  154. SEGACT,MTAB1,MTAB2
  155. C - les 2 tables doivent avoir la meme dimension
  156. I1 = MTAB1.MLOTAB
  157. I2 = MTAB2.MLOTAB
  158. IF (I1.NE.I2) THEN
  159. MOTERR(1:4)='CHAR'
  160. MOTERR(5:12)='TABLE '
  161. CALL ERREUR(125)
  162. RETURN
  163. ENDIF
  164. DO N=1,I1
  165. C - les indices des 2 tables doivent etre ENTIERs
  166. MOT3=MTAB1.MTABTI(N)
  167. MOT4=MTAB2.MTABTI(N)
  168. IF ((MOT3.NE.'ENTIER ').OR.(MOT4.NE.'ENTIER ')) THEN
  169. CALL ERREUR(647)
  170. RETURN
  171. ENDIF
  172. C - la table 1 doit contenir des FLOTTANTs
  173. MOT3=MTAB1.MTABTV(N)
  174. MOT4=MTAB2.MTABTV(N)
  175. IF (MOT3.NE.'FLOTTANT') THEN
  176. CALL ERREUR(692)
  177. RETURN
  178. ENDIF
  179. C - la table 2 doit contenir des CHPOINTs ou des MCHAMLs
  180. IF ((MOT4.NE.'CHPOINT ').AND.(MOT4.NE.'MCHAML ')) THEN
  181. CALL ERREUR(694)
  182. RETURN
  183. ENDIF
  184. C - les indices doivent etre croissants de 0 a (N-1)
  185. IND1=MTAB1.MTABII(N)
  186. IND2=MTAB2.MTABII(N)
  187. IF ((IND1.NE.(N-1)).OR.(IND2.NE.(N-1))) THEN
  188. CALL ERREUR(647)
  189. RETURN
  190. ENDIF
  191. C - les instants de la table 1 doivent etre croissants
  192. IF (N.EQ.1) THEN
  193. XTPP=MTAB1.RMTABV(N)
  194. ELSE
  195. XTP1=MTAB1.RMTABV(N)
  196. IF (XTP1.LT.XTPP) THEN
  197. CALL ERREUR(285)
  198. RETURN
  199. ENDIF
  200. XTPP=XTP1
  201. ENDIF
  202. ENDDO
  203. SEGDES,MTAB1,MTAB2
  204. ENDIF
  205. C----------------------- Lecture des mots-cle optionnels ------------------
  206. IRETOU = 0
  207. IRETO1 = 0
  208. IRETO2 = 0
  209. IF (MOT2.EQ.' ') CALL LIRCHA(MOT2,0,LCHA)
  210. IF (LCHA.NE.0) THEN
  211. IF (MOT2.EQ.'LIBR') THEN
  212. CHALIE = 'LIBR'
  213. CALL LIRCHA(MOT2,0,LCHA)
  214. ELSEIF(MOT2.EQ.'LIE ') THEN
  215. CHALIE='LIE '
  216. CALL LIRCHA(MOT2,0,LCHA)
  217. ELSE
  218. CHALIE='LIE '
  219. ENDIF
  220. ELSE
  221. CHALIE='LIE '
  222. ENDIF
  223.  
  224. IF (LCHA.NE.0) THEN
  225.  
  226. IF (MOT2.EQ.'TRAN') THEN
  227. CHAMOB = MOT2
  228. CALL LIROBJ('POINT ',IPO1,1,IRETO1)
  229. IF(IERR.NE.0) RETURN
  230. ICHPO4 = IPO1
  231. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  232. IF(IERR.NE.0) RETURN
  233.  
  234. ELSE IF (MOT2.EQ.'ROTA') THEN
  235. CHAMOB = MOT2
  236. CALL LIROBJ('POINT ',IPT1,1,IRETO1)
  237. IF(IERR.NE.0) RETURN
  238. ICHPO4 = IPT1
  239. IF (IDIM.GE.3) THEN
  240. CALL LIROBJ('POINT ',IPT2,1,IRETO2)
  241. IF(IERR.NE.0) RETURN
  242. ICHPO5 = IPT2
  243. ENDIF
  244. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  245. IF(IERR.NE.0) RETURN
  246.  
  247. ELSE IF (MOT2.EQ.'TRAJ') THEN
  248. CHAMOB = MOT2
  249. CALL LIROBJ('CHPOINT ',ITA1,1,IRETO1)
  250. IF(IERR.NE.0) RETURN
  251.  
  252. ELSE
  253. *
  254. GOTO 900
  255. ENDIF
  256.  
  257. ELSE
  258. CHAMOB = 'STAT'
  259. ENDIF
  260. *
  261. IF ((MOT2.EQ.'TRAN').OR.(MOT2.EQ.'ROTA')) THEN
  262. SEGACT MEVOLL
  263. IEV1 = IEVOLL(/1)
  264. IF (IEV1.NE.1) THEN
  265. CALL ERREUR(687)
  266. SEGDES MEVOLL
  267. RETURN
  268. ENDIF
  269. KEVOLL=IEVOLL(1)
  270. SEGACT KEVOLL
  271. MLREE1 = IPROGX
  272. MLREE2 = IPROGY
  273. SEGACT MLREE1,MLREE2
  274. IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN
  275. * la dimension des LISTREEL doit etre plus grande que 1
  276. SEGDES MEVOLL,KEVOLL,MLREE1,MLREE2
  277. SEGSUP ICHARG,MCHARG
  278. CALL ERREUR(897)
  279. RETURN
  280. ENDIF
  281. SEGDES MLREE1,MLREE2
  282. ICHPO6=IPROGX
  283. ICHPO7=IPROGY
  284. SEGDES KEVOLL
  285. SEGDES MEVOLL
  286. ELSE IF (MOT2.EQ.'TRAJ') THEN
  287. MCHPO2 = ITA1
  288. SEGACT MCHPO2
  289. NSOUPO = MCHPO2.IPCHP(/1)
  290. IF (NSOUPO.GT.1) THEN
  291. SEGSUP ICHARG,MCHARG
  292. * le champ doit posseder une seule composante
  293. CALL ERREUR(898)
  294. RETURN
  295. ENDIF
  296. MSOUP2 = MCHPO2.IPCHP(1)
  297. SEGDES MCHPO2
  298. SEGACT MSOUP2
  299. NC = MSOUP2.NOCOMP(/2)
  300. IF (NC.GT.1) THEN
  301. SEGSUP ICHARG,MCHARG
  302. SEGDES MSOUP2
  303. * le champ doit posseder une seule composante
  304. CALL ERREUR(898)
  305. RETURN
  306. ENDIF
  307. IF (MSOUP2.NOCOMP(1).NE.'TEMP') THEN
  308. SEGSUP ICHARG,MCHARG
  309. SEGDES MSOUP2
  310. * le nom de la composante doit etre TEMP
  311. CALL ERREUR(898)
  312. RETURN
  313. ENDIF
  314.  
  315. ICHPO4 = MCHPO2
  316. ICHPO5 = MSOUP2.IGEOC
  317. MPOVA2 = MSOUP2.IPOVAL
  318. SEGDES MSOUP2
  319. SEGACT MPOVA2
  320. JG = MPOVA2.VPOCHA(/1)
  321. SEGINI MLREE2
  322. ICHPO6 = MLREE2
  323. DO IVO = 1,JG
  324. MLREE2.PROG(IVO) = MPOVA2.VPOCHA(IVO,1)
  325. ENDDO
  326. SEGDES MPOVA2
  327. SEGDES MLREE2
  328. ENDIF
  329. *
  330. 900 CONTINUE
  331. SEGDES ICHARG,MCHARG
  332. CALL ECROBJ('CHARGEME',MCHARG)
  333. RETURN
  334. END
  335.  
  336.  

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