Télécharger evpjba.eso

Retour à la liste

Numérotation des lignes :

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

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