Télécharger charge.eso

Retour à la liste

Numérotation des lignes :

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

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