Télécharger pjba.eso

Retour à la liste

Numérotation des lignes :

  1. C PJBA SOURCE JC220346 16/04/25 21:15:12 8915
  2. SUBROUTINE PJBA
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C=======================================================================
  6. C OPERATEUR PJBA :
  7. C PROJECTION D'UN CHPOINT, D'UN CHARGEMENT OU D'UNE RIGIDITE
  8. C SUR LES ELEMENTS D'UNE BASE MODALE B.
  9. C LE RESULTAT EST DU MEME TYPE.
  10. C
  11. C SYNTAXE :
  12. C * FN = PJBA B OBJET ; SI BASE ELEMENTAIRE
  13. C * FN = PJBA B STR1 (N) OBJET ; SI BASE COMPLEXE
  14. C
  15. C OBJET POUVANT ETRE UNE FORCE OU UN CHARGEMENT,
  16. C OU UNE RIGIDITE DANS LE PREMIER CAS.
  17. C
  18. C STR1 EST LA SOUS-STRUCTURE OU S'APPLIQUE L'OBJET.
  19. C N EST LE NUMERO DE LA SOUS-STRUCTURE SI CELLE-CI EST
  20. C FORMEE DE SOUS-STRUCTURES IDENTIQUES .
  21. C
  22. C
  23. C CAS PARTICULIER DES GRANDS DEPLACEMENTS SUR BASE TOURNANTE :
  24. C ----------------------------------------------------------
  25. C
  26. C SI LA FORCE N'EST PAS LIEE A LA BASE ( EX : LA PESANTEUR )
  27. C IL FAUT SPECIFIER LE MOT-CLEF ......... LIBR
  28. C ALORS FN EST UN OBJET LISTCHPO CONTENANT LES VECTEURS DE
  29. C DECOMPOSITION DE LA FORCE GENERALISEE F
  30. C
  31. C=======================================================================
  32. -INC SMBASEM
  33. -INC SMCHPOI
  34. -INC SMCHARG
  35. -INC SMLCHPO
  36. -INC SMSOLUT
  37. -INC SMSTRUC
  38. -INC CCOPTIO
  39. C
  40. LOGICAL L0,L1,CHAR,TABL
  41. CHARACTER*4 LIBR(1),CLE(1)
  42. CHARACTER*32 CH32
  43. CHARACTER*72 motyp1,motyp2
  44. DATA CLE(1)/'REEL'/
  45. DATA LIBR(1) /'LIBR'/
  46. NLIBR = 1
  47. TABL = .FALSE.
  48.  
  49.  
  50. C---- Cas d'un LISTCHPO ou d'une TABLE de resultats --------------------
  51. CALL LIRTAB('PASAPAS',MTAB1,0,IRETOU)
  52. IF (IRETOU.EQ.0) CALL LIRTAB('DYNAMIC',MTAB1,0,IRETOU)
  53. IF (IRETOU.EQ.0) CALL LIRTAB('EXEC',MTAB1,0,IRETOU)
  54. IF (IRETOU.EQ.0) CALL LIROBJ('LISTCHPO',ILCHP1,0,IRETOU)
  55. IF (IRETOU.EQ.0) GOTO 100
  56.  
  57. * SIGNAL D'ENTREE
  58. ITYP=0
  59. CALL REFUS
  60. CALL LIRRES(ILCHP1,1,ITYP,CH32,NCH,0,ILREE1)
  61. IF (IERR.NE.0) RETURN
  62.  
  63. * TABLE DE MODES
  64. CALL LIRTAB('BASE_MODALE',ITBAS1,1,IRET)
  65. IF (IERR.NE.0) RETURN
  66.  
  67. * NOMBRE DE MODES
  68. CALL LIRENT(NMOD1,0,IRET)
  69. IF (IRET.EQ.0) NMOD1=0
  70.  
  71. * MATRICE POUR LE PRODUIT SCALAIRE
  72. CALL LIROBJ('RIGIDITE',IRIG1,0,IRET)
  73. IF (IRET.EQ.0) IRIG1=0
  74.  
  75. CALL PJBLCH(ILCHP1,ITBAS1,NMOD1,IRIG1,ILCHP2)
  76. IF (IERR.NE.0) RETURN
  77. CALL ECROBJ('LISTCHPO',ILCHP2)
  78.  
  79. RETURN
  80.  
  81. C---- Cas d'un MODELE --------------------------------------------------
  82. 100 CONTINUE
  83. call lirobj('MMODEL ',IPMODE,0,iretou)
  84. IF (iretou.EQ.0) GOTO 200
  85. call pjmode(ipmode)
  86. return
  87.  
  88. C---- Cas d'une RIGIDITE -----------------------------------------------
  89. 200 CONTINUE
  90. CALL LIROBJ('RIGIDITE',MRIGID,0,IRETOU)
  91. IF (IRETOU.EQ.0) GOTO 300
  92.  
  93. C --- Cas d'une RIGIDITE suivie d'1 (ou 2) TABLE(S) ---
  94. CALL LIROBJ('TABLE ',MTAB1,1,IRETOU)
  95. IF (IERR.NE.0) RETURN
  96. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0,
  97. & 'MOT',IP,RR,motyp1,.TRUE.,IQ)
  98. c lecture facultative d une 2eme table
  99. CALL LIROBJ('TABLE ',MTAB2,0,IRETO2)
  100. IF(IRETO2.NE.0) THEN
  101. CALL ACCTAB(MTAB2,'MOT',0,0.0D0,'SOUSTYPE',.TRUE.,0,
  102. & 'MOT',IP,RR,motyp2,.TRUE.,IQ)
  103. IF (IERR.NE.0) RETURN
  104. c a t'on inversé les 2 tables ?
  105. if (motyp1.eq.'LIAISONS_STATIQUES'.and.
  106. & motyp2.eq.'BASE_MODALE') then
  107. motyp1='BASE_MODALE'
  108. motyp2='LIAISONS_STATIQUES'
  109. MTEMP = MTAB1
  110. MTAB1 = MTAB2
  111. MTAB2 = MTEMP
  112. endif
  113. if (motyp1.ne.'BASE_MODALE'.or.
  114. & motyp2.ne.'LIAISONS_STATIQUES') then
  115. write(ioimp,*) 'Donnez une (des) table(s) de soustype',
  116. & ' BASE_MODALE ou LIAISONS_STATIQUES'
  117. call erreur(482)
  118. return
  119. endif
  120. ELSE
  121. MTAB2=0
  122. ENDIF
  123.  
  124. c -calcul de Phi^T * K * Phi (ou Phi = base modale)
  125. if (motyp1.eq.'BASE_MODALE') then
  126. CALL LIRMOT(CLE,1,ICLE,0)
  127. CALL PROJRG(MRIGID,MTAB1,MTAB2,ICLE,MRIG1,MRIG2)
  128. if (ierr.ne.0) return
  129. IF (MRIG2.NE.0) CALL ECROBJ('RIGIDITE',MRIG2)
  130.  
  131. c -calcul de Psi^T * RELA * Psi (ou Psi = base deformees statiques)
  132. elseif (motyp1.eq.'LIAISONS_STATIQUES') then
  133. call probas(MRIGID,MTAB1,MRIG1)
  134. if (ierr.ne.0) return
  135. call proba2(MTAB1,MRIG2)
  136. if (ierr.ne.0) return
  137. if (mrig2.gt.0.and.mrig1.gt.0) then
  138. call fusrig(mrig1,mrig2,mrig3)
  139. mrig1 = mrig3
  140. mrig2 = 0
  141. endif
  142. if (mrig2.gt.0) mrig1 = mrig2
  143. if (mrig1.eq.0) then
  144. call ECRLOG(.false.)
  145. return
  146. endif
  147. else
  148. write(ioimp,*) 'Donnez une table de soustype BASE_MODALE ou',
  149. & ' LIAISONS_STATIQUES'
  150. call erreur(482)
  151. return
  152. endif
  153. CALL ECROBJ('RIGIDITE',MRIG1)
  154. RETURN
  155.  
  156. c---- cas d'un CHPOINT ou d'un CHARGEMENT ------------------------------
  157. 300 CONTINUE
  158. CALL LIROBJ('CHPOINT ',IP1,0,IRETOU)
  159. CHAR = IRETOU.EQ.0
  160. IF (CHAR) THEN
  161. CALL LIROBJ('CHARGEME',IPCHAR,0,IRETOU)
  162. IF (IERR.NE.0) RETURN
  163. ENDIF
  164. IF (IRETOU.EQ.0) GOTO 400
  165.  
  166. c -lecture des modes sous forme de BASEMODA ou de table BASE_MODALE
  167. IPSTA=0
  168. CALL LIROBJ('BASEMODA',IP2,0,IRETOU)
  169. IF (IRETOU.EQ.0) THEN
  170. CALL LIRTAB('BASE_MODALE',ITBAS,1,IRETOU)
  171. IF(IERR.NE.0) RETURN
  172. CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,
  173. & 'TABLE',I1,X1,' ',L1,IP2)
  174. TABL = .TRUE.
  175. c lecture facultative d une 2eme table de liaisons statiques
  176. CALL LIRTAB('LIAISONS_STATIQUES',IPSTA,0,IRETOU)
  177. ELSE
  178. MBASEM=IP2
  179. SEGACT MBASEM
  180. NBAS=LISBAS(/1)
  181. IP4=1
  182. IF(NBAS.EQ.1) GOTO 5
  183. * BASE COMPLEXE
  184. CALL LIROBJ('STRUCTUR',IRET,1,IRETOU)
  185. IF(IERR.NE.0) GOTO 4000
  186. MSTRUC=IRET
  187. SEGACT MSTRUC
  188. NSTRU=LISTRU(/1)
  189. MSOSTU=LISTRU(1)
  190. IP3=1
  191. IF(NSTRU.EQ.1) GOTO 2
  192. * STRUCTURE COMPLEXE
  193. CALL LIRENT(IP3,1,IRETOU)
  194. IF(IERR.NE.0) GOTO 3000
  195. * ON VERIFIE QU'IL S'AGIT DE SOUS-STRUCTURES IDENTIQUES
  196. SEGACT MSOSTU
  197. ISRAI1=ISRAID
  198. SEGDES MSOSTU
  199. DO 1 NS=2,NSTRU
  200. MSOSTU=LISTRU(NS)
  201. SEGACT MSOSTU
  202. IF(ISRAI1.NE.ISRAID) GOTO 2000
  203. SEGDES MSOSTU
  204. 1 CONTINUE
  205. IF(IP3.EQ.0.OR.IP3.GT.NSTRU) GOTO 4000
  206. MSOSTU=LISTRU(IP3)
  207. 2 CONTINUE
  208. SEGDES MSTRUC
  209. * ON VERIFIE QUE LA SOUS-STRUCTURE EST DANS LA BASE
  210. DO 3 NB = 1,NBAS
  211. MSOBAS=LISBAS(NB)
  212. SEGACT MSOBAS
  213. IP4=NB
  214. IF(IBSTRM(1).EQ.MSOSTU) GOTO 4
  215. SEGDES MSOBAS
  216. 3 CONTINUE
  217. * INCOHERENCE ENTRE LA BASE ET LA STRUCTURE
  218. GOTO 4000
  219. 4 CONTINUE
  220. SEGDES MSOBAS
  221. ENDIF
  222. c -fin du cas on a une base modale
  223.  
  224. c -lecture du mot clé LIBR
  225. 5 CALL LIRMOT(LIBR,NLIBR,ILIBRE,0)
  226.  
  227. c -cas d'un chargement
  228. IF (CHAR) THEN
  229. MCHAR1=IPCHAR
  230. SEGINI,MCHARG=MCHAR1
  231. NBCHG=KCHARG(/1)
  232. DO 10 NC=1,NBCHG
  233. ICHAR1=KCHARG(NC)
  234. SEGINI,ICHARG=ICHAR1
  235. KCHARG(NC)=ICHARG
  236. IP1=ICHPO1
  237. *+* POUR L'INSTANT, ON NE DUPLIQUE PAS LES LISTREELS
  238. IF (TABL) THEN
  239. CALL PROJTA(IP1,IP2,IPSTA,IRET)
  240. ELSE
  241. CALL PROJBA(IP1,IP2,IP4,IRET)
  242. ENDIF
  243. IF(IERR.NE.0) RETURN
  244. ICHPO1=IRET
  245. SEGDES,ICHARG
  246. 10 CONTINUE
  247. SEGDES,MCHARG
  248. CALL ECROBJ('CHARGEME',MCHARG)
  249. c -cas d'un chpoint
  250. ELSE
  251. IF (ILIBRE .EQ. 1) THEN
  252. C CAS GRANDS DEPLACEMENTS ; CHARGEMENT LIBRE
  253. CALL PJLIBR( IP1,IP2,IP4,IRET )
  254. CALL ECROBJ( 'LISTCHPO',IRET )
  255. ELSE
  256. IF (TABL) THEN
  257. CALL PROJTA(IP1,IP2,IPSTA,IRET)
  258. ELSE
  259. CALL PROJBA( IP1,IP2,IP4,IRET )
  260. ENDIF
  261. IF(IRET.EQ.0) GO TO 5000
  262. CALL ECROBJ( 'CHPOINT ',IRET )
  263. ENDIF
  264. ENDIF
  265. GOTO 5000
  266. 2000 CONTINUE
  267. SEGDES MSOSTU
  268. 3000 CONTINUE
  269. SEGDES MSTRUC
  270. 4000 CALL ERREUR(216)
  271. SEGDES MBASEM
  272. 5000 CONTINUE
  273.  
  274. RETURN
  275.  
  276. c---- cas TABLE LIAISONS STATIQUES SEULE -------------------------------
  277. 400 CONTINUE
  278. CALL LIRTAB('LIAISONS_STATIQUES',MTAB1,0,IRETOU)
  279. IF (IRETOU.EQ.0) GOTO 9999
  280. c on calcule les rigidites associees
  281. call proba2(MTAB1,MRIG1)
  282. if (ierr.ne.0) return
  283. if (mrig1.gt.0) then
  284. CALL ECROBJ('RIGIDITE',MRIG1)
  285. else
  286. call ECRLOG(.false.)
  287. endif
  288.  
  289. RETURN
  290.  
  291.  
  292. c petit message d'erreur si on n'a pas lu un objet a projeter
  293. 9999 CONTINUE
  294. MOTERR(1:8)='RIGIDITE'
  295. MOTERR(9:16)='CHPOINT'
  296. MOTERR(17:24)='CHARGEME'
  297. MOTERR(25:32)='TABLE'
  298. MOTERR(33:40)='LISTCHPO'
  299. call erreur(471)
  300.  
  301. return
  302.  
  303. *
  304. END
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  

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