Télécharger evreco.eso

Retour à la liste

Numérotation des lignes :

  1. C EVRECO SOURCE CB215821 19/07/30 21:16:12 10273
  2. SUBROUTINE EVRECO(LCOUL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C OPTION RECO DE L'OPERATEUR EVOL
  7. C
  8. C.1.EVOLUTION D'UN DDL DANS L'OBJET SOLUTION:
  9. C MEVOL = EVOL COUL RECO MSOLUT BASE TYPE PT1 COMP (INSTANTS) ;
  10. C ---- ---- ---- ----
  11. C
  12. C.2.EVOLUTION DE PLUSIEURS DDL DANS L'OBJET SOLUTION:
  13. C MEVOL = EVOL COUL RECO MSOLUT BASE TYPE CHP1 (INSTANTS) ;
  14. C
  15. C.3.EVOLUTION DE PLUSIEURS DDL DANS L'OBJET TABLE
  16. C MEVOL = EVOL COUL RECO TRESU TBASE TYPE PT1 COMP (INSTANTS) ;
  17. C ---- ---- ---- ----
  18. C
  19. C COUL : COULEUR DE LA (OU DES) COURBE(S)
  20. C MEVOL : OBJET DE TYPE EVOLUTION
  21. C MSOLUT : OBJET SOLUTION
  22. C TYPE : MOT CLE:TYPE DE LA VARIABLE (DEPL,VITE,ACCE,CONT..)
  23. C COMP : NOM DE LA COMPOSANTE CHOISIE
  24. C INSTANTS: PROCEDURE FACULTATIVE POUR CHOISIR LES CAS DE SORTIE
  25. C PROGX :OBJET LISTREEL, LISTE DES TEMPS A SORTIR
  26. C LECTC :OBJET LISTENTI, LISTE DES CAS A SORTIR
  27. C RIEN :L'OBJET EVOLUTION PORTE SUR TOUS LES CAS PRESENTS
  28. C DANS LE MSOLUT
  29. C
  30. C BASE : BASE ELEMENTAIRE
  31. C BASE STRU N
  32. C
  33. C PT1 : POINT OU MELEME A EXTRAIRE
  34. C CHP1 : CHPOINT CONTENANT LES POINTS ET DDL (FABRIQUE PAR
  35. C EXEMPLE PAR MANU CHPO )
  36. C
  37. C LES OBJETS PT1,CHP1 SERVENT A REPERER DANS LES CHAMPS
  38. C CHOISIS, LE(S) POINT(S) QUI INTERESSENT L'EVOLUTION.
  39. C
  40. C CREATION : 16/10/85, FARVACQUE
  41. C
  42. C=======================================================================
  43. -INC CCOPTIO
  44. -INC SMSOLUT
  45. -INC SMTABLE
  46. -INC SMBASEM
  47. -INC SMEVOLL
  48. -INC SMELEME
  49. -INC SMLENTI
  50. -INC SMLREEL
  51. -INC SMLMOTS
  52. -INC SMCHPOI
  53. LOGICAL L0,L1
  54. SEGMENT NUMOO
  55. INTEGER NUMO(N),KLIST(N)
  56. CHARACTER*4 NUDDL(N)
  57. ENDSEGMENT
  58. CHARACTER*4 TI1,CHA4
  59. CHARACTER*8 ITYPE,ITYP1,CTYP,TYPRET,CHARRE
  60. CHARACTER*72 TI,MCHA,NOMCO,MTIT1
  61. PARAMETER(NCLE=5)
  62. CHARACTER*4 MOTIT1(1),MOCLE(NCLE)
  63. CHARACTER*12 MOCLE2(NCLE),MODYN
  64. DATA MOTIT1/'LEGE'/
  65. DATA MOCLE/'DEPL','VITE','ACCE','CONT','REAC'/
  66. DATA MOCLE2/'DEPLACEMENT','VITESSE','ACCELERATION',
  67. & 'DEPLACEMENT','DEPLACEMENT'/
  68. POINTEUR LCOUL.MLENTI
  69. C
  70. C LECTURE OPTIONNELLE DU TITRE DE LA SOUS EVOLUTION DE LA COURBE (LEGE) :
  71. MTIT1=' '
  72. ITIT1=0
  73. CALL LIRMOT(MOTIT1,1,ITIT1,0)
  74. IF(ITIT1.EQ.1) THEN
  75. CALL LIRCHA(MTIT1,1,IRETOU)
  76. IF(IERR.NE.0) RETURN
  77. ENDIF
  78.  
  79. C=======================================================================
  80. ICONT=0
  81. KPSMO=0
  82. ISOLU=0
  83. ITABL=0
  84. *
  85. *---- type du prochain objet a lire ( TABLE ou SOLUTION )
  86. *
  87. CALL QUETYP (CTYP,1,IRETOU)
  88. IF (IERR.NE.0) RETURN
  89.  
  90. c-----------------------------------------------------------------------
  91. c SYNTAXE AVEC LISTCHPO
  92. c-----------------------------------------------------------------------
  93. IF (CTYP.EQ.'LISTCHPO') THEN
  94. *
  95. * LISTCHPO DES COEFFICIENTS DE PROJECTION
  96. * =======================================
  97. CALL LIROBJ('LISTCHPO',ILCHP1,1,IRET)
  98. CALL ACTOBJ('LISTCHPO',ILCHP1,1)
  99. IF (IERR.NE.0) RETURN
  100. *
  101. * LISTE DES INSTANTS
  102. * ==================
  103. CALL LIROBJ('LISTREEL',ILREE1,1,IRET)
  104. CALL ACTOBJ('LISTREEL',ILREE1,1)
  105. IF (IERR.NE.0) RETURN
  106. *
  107. * TABLE DE MODES
  108. * ==============
  109. CALL LIRTAB('BASE_MODALE',ITBAS1,1,IRET)
  110. IF (IERR.NE.0) RETURN
  111. *
  112. * NOMBRE DE MODES
  113. * ===============
  114. CALL LIRENT(NMOD1,0,IRET)
  115. IF (IRET.EQ.0) NMOD1=0
  116. *
  117. * LISTE DES COMPOSANTES
  118. * =====================
  119. ILMOT1=0
  120. CALL LIROBJ('LISTMOTS',ILMOT1,0,IRET)
  121. IF (IRET.EQ.0) THEN
  122. CALL LIRCHA(CHA4,0,IRETOU)
  123. IF (IRETOU.GT.0) THEN
  124. JGN=4
  125. JGM=1
  126. SEGINI,MLMOTS
  127. MOTS(1)=CHA4
  128. ILMOT1=MLMOTS
  129. ENDIF
  130. ENDIF
  131. *
  132. * GEOMETRIE
  133. * =========
  134. CALL LIROBJ('POINT ',IPO1,0,IRET)
  135. IF (IRET.NE.0) THEN
  136. NBNN=1
  137. NBELEM=1
  138. NBSOUS=0
  139. NBREF=0
  140. SEGINI,MELEME
  141. ITYPEL=1
  142. NUM(1,1)=IPO1
  143. IMA1=MELEME
  144. ELSE
  145. CALL LIROBJ('MAILLAGE',IMA1,1,IRET)
  146. CALL ACTOBJ('MAILLAGE',IMA1,1)
  147. ENDIF
  148. *
  149. * CALCUL DE LA RECOMBINAISON MODALE
  150. * =================================
  151. CALL RECLCH(ILCHP1,ITBAS1,NMOD1,ILCHP2)
  152. IF (IERR.NE.0) RETURN
  153. *
  154. * CREATION DE L'OBJET EVOLUTION
  155. * =============================
  156. CALL CREVLC(ILREE1,ILCHP2,IMA1,ILMOT1,LCOUL,MTIT1,IEVOL1)
  157. IF (IERR.NE.0) RETURN
  158. CALL ACTOBJ('EVOLUTIO',IEVOL1,1)
  159. CALL ECROBJ('EVOLUTIO',IEVOL1)
  160. *
  161. RETURN
  162.  
  163. ENDIF
  164.  
  165.  
  166. c-----------------------------------------------------------------------
  167. c SYNTAXE AVEC TABLE ou SOLUTION
  168. c-----------------------------------------------------------------------
  169. SEGACT,LCOUL
  170. ICOUL=LCOUL.LECT(1)
  171. SEGDES,LCOUL
  172.  
  173. *
  174. * --- on lit le type du champ a traiter et le nom de la composante
  175. cbp -deb-
  176. c CALL LIRCHA(MCHA,1,IRETOU)
  177. CALL LIRMOT(MOCLE,NCLE,ICLE,1)
  178. IF(IERR.NE.0) RETURN
  179. MCHA=' '
  180. MCHA(1:4)=MOCLE(ICLE)
  181. LCHALU=4
  182. MODYN=MOCLE2(ICLE)
  183. cbp -fin-
  184. IF (MCHA.EQ.'CONT') ICONT = 1
  185. IF (MCHA.EQ.'REAC') ICONT = 2
  186. cbp LCHALU=IRETOU
  187. CALL LIRCHA(NOMCO,0,IRETOU)
  188. IF(IRETOU.EQ.0) NOMCO=' '
  189. *
  190. * --- on recupere le point ou le maillage ou le chpoint
  191. CALL LIROBJ('POINT ',IRET,0,IRETOU)
  192. IF (IRETOU.EQ.0) THEN
  193. CALL LIROBJ('MAILLAGE',IRET,0,IRETOU)
  194. IF (IRETOU.EQ.0) THEN
  195. CALL LIROBJ('CHPOINT ',IRET,0,IRETOU)
  196. IF (IRETOU.EQ.0) THEN
  197. * on ne trouve pas le support qui contient les points
  198. CALL ERREUR(248)
  199. RETURN
  200. ELSE
  201. ITYPE='CHPOINT'
  202. CALL ACTOBJ('CHPOINT ',IRET,1)
  203. ENDIF
  204. ELSE
  205. ITYPE='MAILLAGE'
  206. CALL ACTOBJ('MAILLAGE',IRET,1)
  207. ENDIF
  208. ELSE
  209. ITYPE='POINT'
  210. ENDIF
  211. iptu = iret
  212.  
  213. *--------------------------------------------
  214. *---cas d'un objet de type TABLE ------------
  215. *--------------------------------------------
  216.  
  217. *------ sous cas d'une table PASAPAS --------
  218.  
  219. call lirtab('PASAPAS',ITAP,0,iretou)
  220. if (iretou.gt.0) then
  221. call lirobj('MMODEL ', IPMODE,1,iretou)
  222. call actobj('MMODEL ', IPMODE,1)
  223. if (ierr.ne.0) return
  224.  
  225. CALL LIROBJ('MCHAML ',IPIN,1,IRETOU)
  226. CALL ACTOBJ('MCHAML ',IPIN,1)
  227. if (ierr.ne.0) return
  228. CALL REDUAF(IPIN,IPMODE,IPCHA1,0,IR,KER)
  229. IF(IR .NE. 1) CALL ERREUR(KER)
  230. IF(IERR .NE. 0) RETURN
  231.  
  232. if (iretou.gt.0) call EVREC6(itap,ipmode,ipcha1,mcha,nomco,
  233. &itype,iptu,ipevo)
  234. if (ierr.ne.0) return
  235. if (ipevo.gt.0) then
  236. call actOBJ('EVOLUTION',ipevo,1)
  237. call ECROBJ('EVOLUTION',ipevo)
  238. endif
  239. return
  240. endif
  241.  
  242. *------ sous cas d'une table DYNE --------
  243.  
  244. IF (CTYP(1:5).EQ.'TABLE') THEN
  245. ITABL = 1
  246. CALL LIRTAB ('RESULTAT_DYNE',ISTA,1,IRETOU)
  247. IF (IERR.NE.0) RETURN
  248. CALL LIRTAB ('BASE_MODALE',ISBM,0,IRETOU)
  249. IF (IRETOU.EQ.0) THEN
  250. CALL LIRTAB ('ENSEMBLE_DE_BASES',ISEB,1,IRETOU)
  251. IF (IERR.NE.0) RETURN
  252. IT = 0
  253. 56 CONTINUE
  254. IT = IT + 1
  255. TYPRET = ' '
  256. CALL ACCTAB (ISEB,'ENTIER',IT,X0,' ',L0,IRET0,
  257. & TYPRET,I1,X1,CHARRE,L1,ISBM)
  258. IF (ISBM.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
  259. CALL ACCTAB (ISBM,'MOT',I0,X0,'MODES',L0,IRET0,
  260. & 'TABLE',I1,X1,' ',L1,ISTB)
  261. CALL ACCTAB (ISTB,'MOT',I0,X0,'MAILLAGE',L0,IRET0,
  262. & 'MAILLAGE',I1,X1,' ',L1,IMAIL)
  263. CALL EXTR12(IMAIL,IRET,IRE12)
  264. c => avec un ENSEMBLE_DE_BASES seule la syntaxe avec 1 point
  265. IF (IRE12.EQ.0) GOTO 56
  266. TYPRET = ' '
  267. CALL ACCTAB (ISBM,'MOT',I0,X0,'PSEUDO_MODES',L0,IRET0,
  268. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  269. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') KPSMO = 1
  270. ELSE
  271. RETURN
  272. ENDIF
  273. ELSE
  274. CALL ACCTAB (ISBM,'MOT',I0,X0,'MODES',L0,IRET0,
  275. & 'TABLE',I1,X1,' ',L1,ISTB)
  276. TYPRET = ' '
  277. CALL ACCTAB (ISBM,'MOT',I0,X0,'PSEUDO_MODES',L0,IRET0,
  278. & TYPRET,I1,X1,CHARRE,L1,ITPS)
  279. IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') KPSMO = 1
  280. ENDIF
  281. ENDIF
  282.  
  283. *--------------------------------------------
  284. *---cas d'un objet de type SOLUTION ---------
  285. *--------------------------------------------
  286.  
  287. IF (CTYP(1:8).EQ.'SOLUTION') THEN
  288. CALL LIROBJ('SOLUTION',KSOLU,1,IRETOU)
  289. IF(IERR.NE.0) RETURN
  290. ISOLU = 1
  291. MSOLUT=KSOLU
  292. C lecture de la base elementaire
  293. CALL LIRBAS(1,IBOBAS,IBOSEM)
  294. MSOBAS=IBOBAS
  295. C MBASEM=IBOSEM
  296. IF(IERR.NE.0) RETURN
  297. ENDIF
  298.  
  299. *----------------------------------------------------------
  300. *------- fin des cas TABLE/SOLUTION
  301. * et sous cas TABLE PASAPAS / TABLE DYNE ---------
  302. *----------------------------------------------------------
  303.  
  304.  
  305. C---- lecture du chargement pour les pseudo-modes
  306. KCHAR = 0
  307. CALL LIROBJ('CHARGEME',KCHAR,0,IRETOU)
  308. IF(IRETOU .EQ. 1)CALL ACTOBJ('CHARGEME',KCHAR,1)
  309.  
  310. C---- lecture des instants
  311. IPX=0
  312. ITOUS=0
  313. ILX=0
  314. CALL LIROBJ('LISTREEL',IPX,0,IRETOU)
  315. IF(IRETOU.EQ.0) CALL LIROBJ('LISTENTI',ILX,0,IRETOU)
  316. IF(IRETOU.EQ.0) ITOUS=1
  317.  
  318. C----------------------------------------------------
  319. c remplissage des tableaux de NUMOO
  320. C----------------------------------------------------
  321. c sortie : NUMOO.NUMO(i) = numero de noeud du i^eme ddl a traiter
  322. c NUMOO.NUDDL(i)= composante du i^eme ddl a traiter
  323. CALL EVNUMO(ITYPE,IRET,NOMCO,IBOO)
  324. NUMOO=IBOO
  325. IF(IERR.NE.0) RETURN
  326.  
  327.  
  328. *--------------------------------------------
  329. *---cas d'un objet de type SOLUTION ---------
  330. *--------------------------------------------
  331. IF (ISOLU.EQ.1) THEN
  332.  
  333. SEGACT MSOLUT
  334. IF (MCHA.EQ.'CONT') MCHA = 'DEPL'
  335. MOTERR(1:8)=ITYSOL
  336. CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT)
  337. IF(ICHA.EQ.0) THEN
  338. * erreur dans le type du champ
  339. MOTERR(1:8)='SOLUTION'
  340. MOTERR(9:26)=ITYSOL
  341. MOTERR(30:38)=MCHA
  342. CALL ERREUR(235)
  343. RETURN
  344. ENDIF
  345. MSOLEN=MSOLIS(ICHA)
  346. IF(MSOLEN.EQ.0) THEN
  347. * ce type de champ est vide dans le MSOLUT
  348. MOTERR(1:8)='SOLUTION'
  349. MOTERR(9:26)=ITYSOL
  350. MOTERR(30:38)=MCHA
  351. CALL ERREUR(235)
  352. RETURN
  353. ENDIF
  354. IF (ITYSOL.NE.'DYNAMIQU') THEN
  355. * option non disponible
  356. MOTERR(1:8)='SOLUTION'
  357. MOTERR(9:16)=ITYSOL
  358. CALL ERREUR(131)
  359. RETURN
  360. ENDIF
  361. IF (MSOLIT(ICHA).NE.2) THEN
  362. * la sortie porte sur des CHAMELEM
  363. * option non disponible
  364. CALL ERREUR(19 )
  365. RETURN
  366. ENDIF
  367. IBOS=MSOLUT
  368. * verification des instants de sortie
  369. * dans IPX le LISTREEL a mettre dans IPROGX
  370. * dans ILEX le LISTENTI qui contient les numeros des champs
  371. CALL VERIDY(IBOS,IPX,ICHA,ITOUS,ILEX,ITYP1)
  372. IF(IERR.NE.0) RETURN
  373. MSOLUT=IBOS
  374. *
  375. IBOBAS=MSOBAS
  376. IBOO=NUMOO
  377. CALL EVOL2(IBOO,ILEX,IBOBAS,ICONT)
  378. IF(IERR.NE.0) RETURN
  379. MSOBAS=IBOBAS
  380. NUMOO=IBOO
  381. MLENTI=ILEX
  382. SEGSUP MLENTI
  383. *
  384. * prise en compte des pseudo-modes
  385. *
  386. SEGACT MSOBAS
  387. IMODE = IBSTRM(2)
  388. ILIAI = IBSTRM(4)
  389. KPSMO = IBSTRM(5)
  390. SEGDES MSOBAS
  391. IF (KPSMO.NE.0) THEN
  392. IF (ILIAI.NE.0) THEN
  393. MSOLUT = KSOLU
  394. SEGACT MSOLUT
  395. MOTERR(1:8) = ITYSOL
  396. MCHA = 'LIAI'
  397. CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT)
  398. IF (ICHA.EQ.0) THEN
  399. MOTERR(1:8)='SOLUTION'
  400. MOTERR(9:26)=ITYSOL
  401. MOTERR(30:38)=MCHA
  402. CALL ERREUR(235)
  403. RETURN
  404. ENDIF
  405. MSOLEN = MSOLIS(ICHA)
  406. IF (MSOLEN.EQ.0) THEN
  407. MOTERR(1:8)='SOLUTION'
  408. MOTERR(9:26)=ITYSOL
  409. MOTERR(30:38)=MCHA
  410. CALL ERREUR(235)
  411. RETURN
  412. ENDIF
  413. SEGDES MSOLUT
  414. ITOU2 = 0
  415. IBOS = KSOLU
  416. CALL VERIDY(IBOS,IPX,ICHA,ITOU2,ILEX2,ITYP1)
  417. IF (IERR.NE.0) RETURN
  418. ELSE
  419. ILEX2 = 0
  420. ENDIF
  421. IBOO = NUMOO
  422. CALL PSEVO1(IMODE,KPSMO,IBOO,IPX,ILEX2,KCHAR,ICONT)
  423. NUMOO = IBOO
  424. ENDIF
  425.  
  426. ENDIF
  427.  
  428. *-------------------------------------------------
  429. *---cas d'un objet de type TABLE DYNE ------------
  430. *-------------------------------------------------
  431.  
  432. IF (ITABL.EQ.1) THEN
  433.  
  434.  
  435. cbp QUEL TYPE DE SORTIE DE LA TABLE DYNE (CHPOINT OU LISTREEEL)?
  436.  
  437. * ------ sous cas d'un LISTREEL
  438. * dans la table . 'DEPLACEMENT' . ptalfa --------
  439.  
  440. c existe-t-il le LISTREEL dans la table . 'DEPLACEMENT' ?
  441. TYPRET=' '
  442. CALL ACCTAB (ISTA ,'MOT',I0,X0,MODYN,L0,IRET0,
  443. & TYPRET,I1,X1,' ',L1,IDYN1)
  444.  
  445. IF(TYPRET.EQ.'TABLE'.AND.IDYN1.NE.0) THEN
  446.  
  447. * sortie : ILEN1 = liste des deformees modales [phi_j]
  448. * ILEN2 = liste des points reperes
  449. CALL CHCHA2 (ISTB,ILEN1,ILEN2,ICONT)
  450. IF(IERR.NE.0) RETURN
  451.  
  452. c ILEN3 =liste des LISTREEL des alpha_j(t)
  453. MLENT2=ILEN2
  454. SEGACT,MLENT2
  455. JG=MLENT2.LECT(/1)
  456. SEGINI,MLENT3
  457. ILEN3=MLENT3
  458. DO I=1,JG
  459. IPREP2=MLENT2.LECT(I)
  460. CALL ACCTAB (IDYN1,'POINT',I0,X0,' ',L0,IPREP2,
  461. & 'LISTREEL',I1,X1,' ',L1,IRET1)
  462. MLENT3.LECT(I)=IRET1
  463. ENDDO
  464. claisse actif SEGDES,MLENT2,MLENT3
  465.  
  466. c creation d'une listenti des indices a sortir pour l'evolution
  467. CALL VERIT3(ISTA,IPX,ITOUS,ILEX,ITYP1)
  468.  
  469. * Travail effectif (= Recombinaison modale)
  470. * sortie : NUMOO.KLIST(k) = pointeur vers le k^ieme listreel resultat
  471. IBOO=NUMOO
  472. CALL EVOL23(IBOO,ILEX,ILEN1,ILEN3)
  473. SEGDES,MLENT2,MLENT3
  474.  
  475. GOTO 2001
  476.  
  477. ENDIF
  478.  
  479. * ------ sous cas de CHPOINTS dans la table . I . 'DEPL' --------
  480.  
  481. ICHA =0
  482. * on prend l'indice 1 de la table (IRET1 = table du pas 1)
  483. CALL ACCTAB (ISTA ,'ENTIER',1,X0,' ',L0,IRET0,
  484. & 'TABLE',I1,X1,' ',L1,IRET1)
  485.  
  486. c recherche de l'indice MCHA dans la table du pas 1
  487. IF (ICONT.EQ.1) MCHA = 'DEPL'
  488. IF (ICONT.EQ.2) MCHA = 'DEPL'
  489. IBOBO=IRET1
  490. CALL CHTCHA (MCHA,LCHALU,IBOBO,ICHA)
  491. IF (ICHA.EQ.0) THEN
  492. * erreur dans le type du champ :
  493. cbp MOTERR(1:8)= MCHA(1:8)
  494. MOTERR(1:8)='TABLE '
  495. MOTERR(9:26)='RESULTAT_DYNE '
  496. MOTERR(30:38)=MCHA
  497. CALL ERREUR(235)
  498. c Dans l'objet solution de type DEPL on ne trouve pas la liste des DEPL
  499. RETURN
  500. ENDIF
  501.  
  502. * verification des instants de sortie
  503. * entree : IPX = LISTREEL des instants (a mettre dans IPROGX)
  504. * ITOUS = 1 si IPX non fourni (on recherche alors tous
  505. * les instants), =0 sinon
  506. * sortie : ILEX = LISTENTI des pointeurs vers les champs
  507. * aux temps souhaites { alpha(t_1) ... }
  508. CALL VERITA(ISTA,IPX,ICHA,ITOUS,ILEX,ITYP1)
  509. IF (IERR.NE.0) RETURN
  510. *
  511. * sortie : ILEN1 = liste des deformees modales [phi_j]
  512. * ILEN2 = liste des points reperes
  513. CALL CHCHA2 (ISTB,ILEN1,ILEN2,ICONT)
  514. IF(IERR.NE.0) RETURN
  515. *
  516. * Travail effectif (= Recombinaison modale)
  517. * sortie : NUMOO.KLIST(k) = pointeur vers le k^ieme listreel resultat
  518. IBOO=NUMOO
  519. CALL EVOL22 (IBOO,ILEX,ILEN1,ILEN2)
  520. IF(IERR.NE.0) RETURN
  521. NUMOO=IBOO
  522.  
  523.  
  524. * ------ partie commune aux 2 sous cas --------
  525. 2001 CONTINUE
  526. *
  527. * prise en compte de la rotation des corps rigides
  528. *
  529. IF (MCHA(1:4).EQ.'DEPL') THEN
  530. * On regarde si on a une base de corps rigide
  531. CALL VERRIG(ISTB,IROT,ICDG,ILEN1,ILEN2,IDEFO)
  532. IF (IROT.NE.0) THEN
  533. IBOO = NUMOO
  534. * Recombinaison des deplacements
  535. CALL EVORIG(IROT,ICDG,IBOO,ILEX,0,0,0,IDEFO)
  536. NUMOO = IBOO
  537. ENDIF
  538. ELSE
  539. IF (MCHA(1:4).EQ.'VITE') THEN
  540. * On regarde si on a une base de corps rigide
  541. CALL VERRIG(ISTB,IROT,ICDG,ILEN1,ILEN2,IDEFO)
  542. IF (IROT.NE.0) THEN
  543. * On recupere les angles de rotation
  544. CALL CHTCHA('DEPL',4,IBOBO,ICHARO)
  545. IF (ICHARO.EQ.0) THEN
  546. c MOTERR(1:8)=MCHA(1:8)
  547. c MOTERR(9:12)=MCHA
  548. MOTERR(1:8)='TABLE '
  549. MOTERR(9:26)='RESULTAT_DYNE '
  550. MOTERR(30:38)=MCHA
  551. CALL ERREUR(235)
  552. RETURN
  553. ENDIF
  554. CALL VERITA(ISTA,IPX,ICHARO,ITOUS,ILEXRO,ITYP1)
  555. IBOO = NUMOO
  556. * On recombine les vitesses
  557. CALL EVORIG(IROT,ICDG,IBOO,ILEX,1,ILEXRO,0,IDEFO)
  558. NUMOO = IBOO
  559. ENDIF
  560. ELSE
  561. IF (MCHA(1:4).EQ.'ACCE') THEN
  562. * On regarde si on a une base de corps rigide
  563. CALL VERRIG(ISTB,IROT,ICDG,ILEN1,ILEN2,IDEFO)
  564. IF (IROT.NE.0) THEN
  565. * On recupere les angles de rotation
  566. CALL CHTCHA('DEPL',4,IBOBO,ICHARO)
  567. IF (ICHARO.EQ.0) THEN
  568. c MOTERR(1:8)=MCHA(1:8)
  569. c MOTERR(9:12)=MCHA
  570. MOTERR(1:8)='TABLE '
  571. MOTERR(9:26)='RESULTAT_DYNE '
  572. MOTERR(30:38)=MCHA
  573. CALL ERREUR(235)
  574. RETURN
  575. ENDIF
  576. CALL VERITA(ISTA,IPX,ICHARO,ITOUS,ILEXRO,ITYP1)
  577. * On recupere les vitesses de rotation
  578. CALL CHTCHA('VITE',4,IBOBO,ICHAVI)
  579. IF (ICHAVI.EQ.0) THEN
  580. c MOTERR(1:8)=MCHA(1:8)
  581. c MOTERR(9:12)=MCHA
  582. MOTERR(1:8)='TABLE '
  583. MOTERR(9:26)='RESULTAT_DYNE '
  584. MOTERR(30:38)=MCHA
  585. CALL ERREUR(235)
  586. RETURN
  587. ENDIF
  588. CALL VERITA(ISTA,IPX,ICHAVI,ITOUS,ILEXVI,ITYP1)
  589. IBOO = NUMOO
  590. * On recombine les accelerations
  591. CALL EVORIG(IROT,ICDG,IBOO,ILEX,-1,ILEXRO,
  592. &ILEXVI,IDEFO)
  593. NUMOO = IBOO
  594. ENDIF
  595. ENDIF
  596. ENDIF
  597. ENDIF
  598. MLENTI=ILEN1
  599. SEGSUP MLENTI
  600. MLENTI=ILEN2
  601. SEGSUP MLENTI
  602. MLENTI=ILEX
  603. SEGSUP MLENTI
  604. *
  605. * prise en compte des pseudo-modes
  606. *
  607. IF (KPSMO.EQ.1) THEN
  608. IF (KCHAR.NE.0) THEN
  609. IBOO = NUMOO
  610. CALL PSEVRC(ICONT,ITPS,ISTB,IBOO,IPX,KCHAR)
  611. NUMOO = IBOO
  612. ELSE
  613. CALL ERREUR(430)
  614. ENDIF
  615. ENDIF
  616. ENDIF
  617.  
  618. *--------------------------------------------
  619. * initialisation du MEVOLL resultat
  620. *--------------------------------------------
  621. *
  622. IF (ICONT.EQ.1) MCHA='CONT'
  623. IF (ICONT.EQ.2) MCHA='REAC'
  624. N=NUMO(/1)
  625. SEGINI MEVOLL
  626. ITYEVO='REEL'
  627. TI(1:72)=TITREE
  628. IEVTEX=TI
  629. DO 2080 I=1,N
  630. SEGINI KEVOLL
  631. TYPX='LISTREEL'
  632. TYPY='LISTREEL'
  633. IPROGX=IPX
  634. IPROGY=KLIST(I)
  635. NOMEVX=ITYP1
  636. NOMEVY(1:4)=MCHA
  637. WRITE (NOMEVY(5:8),FMT='(I4)') NUMO(I)
  638. NOMEVY(9:12)=NUDDL(I)
  639. c KEVTEX=TI
  640. IF(ITIT1.EQ.0) MTIT1(1:12)=NOMEVY(1:12)
  641. KEVTEX=MTIT1
  642. NUMEVY='REEL'
  643. NUMEVX=ICOUL
  644. SEGDES KEVOLL
  645. IEVOLL(I)=KEVOLL
  646. 2080 CONTINUE
  647. SEGDES MEVOLL
  648. SEGSUP NUMOO
  649. CALL ACTOBJ('EVOLUTIO',MEVOLL,1)
  650. CALL ECROBJ('EVOLUTIO',MEVOLL)
  651. *
  652. END
  653.  
  654.  
  655.  
  656.  
  657.  

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