Télécharger recomb.eso

Retour à la liste

Numérotation des lignes :

  1. C RECOMB SOURCE CB215821 16/12/05 22:04:29 9237
  2. SUBROUTINE RECOMB
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *_______________________________________________________________________
  6. *
  7. * OPERATEUR RECO :
  8. * RECOMBINAISON EN ANALYSE MODALE.
  9. *
  10. * ANCIENNE SYNTAXE:
  11. * ================
  12. * ******** B EST UNE BASE ELEMENTAIRE
  13. * ----------------
  14. * X1 = RECO XA B DEPL;
  15. * X2 = RECO XA B CONT;
  16. *
  17. * ******** B EST UNE BASE COMPLEXE: STR1 EST LA STRUCTURE
  18. * ------------- POUR LAQUELLE LA
  19. * RECOMBINAISON S'EFFECTUE, ET N LE NUMERO DE
  20. * LA SOUS-STRUCTURE SI CELLE CI EST FORMEE DE
  21. * SOUS-STRUCTURES IDENTIQUES.
  22. *
  23. * X1 = RECO XA B STR1 (N) DEPL ;
  24. * X2 = RECO XA B STR1 (N) CONT ;
  25. *
  26. * XA : OBJET CHPOINT CONTENANT LES CONTRIBUTIONS MODALES
  27. * DEPL : ON RECOMBINE DES DEPLACEMENTS. X1 EST UN CHPOINT
  28. * CONT : ON RECOMBINE DES CONTRAINTES . X2 EST UN CHELEM
  29. *
  30. * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 02/91
  31. * EXTENSION AU CAS OU XA EST UN LISTCHPO LE 7/04/2016
  32. *
  33. *
  34. *_______________________________________________________________________
  35. *
  36. -INC CCOPTIO
  37. -INC CCREEL
  38. -INC SMBASEM
  39. -INC SMCHPOI
  40. -INC SMLCHPO
  41. -INC SMLREEL
  42. -INC SMSOLUT
  43. -INC SMSTRUC
  44. LOGICAL L0,L1,LOGIN,LOGRE
  45. PARAMETER ( LMOOPT = 5 , IUN = 1 )
  46. CHARACTER*4 MOOPT(LMOOPT)
  47. CHARACTER*(8) ITYPE,CTYP,TYPOBJ
  48. CHARACTER*(16) TYPTAB
  49. CHARACTER*72 CHARRE
  50. DATA MOOPT/'DEPL','CONT','VITE','ACCE','REAC'/
  51.  
  52.  
  53. C---- Lecture de l'objet resultat + Aiguillage
  54. c qui determine (en partie) dans quel cas on est -------------------
  55.  
  56. c-----CHPOINT
  57. ILECT=0
  58. CALL LIROBJ('CHPOINT ',ICHP1,0,IRET3)
  59. c write(6,*) 'CHPOINT?',IRET3
  60. IF(IRET3.EQ.1) GOTO 300
  61.  
  62. c-----LISTCHPO
  63. CALL LIROBJ('LISTCHPO',ILCHP1,0,IRET23)
  64. IF (IRET23.EQ.1) THEN
  65.  
  66. * TABLE DE MODES
  67. CALL LIRTAB('BASE_MODALE',ITBAS1,1,IRET)
  68. IF (IERR.NE.0) RETURN
  69.  
  70. * NOMBRE DE MODES
  71. CALL LIRENT(NMOD1,0,IRET)
  72. IF (IRET.EQ.0) NMOD1=0
  73.  
  74. CALL RECLCH(ILCHP1,ITBAS1,NMOD1,ILCHP2)
  75. IF (IERR.NE.0) RETURN
  76. CALL ECROBJ('LISTCHPO',ILCHP2)
  77.  
  78. RETURN
  79.  
  80. ENDIF
  81.  
  82.  
  83. c-----TABLE
  84. CALL LIROBJ('TABLE ',ITAB1,0,IRET12)
  85. c write(6,*) 'TABLE?',IRET12
  86. IF(IRET12.EQ.0) GOTO 9
  87.  
  88. C---- Lecture du mot clé -----------------------------------------------
  89. IMOO=0
  90. CALL LIRMOT(MOOPT,LMOOPT,IMOO,0)
  91.  
  92.  
  93. c -table PASAPAS ?
  94. c CALL LIRTAB('PASAPAS',ITPASA,0,IRET2)
  95. TYPOBJ = ' '
  96. TYPTAB ='PASAPAS'
  97. LE=7
  98. IRET2=0
  99. CALL ACCTAB(ITAB1,'MOT ',IVALIN,XVALIN,'SOUSTYPE',LOGIN,
  100. $ IOBIN, TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  101. c write(6,*) 'TABLE PASAPAS?',TYPOBJ,IVALRE,CHARRE(1:LE)
  102. IF(TYPOBJ.NE.'MOT ') GOTO 2
  103. IF(IVALRE.NE.LE) GOTO 2
  104. IF(CHARRE(1:LE).NE.TYPTAB) GOTO 2
  105. ITPASA=ITAB1
  106. IRET2=1
  107. c si table PASAPAS on recupere le chpoint qui va bien
  108. ITRES=ITPASA
  109. IF(IMOO.EQ.0) THEN
  110. WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un mot-cle'
  111. CALL ERREUR(21)
  112. RETURN
  113. ENDIF
  114. CALL REPEC2(ITRES,IMOO,ICHP1)
  115. ILECT=1
  116. GOTO 300
  117.  
  118. 2 CONTINUE
  119. c -table RESULTAT_DYNE ?
  120. c CALL LIRTAB('RESULTAT_DYNE',ITDYNE,0,IRET1)
  121. TYPOBJ = ' '
  122. TYPTAB ='RESULTAT_DYNE'
  123. LE=13
  124. IRET1=0
  125. CALL ACCTAB(ITAB1,'MOT ',IVALIN,XVALIN,'SOUSTYPE',LOGIN,
  126. $ IOBIN, TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  127. c write(6,*) 'TABLE PASAPAS?',TYPOBJ,IVALRE,CHARRE(1:LE)
  128. IF(TYPOBJ.NE.'MOT ') GOTO 9
  129. IF(IVALRE.NE.LE) GOTO 9
  130. IF(CHARRE(1:LE).NE.TYPTAB) GOTO 9
  131. ITDYNE=ITAB1
  132. IRET1=1
  133. GOTO 100
  134.  
  135. C-----ERREUR argument entree
  136. 9 CONTINUE
  137. WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un objet de type :'
  138. WRITE(IOIMP,*) '- TABLE de sous-type RESULTAT_DYNE,'
  139. WRITE(IOIMP,*) '- TABLE de sous-type PASAPAS,'
  140. WRITE(IOIMP,*) '- ou CHPOINT ou LISTCHPO'
  141. CALL ERREUR(21)
  142. RETURN
  143.  
  144.  
  145. C---- Cas d'un CHPOINT -------------------------------------------------
  146. 300 CONTINUE
  147.  
  148. c A partir de quelle objet recombine t'on ?
  149. c (modele, table ou basemoda)
  150.  
  151. C---- Cas d'un CHPOINT + MODELE modal ----------------------------------
  152. c CALL LIROBJ('MMODEL',IPMODL,ILECT,IRET)
  153. CALL LIROBJ('MMODEL',IPMODL,0,IRET)
  154. IF (IRET.NE.0) THEN
  155. CALL LIROBJ('MCHAML',IPIN,1,IRET1)
  156. if (IERR.NE.0) RETURN
  157. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IR,KER)
  158. IF(IR .NE. 1) CALL ERREUR(KER)
  159. IF(IERR .NE. 0) RETURN
  160.  
  161. CALL RECOF2(ipmodl,ipcha1,ichp1,ipout)
  162. if (IERR.NE.0) RETURN
  163. CALL ECROBJ('CHPOINT ',ipout)
  164. RETURN
  165. ENDIF
  166.  
  167. C---- Cas d'un CHPOINT + TABLES (LIAISONS_STATIQUES + BASE_MODALE) -----
  168. CALL LIRTAB('LIAISONS_STATIQUES',itst,0,iretst)
  169. CALL LIRTAB('BASE_MODALE',itbm,0,iretbm)
  170. if (ierr.ne.0) return
  171.  
  172. c -si on n'a pas lu de table on va vers l'ancienne syntaxe (BASEMODA)
  173. if (iretst.eq.0.and.iretbm.eq.0) GOTO 900
  174.  
  175. c -syntaxe avec une ou des tables
  176. CALL RECOF1(itst,itbm,ichp1,ipout)
  177. if (ierr.ne.0) return
  178. CALL ECROBJ('CHPOINT ',ipout)
  179. RETURN
  180.  
  181.  
  182. C---- Cas d'une TABLE de RESULTAT_DYNE ---------------------------------
  183. 100 CONTINUE
  184.  
  185. ITRES = ITDYNE
  186.  
  187. c qq initialisations
  188. KPSMO = 0
  189. KCHAR = 0
  190. KCHLIA = 0
  191. ITLIA = 0
  192. XTEMP = 0.D0
  193.  
  194. c Lecture obligatoire mot clé (DEPL,...)
  195. IF(IMOO.EQ.0) THEN
  196. WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un mot-cle'
  197. CALL ERREUR(21)
  198. RETURN
  199. ENDIF
  200.  
  201. c + temps pour lequel il faut restituer
  202. CALL LIRREE(XTEMP,1,IRET)
  203. IF (IERR.NE.0) RETURN
  204. XMPE = -XPETIT
  205. IF (XTEMP.LT.XMPE) THEN
  206. CALL ERREUR(431)
  207. RETURN
  208. ENDIF
  209.  
  210. C + table BASE_MODALE ou ENSEMBLE_DE_BASES
  211. CALL LIRTAB('BASE_MODALE',ITBAS,0,IRET)
  212. IF (IRET.EQ.0) THEN
  213. CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,1,IRET)
  214. ENDIF
  215. IF (IERR.NE.0) RETURN
  216.  
  217. c + facultative chargement et liaison
  218. CALL LIROBJ('CHARGEME',KCHAR,0,IRET)
  219. CALL LIRTAB('LIAISON',ITLIA,0,IRET)
  220.  
  221. c l'instant XTEMP correspond au pas de temps IPOS
  222. CALL ACCTAB(ITRES,'MOT',I0,X0,'TEMPS_DE_SORTIE',L0,IP0,
  223. & 'LISTREEL',I1,X1,' ',L1,LBO)
  224. MLREEL = LBO
  225. SEGACT MLREEL
  226. LTE = PROG(/1)
  227. PRECI = (PROG(LTE) - PROG(1)) / (LTE * 100)
  228. CALL PLACE3(PROG,IUN,LTE,XTEMP,IR,AR)
  229. IF (AR.LE.PRECI) THEN
  230. IPOS = IR
  231. ELSE
  232. ARR = ABS(1. - AR)
  233. IF (ARR.LE.PRECI) THEN
  234. IPOS = IR + 1
  235. ELSE
  236. MOTERR(1:8) = 'TABLE '
  237. MOTERR(9:16) ='LISTREEL'
  238. CALL ERREUR(135)
  239. SEGDES MLREEL
  240. RETURN
  241. ENDIF
  242. ENDIF
  243. SEGDES MLREEL
  244.  
  245. c Recuperation du CHPOINT a l'instant XTEMP
  246. c + Recombinaison via RCDEPL et RCCONT
  247. c (Ecriture du CHPOIN/MCHAML dans RCDEPL/RCCONT)
  248. CALL ACCTAB(ITRES,'ENTIER',IPOS,X0,' ',L0,IP0,
  249. & 'TABLE',I1,X1,' ',L1,ITDEP)
  250. IF (MOOPT(IMOO).EQ.'DEPL') THEN
  251. CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  252. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  253. CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,0)
  254. ELSE IF (MOOPT(IMOO).EQ.'VITE') THEN
  255. CALL ACCTAB(ITDEP,'MOT',I0,X0,'VITESSE',L0,IP0,
  256. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  257. CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,1)
  258. ELSE IF (MOOPT(IMOO).EQ.'ACCE') THEN
  259. CALL ACCTAB(ITDEP,'MOT',I0,X0,'ACCELERATION',L0,IP0,
  260. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  261. CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,-1)
  262. ELSE IF (MOOPT(IMOO).EQ.'REAC') THEN
  263. CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  264. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  265. CALL RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,2)
  266. ELSE
  267. CALL ACCTAB(ITDEP,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
  268. & 'CHPOINT',I1,X1,' ',L1,ICHPT)
  269. CALL RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  270. ENDIF
  271.  
  272. RETURN
  273. C---- fin du cas avec une TABLE de RESULTAT_DYNE -----------------------
  274.  
  275.  
  276.  
  277. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*
  278. * version appelee a disparaitre
  279. *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*
  280. 900 CONTINUE
  281. C---- Cas d'un CHPOINT + BASEMODA --------------------------------------
  282.  
  283. C Lecture obligatoire de la BASEMODA + un mot clé (DEPL,...)
  284. CALL LIROBJ ('BASEMODA',IP2,0,IRETOU)
  285. if (IRETOU.eq.0.or.IERR.NE.0) THEN
  286. WRITE(IOIMP,*) 'OPERATEUR RECO : Apres un CHPOINT,' ,
  287. & ' on attend un objet de type :'
  288. WRITE(IOIMP,*) '- TABLE de sous-type BASE_MODALE,'
  289. WRITE(IOIMP,*) '- TABLE de sous-type LIAISONS_STATIQUES,'
  290. WRITE(IOIMP,*) '- ou BASEMODA'
  291. CALL ERREUR(21)
  292. RETURN
  293. ENDIF
  294.  
  295. IF (IRET3.EQ.1) THEN
  296. IMOO=0
  297. CALL LIRMOT(MOOPT,LMOOPT,IMOO,0)
  298. ENDIF
  299.  
  300. IF(IMOO.EQ.0) THEN
  301. WRITE(IOIMP,*) 'OPERATEUR RECO : On attend un mot-cle'
  302. CALL ERREUR(21)
  303. RETURN
  304. ENDIF
  305.  
  306. c qq initialisations + recup du chpoint
  307. KPSMO = 0
  308. KCHAR = 0
  309. KCHLIA = 0
  310. ITLIA = 0
  311. XTEMP = 0.D0
  312. ICH1=ICHP1
  313.  
  314. c lecture du temps si PSEUDO MODE (+chargement + chpoint de liaison)
  315. IF(IERR.NE.0) RETURN
  316. CALL LIRREE(XTEMP,0,IRETOU)
  317. IF (IRETOU.EQ.1) THEN
  318. KPSMO = 1
  319. CALL LIROBJ('CHPOINT ',KCHLIA,0,IRETOU)
  320. CALL LIROBJ('CHARGEME',KCHAR,0,IRETOU)
  321. ENDIF
  322. IF(IERR.NE.0) RETURN
  323. C
  324. C **** ON VERIFIE QUE LE CHPOINT CONTIENT LES CONTRIBUTIONS MODALES
  325. C
  326. MCHPOI = ICH1
  327. SEGACT MCHPOI
  328. NSOUPO = IPCHP(/1)
  329. DO 1 ISOU = 1,NSOUPO
  330. MSOUPO = IPCHP(ISOU)
  331. SEGACT MSOUPO
  332. IF (NOCOMP(/2).NE.1) THEN
  333. C ON CHERCHE UN CHPOINT QUI CONTIENT DES CONTIBUTIONS MODALES
  334. CALL ERREUR(188)
  335. RETURN
  336. ENDIF
  337. IF (NOCOMP(1).NE.'ALFA') THEN
  338. C ON CHERCHE ........
  339. CALL ERREUR(188)
  340. SEGDES MSOUPO
  341. RETURN
  342. ENDIF
  343. SEGDES MSOUPO
  344. 1 CONTINUE
  345. SEGDES MCHPOI
  346.  
  347. * TRAVAIL SUR LA BASE MODALE
  348. MBASEM = IP2
  349. SEGACT MBASEM
  350. NBAS = LISBAS(/1)
  351. IP4 = 1
  352. IF (NBAS.NE.1) THEN
  353. C BASE COMPLEXE
  354. CALL LIROBJ('STRUCTUR',IRET,1,IRETOU)
  355. IF( IERR.NE.0 ) RETURN
  356. MSTRUC = IRET
  357. SEGACT MSTRUC
  358. NSTRU = LISTRU(/1)
  359. MSOSTU = LISTRU(1)
  360. IP3 = 1
  361. IF (NSTRU.NE.1) THEN
  362. C STRUCTURE COMPLEXE
  363. CALL LIRENT(IP3,1,IRETOU)
  364. IF (IERR.NE.0) RETURN
  365. C ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES
  366. SEGACT MSOSTU
  367. ISRAI1 = ISRAID
  368. SEGDES MSOSTU
  369. DO 14 NS = 2,NSTRU
  370. MSOSTU = LISTRU(NS)
  371. SEGACT MSOSTU
  372. IF (ISRAI1.NE.ISRAID) RETURN
  373. SEGDES MSOSTU
  374. 14 CONTINUE
  375. IF (IP3.EQ.0 .OR. IP3.GT.NSTRU) THEN
  376. CALL ERREUR(216)
  377. RETURN
  378. ENDIF
  379. MSOSTU = LISTRU(IP3)
  380. ENDIF
  381. SEGDES MSTRUC
  382. C ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE
  383. DO 16 NB = 1,NBAS
  384. MSOBAS = LISBAS(NB)
  385. SEGACT MSOBAS
  386. IP4 = NB
  387. IF (IBSTRM(1).EQ.MSOSTU) GOTO 17
  388. SEGDES MSOBAS
  389. 16 CONTINUE
  390. C *** INCOHERENCE ENTRE LA BASE ET LA STRUCTURE
  391. CALL ERREUR(216)
  392. RETURN
  393. 17 CONTINUE
  394. ENDIF
  395. MSOBAS = LISBAS(IP4)
  396. SEGDES MBASEM
  397. SEGACT MSOBAS
  398. IBMODE = IBSTRM(2)
  399. IBSOLS = IBSTRM(3)
  400. IBPSMO = IBSTRM(5)
  401. IRET = 0
  402. IRET1 = 0
  403. IRET2 = 0
  404. *
  405. IF (IMOO.EQ.2) THEN
  406. *
  407. * RECOMBINAISON DE CONTRAINTES
  408. *
  409. READ (MOOPT(2),FMT='(A4)') MOCON
  410. IF (IBMODE.NE.0) THEN
  411. MSOLUT = IBMODE
  412. SEGACT MSOLUT
  413. KMEL1 = MSOLIS(3)
  414. KCON = MSOLIS(6)
  415. SEGDES MSOLUT
  416. IF (KCON.EQ.0) THEN
  417. MOTERR(1:8) = ITYSOL
  418. CALL ERREUR(61)
  419. RETURN
  420. ENDIF
  421. CALL RCOSIG(ICH1,KCON,KMEL1,IRET1)
  422. IF( IERR.NE.0 ) RETURN
  423. IF (IBSOLS.EQ.0) IRET = IRET1
  424. ENDIF
  425. IF (IBSOLS.NE.0) THEN
  426. MSOLUT = IBSOLS
  427. SEGACT MSOLUT
  428. KMEL1 = MSOLIS(3)
  429. KCON = MSOLIS(6)
  430. SEGDES MSOLUT
  431. IF (KCON.EQ.0) THEN
  432. MOTERR(1:8) = ITYSOL
  433. CALL ERREUR(61)
  434. RETURN
  435. ENDIF
  436. CALL RCOSIG(ICH1,KCON,KMEL1,IRET2)
  437. IF( IERR.NE.0 ) RETURN
  438. IF (IRET1.NE.0) THEN
  439. ICONV=0
  440. CALL ADCHEL(IRET1,IRET2,IRET,IUN)
  441. ELSE
  442. IRET = IRET2
  443. ENDIF
  444. ENDIF
  445. IF (IRET.EQ.0) RETURN
  446. ITYPE = 'CHAMELEM'
  447. ELSE
  448. *
  449. * RECOMBINAISON DE DEPLACEMENTS
  450. *
  451. READ (MOOPT(1),FMT='(A4)') MODEPL
  452. IF (IBMODE.NE.0) THEN
  453. MSOLUT = IBMODE
  454. SEGACT MSOLUT
  455. KDEPL = MSOLIS(5)
  456. KMEL1 = MSOLIS(3)
  457. SEGDES MSOLUT
  458. IF (KDEPL.EQ.0) THEN
  459. MOTERR(1:8) = ITYSOL
  460. CALL ERREUR(61)
  461. RETURN
  462. ENDIF
  463. CALL RCODP1(ICH1,KDEPL,KMEL1,IRET1)
  464. IF (IERR.NE.0) RETURN
  465. IF (IBSOLS.EQ.0) IRET = IRET1
  466. ENDIF
  467. IF (IBSOLS.NE.0) THEN
  468. MSOLUT = IBSOLS
  469. SEGACT MSOLUT
  470. KDEPL = MSOLIS(5)
  471. KMEL1 = MSOLIS(3)
  472. SEGDES MSOLUT
  473. IF (KDEPL.EQ.0) THEN
  474. MOTERR(1:8) = ITYSOL
  475. CALL ERREUR(61)
  476. RETURN
  477. ENDIF
  478. CALL RCODP1(ICH1,KDEPL,KMEL1,IRET2)
  479. IF (IERR.NE.0) RETURN
  480. IF (IRET1.NE.0) THEN
  481. CALL ADCHPO(IRET1,IRET2,IRET,1D0,1D0)
  482. IF( IERR.NE.0 ) RETURN
  483. ELSE
  484. IRET = IRET2
  485. ENDIF
  486. ENDIF
  487. IF (IRET.EQ.0) RETURN
  488. ITYPE = 'CHPOINT '
  489. ENDIF
  490. *
  491. * PRIS EN COMPTE DES PSEUDO-MODES
  492. *
  493. IF (KPSMO.NE.0) THEN
  494. CALL PSRECO(IBMODE,IBPSMO,MOOPT(IMOO),KCHAR,KCHLIA,XTEMP,IRET)
  495. ENDIF
  496. *
  497. SEGDES MSOBAS
  498.  
  499. CALL ECROBJ (ITYPE,IRET)
  500. *
  501. RETURN
  502. END
  503.  
  504.  
  505.  

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