Télécharger evreco.eso

Retour à la liste

Numérotation des lignes :

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

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