Télécharger pjba.eso

Retour à la liste

Numérotation des lignes :

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

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