Télécharger pjba.eso

Retour à la liste

Numérotation des lignes :

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

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