Télécharger charge.eso

Retour à la liste

Numérotation des lignes :

charge
  1. C CHARGE SOURCE PASCAL 22/06/24 21:15:02 11393
  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 MCHAML : Champ par element (description spatiale) du chargement
  18. C CHPOINT : Champ par point (description spatiale) du chargement
  19. C EVOL : Evolution de ponderation (description temporelle) du chargement
  20. C facultative, le chargement est constant si absente
  21. C TABLE1 : Table des temps indicee par des entiers
  22. C TABLE2 : Table des champs (CHPOINT ou MCHAML) indicee par des
  23. C entiers commancant par 0 puis 1, 2, ...
  24. C
  25. C Par defaut le chargement est fixe. 3 options permettent de preciser
  26. C un mouvement relatif du chargement par rapport au corps etudie
  27. C TABLE3 : Table des temps indicee par des entiers
  28. C TABLE4 : Table des points de la trajectoire indicee par
  29. C des entiers
  30. C
  31. C CREATION : 22/02/85
  32. C PROGRAMMEUR : GUILBAUD
  33. C MODIFICATION : 02/09/94
  34. C PROGRAMMEUR : JEANVOINE
  35. C EXTENSION : /02/98 KICH
  36. C-----------------------------------------------------------------------
  37. C
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8(A-H,O-Z)
  40.  
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44.  
  45. -INC SMCHARG
  46. -INC SMCHPOI
  47. -INC SMCHAML
  48. -INC SMTABLE
  49. -INC SMLREEL
  50. -INC SMEVOLL
  51. -INC SMELEME
  52. -INC SMLOBJE
  53.  
  54. CHARACTER*4 MOT1,MOT2,MOCLE(6)
  55. CHARACTER*8 MOT3,MOT4
  56.  
  57. DATA MOCLE /'LIBR','LIE ','STAT','TRAN','ROTA','TRAJ'/
  58.  
  59. IRETO1=0
  60. IRETO2=0
  61. IRETO3=0
  62. IRETO4=0
  63. IRETO5=0
  64. C----------------------- Lecture obligatoire du nom --------------------
  65.  
  66. CALL LIRCHA(MOT2,0,LCHA)
  67. IF (LCHA.NE.0) THEN
  68. CALL PLACE(MOCLE,6,IPLAC,MOT2)
  69. C Si MOT2 pas dans MOCLE, c'est le nom du chargement > MOT1
  70. IF (IPLAC.EQ.0) THEN
  71. MOT1 = MOT2
  72. MOT2 = ' '
  73. C Si MOT2 dans MOCLE et vaut TRAJ, on ne veut pas un 2e mot TRAJ (exclu)
  74. ELSEIF (IPLAC.EQ.6) THEN
  75. CALL LIRCHA(MOT1,0,LCHA1)
  76. IF (LCHA1.NE.0) THEN
  77. IF (MOT1.EQ.'TRAJ') THEN
  78. CALL ERREUR(696)
  79. RETURN
  80. ENDIF
  81. ELSE
  82. C Si on ne lit que le mot TRAJ, c'est un chargement de nom TRAJ :
  83. MOT1 = MOT2
  84. MOT2 = ' '
  85. ENDIF
  86. ELSE
  87. C Si MOT2 dans MOCLE, nom du chargement inconnu (=' ')
  88. MOT1 = ' '
  89. ENDIF
  90. ENDIF
  91. IF (IERR.NE.0) RETURN
  92. C
  93. C---------------- Lecture du MCHAML,CHPOINT ou TABLE ------------------
  94. C Syntaxe avec 2 TABLEs :
  95. CALL LIROBJ('TABLE ',ITA1,0,IRETO1)
  96. C -- si presence d'une TABLE, on va chercher la seconde TABLE
  97. IF (IRETO1.EQ.1) THEN
  98. CALL LIROBJ('TABLE ',ITA2,1,IRETOU)
  99. IF (IERR.NE.0) RETURN
  100. ELSE
  101. C Syntaxe avec LISTOBJE :
  102. CALL LIROBJ('LISTOBJE',ILOB1,0,IRETO5)
  103. IF (IRETO5.EQ.1) THEN
  104. CALL LIROBJ('LISTREEL',ILRE1,1,IRETOU)
  105. IF (IERR.NE.0) RETURN
  106. ELSE
  107. C Syntaxe avec 1 champ et 1 EVOLUTIOn :
  108. C -- y a t'il un CHPOINT ?
  109. CALL LIROBJ('CHPOINT ',ICH1,0,IRETO2)
  110. IF (IRETO2.EQ.1) THEN
  111. CALL ACTOBJ('CHPOINT ',ICH1,1)
  112. IF (IERR.NE.0) RETURN
  113. C -- si pas de CHPOINT, on exige la lecture d'un MCHAML
  114. ELSE
  115. CALL LIROBJ('MCHAML ',ICH2,1,IRETO3)
  116. CALL ACTOBJ('MCHAML ',ICH2,1)
  117. IF (IERR.NE.0) RETURN
  118. ENDIF
  119. C -- y a t'il une EVOLUTIOn ?
  120. CALL LIROBJ('EVOLUTIO',MEVOLL,0,IRETO4)
  121. C -- si pas d'EVOLUTIOn, le chargement sera constant
  122. IF (IRETO4.EQ.0) THEN
  123. MEVOLL=0
  124. ENDIF
  125. ENDIF
  126. ENDIF
  127.  
  128. N=1
  129. SEGINI MCHARG
  130. SEGINI ICHARG
  131. KCHARG(1)=ICHARG
  132. CHANAT='FORCE'
  133. IF (LCHA.NE.0) THEN
  134. if(mot1.eq.'PSUI') then
  135. call erreur(994)
  136. return
  137. endif
  138. CHANOM = MOT1
  139. ELSE
  140. CHANOM = ' '
  141. ENDIF
  142.  
  143. C------------------ cas du CHPOINT ou du MCHAML --------------------
  144.  
  145. IF((IRETO2.EQ.1).OR.(IRETO3.EQ.1)) THEN
  146. C Cas general, on recupere les LISTREELs de l'evolution
  147. IF (IRETO4.EQ.1) THEN
  148. SEGACT MEVOLL
  149. IEV1 = IEVOLL(/1)
  150. IF (IEV1.NE.1) THEN
  151. CALL ERREUR(687)
  152. RETURN
  153. ENDIF
  154. KEVOLL=IEVOLL(1)
  155. SEGACT KEVOLL
  156. MLREE1 = IPROGX
  157. MLREE2 = IPROGY
  158. SEGACT MLREE1,MLREE2
  159. IF (MLREE1.PROG(/1) .LT. 2 .OR. MLREE2.PROG(/1) .LT. 2) THEN
  160. * la dimension des LISTREEL doit etre plus grande que 1
  161. SEGSUP MCHARG,ICHARG
  162. CALL ERREUR(897)
  163. RETURN
  164. ENDIF
  165. ICHPO2=IPROGX
  166. ICHPO3=IPROGY
  167. C Cas du chargement constant
  168. ELSE
  169. ICHPO2=0
  170. ICHPO3=0
  171. ENDIF
  172. IF(IRETO2.EQ.1) THEN
  173. CHATYP = 'CHPOINT '
  174. ICHPO1 = ICH1
  175. ELSE
  176. CHATYP = 'MCHAML '
  177. ICHPO1 = ICH2
  178. ENDIF
  179. IF (CHATYP.EQ.'CHPOINT ') THEN
  180. MCHPOI = ICH1
  181. CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  182. C SEGACT,MCHPOI
  183. IF (IPCHP(/1) .GE. 1) THEN
  184. MSOUPO = IPCHP(1)
  185. C SEGACT,MSOUPO
  186. IF ((NOCOMP(1).EQ.'FX '.OR.NOCOMP(1).EQ.'FY '.OR.
  187. $ NOCOMP(1).EQ.'FZ '.OR.NOCOMP(1).EQ.'FR '.OR.
  188. $ NOCOMP(1).EQ.'FT '.OR.NOCOMP(1).EQ.'MR '.OR.
  189. $ NOCOMP(1).EQ.'MT '.OR.NOCOMP(1).EQ.'MX '.OR.
  190. $ NOCOMP(1).EQ.'MY '.OR.NOCOMP(1).EQ.'MZ ')
  191. $ .AND.(CHANOM.EQ.' ')) CHANOM = 'MECA'
  192. ENDIF
  193. ENDIF
  194.  
  195. *----------------------- cas avec LISTOBJE ----------------------
  196.  
  197. ELSEIF (IRETO5.EQ.1) THEN
  198. CHATYP = 'LISTOBJE'
  199. ICHPO1 = ILOB1
  200. ICHPO2 = ILRE1
  201.  
  202. C Verification de la dimension des deux listes :
  203. MLOBJE = ILOB1
  204. SEGACT, MLOBJE
  205. MLREEL = ILRE1
  206. SEGACT, MLREEL
  207. IF (LISOBJ(/1).NE.PROG(/1)) THEN
  208. CALL ERREUR(217)
  209. RETURN
  210. ENDIF
  211.  
  212. *------------------------- cas des TABLES -----------------------
  213.  
  214. ELSE
  215. C Forcement syntaxe avec TABLES
  216. C Si pas IRETO1, ERREUR(5) (cas impossible a priori)
  217. IF (IRETO1.NE.1) THEN
  218. CALL ERREUR(5)
  219. RETURN
  220. ENDIF
  221. CHATYP = 'TABLE '
  222. ICHPO1 = ITA1
  223. ICHPO2 = ITA2
  224. C dip : ajout de quelques tests sur les tables de chargement
  225. MTAB1 = ITA1
  226. MTAB2 = ITA2
  227. SEGACT,MTAB1,MTAB2
  228. C - les 2 tables doivent avoir la meme dimension
  229. I1 = MTAB1.MLOTAB
  230. I2 = MTAB2.MLOTAB
  231. IF (I1.NE.I2) THEN
  232. MOTERR(1:4)='CHAR'
  233. MOTERR(5:12)='TABLE '
  234. CALL ERREUR(125)
  235. RETURN
  236. ENDIF
  237. DO N=1,I1
  238. C - les indices des 2 tables doivent etre ENTIERs
  239. MOT3=MTAB1.MTABTI(N)
  240. MOT4=MTAB2.MTABTI(N)
  241. IF ((MOT3.NE.'ENTIER ').OR.(MOT4.NE.'ENTIER ')) THEN
  242. CALL ERREUR(647)
  243. RETURN
  244. ENDIF
  245. C - la table 1 doit contenir des FLOTTANTs
  246. MOT3=MTAB1.MTABTV(N)
  247. MOT4=MTAB2.MTABTV(N)
  248. IF (MOT3.NE.'FLOTTANT') THEN
  249. CALL ERREUR(692)
  250. RETURN
  251. ENDIF
  252. C SP : je retire ce test
  253. * => on peut mettre ce qu'on veut en indice de la 2e table
  254. C - la table 2 doit contenir des CHPOINTs ou des MCHAMLs
  255. C IF ((MOT4.NE.'CHPOINT ').AND.(MOT4.NE.'MCHAML ')) THEN
  256. C CALL ERREUR(694)
  257. C RETURN
  258. C ENDIF
  259. C - les indices doivent etre croissants de 0 a (N-1)
  260. IND1=MTAB1.MTABII(N)
  261. IND2=MTAB2.MTABII(N)
  262. IF ((IND1.NE.(N-1)).OR.(IND2.NE.(N-1))) THEN
  263. CALL ERREUR(647)
  264. RETURN
  265. ENDIF
  266. C - les instants de la table 1 doivent etre croissants
  267. IF (N.EQ.1) THEN
  268. XTPP=MTAB1.RMTABV(N)
  269. ELSE
  270. XTP1=MTAB1.RMTABV(N)
  271. IF (XTP1.LT.XTPP) THEN
  272. CALL ERREUR(285)
  273. RETURN
  274. ENDIF
  275. XTPP=XTP1
  276. ENDIF
  277. ENDDO
  278. ENDIF
  279. C----------------------- Lecture des mots-cle optionnels ------------------
  280. IRETOU = 0
  281. IRETO1 = 0
  282. IRETO2 = 0
  283. IF (MOT2.EQ.' ') CALL LIRCHA(MOT2,0,LCHA)
  284. IF (LCHA.NE.0) THEN
  285. IF (MOT2.EQ.'LIBR') THEN
  286. CHALIE = 'LIBR'
  287. CALL LIRCHA(MOT2,0,LCHA)
  288. ELSEIF(MOT2.EQ.'LIE ') THEN
  289. CHALIE='LIE '
  290. CALL LIRCHA(MOT2,0,LCHA)
  291. ELSE
  292. CHALIE='LIE '
  293. ENDIF
  294. ELSE
  295. CHALIE='LIE '
  296. ENDIF
  297.  
  298. IF (LCHA.NE.0) THEN
  299.  
  300. IF (MOT2.EQ.'TRAN') THEN
  301. CHAMOB = MOT2
  302. CALL LIROBJ('POINT ',IPT1,1,IRETO1)
  303. IF(IERR.NE.0) RETURN
  304. CALL CRELEM(IPT1)
  305. CALL CRECH1(IPT1,1)
  306. ICHPO4 = IPT1
  307. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  308. IF(IERR.NE.0) RETURN
  309.  
  310. ELSE IF (MOT2.EQ.'ROTA') THEN
  311. CHAMOB = MOT2
  312. CALL LIROBJ('POINT ',IPT1,1,IRETO1)
  313. IF(IERR.NE.0) RETURN
  314. CALL CRELEM(IPT1)
  315. CALL CRECH1(IPT1,1)
  316. ICHPO4 = IPT1
  317. IF (IDIM.GE.3) THEN
  318. CALL LIROBJ('POINT ',IPT2,1,IRETO2)
  319. IF(IERR.NE.0) RETURN
  320. CALL CRELEM(IPT2)
  321. CALL CRECH1(IPT2,1)
  322. ICHPO5 = IPT2
  323. ENDIF
  324. CALL LIROBJ('EVOLUTIO',MEVOLL,1,IRETOU)
  325. CALL ACTOBJ('EVOLUTIO',MEVOLL,1)
  326. IF(IERR.NE.0) RETURN
  327.  
  328. ELSE IF (MOT2.EQ.'TRAJ') THEN
  329. CHAMOB = MOT2
  330. CALL LIROBJ('CHPOINT ',ITA1,1,IRETO1)
  331. CALL ACTOBJ('CHPOINT ',ITA1,1)
  332. IF(IERR.NE.0) RETURN
  333.  
  334. ELSE
  335. *
  336. GOTO 900
  337. ENDIF
  338.  
  339. ELSE
  340. CHAMOB = 'STAT'
  341. ENDIF
  342. *
  343. IF ((MOT2.EQ.'TRAN').OR.(MOT2.EQ.'ROTA')) THEN
  344. SEGACT MEVOLL
  345. IEV1 = IEVOLL(/1)
  346. IF (IEV1.NE.1) THEN
  347. CALL ERREUR(687)
  348. RETURN
  349. ENDIF
  350. KEVOLL=IEVOLL(1)
  351. SEGACT KEVOLL
  352. MLREE1 = IPROGX
  353. MLREE2 = IPROGY
  354. SEGACT MLREE1,MLREE2
  355. IF (MLREE1.PROG(/1).LT.2.OR.MLREE2.PROG(/1).LT.2) THEN
  356. * la dimension des LISTREEL doit etre plus grande que 1
  357. SEGSUP ICHARG,MCHARG
  358. CALL ERREUR(897)
  359. RETURN
  360. ENDIF
  361. ICHPO6=IPROGX
  362. ICHPO7=IPROGY
  363. ELSE IF (MOT2.EQ.'TRAJ') THEN
  364. MCHPO2 = ITA1
  365. CALL ACTOBJ('CHPOINT ',MCHPO2,1)
  366. NSOUPO = MCHPO2.IPCHP(/1)
  367. IF (NSOUPO.GT.1) THEN
  368. SEGSUP ICHARG,MCHARG
  369. * le champ doit posseder une seule composante
  370. CALL ERREUR(898)
  371. RETURN
  372. ENDIF
  373. MSOUP2 = MCHPO2.IPCHP(1)
  374. C SEGACT MSOUP2
  375. NC = MSOUP2.NOCOMP(/2)
  376. IF (NC.GT.1) THEN
  377. SEGSUP ICHARG,MCHARG
  378. * le champ doit posseder une seule composante
  379. CALL ERREUR(898)
  380. RETURN
  381. ENDIF
  382. IF (MSOUP2.NOCOMP(1).NE.'TEMP') THEN
  383. SEGSUP ICHARG,MCHARG
  384. * le nom de la composante doit etre TEMP
  385. CALL ERREUR(898)
  386. RETURN
  387. ENDIF
  388.  
  389. ICHPO4 = MCHPO2
  390. ICHPO5 = MSOUP2.IGEOC
  391. MPOVA2 = MSOUP2.IPOVAL
  392. C SEGACT MPOVA2
  393. JG = MPOVA2.VPOCHA(/1)
  394. SEGINI MLREE2
  395. ICHPO6 = MLREE2
  396. DO IVO = 1,JG
  397. MLREE2.PROG(IVO) = MPOVA2.VPOCHA(IVO,1)
  398. ENDDO
  399. ENDIF
  400. *
  401. 900 CONTINUE
  402. CALL ACTOBJ('CHARGEME',MCHARG,1)
  403. CALL ECROBJ('CHARGEME',MCHARG)
  404. END
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  

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