Télécharger evpjba.eso

Retour à la liste

Numérotation des lignes :

evpjba
  1. C EVPJBA SOURCE CB215821 20/11/25 13:28:18 10792
  2. SUBROUTINE EVPJBA(LCOUL)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. * NOM : EVPJBA
  7. * DESCRIPTION : Evolution temporelle des coefficients de projection
  8. * sur les vecteurs d'une base modale
  9. ************************************************************************
  10. * APPELE PAR : evol.eso
  11. ************************************************************************
  12. * SYNTAXE (GIBIANE) :
  13. *
  14. * EVOL1 = EVOL (|COUL1 |) 'PJBA' {SIGNAL1} TBAS1 (LIMOD1) ;
  15. * |LCOUL1|
  16. *
  17. * avec {SIGNAL1} <=> | LCHPO1 LREEL1 | (LIPDT1)
  18. * | TAB1 (MOT1) |
  19. *
  20. ************************************************************************
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC CCGEOME
  25. -INC SMEVOLL
  26. -INC SMELEME
  27. -INC SMTABLE
  28. -INC SMLENTI
  29. -INC SMLREEL
  30. -INC SMLMOTS
  31. -INC SMLCHPO
  32. -INC SMCHPOI
  33. *
  34. SEGMENT,ILORDO(NMO)
  35. POINTEUR LMODE.MLENTI,LCOUL.MLENTI
  36. *
  37. CHARACTER*4 CHA4
  38. CHARACTER*8 CHA8
  39. CHARACTER*32 CH32
  40. *
  41. *
  42. * +---------------------------------------------------------------+
  43. * | |
  44. * | C A L C U L D E L A P R O J E C T I O N |
  45. * | |
  46. * +---------------------------------------------------------------+
  47. *
  48. *
  49. * ===============
  50. * SIGNAL D'ENTREE
  51. * ===============
  52. *
  53. ITYP=0
  54. CALL LIRRES(ILCHP1,1,ITYP,CH32,NCH,1,ILREE1)
  55. IF (IERR.NE.0) RETURN
  56. *
  57. *
  58. * ==============
  59. * TABLE DE MODES
  60. * ==============
  61. *
  62. CALL LIRTAB('BASE_MODALE',ITBAS1,1,IRET)
  63. IF (IERR.NE.0) RETURN
  64. *
  65. * NOMBRE DE MODES DANS LA TABLE FOURNIE ?
  66. CALL ACCTAB(ITBAS1,'MOT',0,0.D0,'MODES',.TRUE.,0,
  67. & 'TABLE',IVAL,XVAL,CHA8,ZLOGI,MTAB1)
  68. SEGACT,MTAB1
  69. MLOTA=MTAB1.MLOTAB
  70. NBMOD=0
  71. DO I=1,MLOTA
  72. IF (MTAB1.MTABTI(I).EQ.'ENTIER') NBMOD=NBMOD+1
  73. ENDDO
  74. SEGDES,MTAB1
  75. IF (NBMOD.EQ.0) THEN
  76. MOTERR(1:8)='TABLE'
  77. CALL ERREUR(1027)
  78. RETURN
  79. ENDIF
  80. *
  81. *
  82. * ========================
  83. * LISTE DES MODES DEMANDES
  84. * ========================
  85. *
  86. CALL LIRENT(IMOD1,0,IRET)
  87. *
  88. * => UN SEUL MODE
  89. IF (IRET.NE.0) THEN
  90. NMO=1
  91. JG=1
  92. SEGINI,LMODE
  93. LMODE.LECT(1)=IMOD1
  94. IMAX1=IMOD1
  95. *
  96. * => PLUSIEURS MODES
  97. ELSE
  98. CALL LIROBJ('LISTENTI',LMODE,0,ILIMOD)
  99. IF (ILIMOD.NE.0) THEN
  100. *
  101. * LISTE FOURNIE : NOMBRE DE MODES DEMANDES ?
  102. SEGACT,LMODE
  103. NMO=LMODE.LECT(/1)
  104. IF (NMO.EQ.0) THEN
  105. MOTERR(1:8)='LISTENTI'
  106. CALL ERREUR(1027)
  107. RETURN
  108. ENDIF
  109. *
  110. * VERIFICATION DES VALEURS FOURNIES
  111. IMAX1=0
  112. DO IMO=1,NMO
  113. IMOD1=LMODE.LECT(IMO)
  114. IF (IMOD1.LE.0.OR.IMOD1.GT.NBMOD) THEN
  115. INTERR(1)=IMOD1
  116. CALL ERREUR(36)
  117. RETURN
  118. ENDIF
  119. IMAX1=MAX(IMAX1,IMOD1)
  120. ENDDO
  121. ELSE
  122. *
  123. * LISTE NON FOURNIE : ON VA SORTIR TOUS LES MODES
  124. NMO=NBMOD
  125. IMAX1=NBMOD
  126. JG=NMO
  127. SEGINI,LMODE
  128. DO IMO=1,NMO
  129. LMODE.LECT(IMO)=IMO
  130. ENDDO
  131. ENDIF
  132. *
  133. ENDIF
  134. *
  135. *
  136. * ==================
  137. * LISTE DES COULEURS
  138. * ==================
  139. *
  140. SEGACT,LCOUL
  141. NCLR=LCOUL.LECT(/1)
  142. *
  143. * ON COMPLETE SI BESOIN LA LISTE DES COULEURS
  144. IF (NMO.GT.NCLR) THEN
  145. JG=NMO
  146. SEGADJ,LCOUL
  147. DO K=NCLR+1,NMO
  148. LCOUL.LECT(K)=LCOUL.LECT(K-NCLR)
  149. ENDDO
  150. ENDIF
  151. *
  152. *
  153. * ================================
  154. * MATRICE POUR LE PRODUIT SCALAIRE
  155. * ================================
  156. *
  157. CALL LIROBJ('RIGIDITE',IRIG1,0,IRET)
  158. IF (IRET.EQ.0) IRIG1=0
  159. *
  160. *
  161. * =============================================
  162. * CALCUL DE TOUS LES COEFFICIENTS DE PROJECTION
  163. * =============================================
  164. *
  165. CALL PJBLCH(ILCHP1,ITBAS1,IMAX1,IRIG1,ILCHP2)
  166. IF (IERR.NE.0) RETURN
  167. *
  168. *
  169. *
  170. * +---------------------------------------------------------------+
  171. * | |
  172. * | C O N S T R U C T I O N D E L ' E V O L U T I O N |
  173. * | |
  174. * +---------------------------------------------------------------+
  175. *
  176. *
  177. * ======================================================
  178. * CREATION ET REMPLISSAGE D'UN LISTREEL POUR CHAQUE MODE
  179. * ======================================================
  180. *
  181. SEGINI,ILORDO
  182. DO IMO=1,NMO
  183. JG=NCH
  184. SEGINI,MLREEL
  185. ILORDO(IMO)=MLREEL
  186. ENDDO
  187. *
  188. MLCHPO=ILCHP2
  189. SEGACT,MLCHPO
  190. *
  191. DO ICH=1,NCH
  192. * AVEC PJBLCH, LE SUPPORT GEOMETRIQUE DE CHAQUE CHPOINT EST DANS
  193. * LE MEME ORDRE QUE LES MODES DE LA TABLE 'BASE_MODALE'
  194. MCHPOI=ICHPOI(ICH)
  195. SEGACT,MCHPOI
  196. MSOUPO=IPCHP(1)
  197. SEGACT,MSOUPO
  198. MPOVAL=IPOVAL
  199. SEGACT,MPOVAL
  200. DO IMO=1,NMO
  201. IMO1=LMODE.LECT(IMO)
  202. MLREEL=ILORDO(IMO)
  203. PROG(ICH)=VPOCHA(IMO1,1)
  204. IF (ICH.EQ.NCH) SEGDES,MLREEL
  205. ENDDO
  206. SEGDES,MPOVAL,MSOUPO,MCHPOI
  207. ENDDO
  208. *
  209. *
  210. * =========================================
  211. * CREATION DES COURBES DE L'OBJET EVOLUTION
  212. * =========================================
  213. *
  214. N=NMO
  215. SEGINI,MEVOLL
  216. ITYEVO='REEL'
  217. IEVTEX='COEFFICIENTS DE PROJECTION SUR BASE MODALE'
  218. DO IMO=1,NMO
  219. SEGINI,KEVOLL
  220. IEVOLL(IMO)=KEVOLL
  221. TYPX='LISTREEL'
  222. TYPY='LISTREEL'
  223. IPROGX=ILREE1
  224. IPROGY=ILORDO(IMO)
  225. NUMEVX=LCOUL.LECT(IMO)
  226. NUMEVY='REEL'
  227. NOMEVX='TEMPS'
  228. NOMEVY=CH32(1:12)
  229. WRITE(CHA4,FMT='(I4)') LMODE.LECT(IMO)
  230. CALL LIMCHA(CHA4,I1,I2)
  231. WRITE(KEVTEX,FMT='("MODE ",A)') CHA4(I1:I2)
  232. MLREEL=ILORDO(IMO)
  233. SEGDES,KEVOLL,MLREEL
  234. ENDDO
  235. SEGDES,MEVOLL
  236. SEGSUP,LCOUL,ILORDO
  237. IF (ILIMOD.NE.0) THEN
  238. SEGDES,LMODE
  239. ELSE
  240. SEGSUP,LMODE
  241. ENDIF
  242. CALL ECROBJ('EVOLUTIO',MEVOLL)
  243. *
  244. RETURN
  245. *
  246. END
  247. *
  248. *
  249.  
  250.  
  251.  

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