Télécharger pjblch.eso

Retour à la liste

Numérotation des lignes :

  1. C PJBLCH SOURCE JC220346 16/05/10 21:15:01 8926
  2. SUBROUTINE PJBLCH(ILCHP1,ITBAS1,NBMOD1,IRIGI1,ILCHP2)
  3. ************************************************************************
  4. * NOM : PJBLCH
  5. * DESCRIPTION : Calcule les coefficients de projection d'un signal
  6. * instationnaire sur une base de modes
  7. ************************************************************************
  8. * APPELE PAR : pjba.eso
  9. ************************************************************************
  10. * ENTREES : ILCHP1 = pointeur vers le LISTCHPO du signal instationnaire
  11. * (les mult. de Lagrange sont ignores)
  12. * ITBAS1 = pointeur vers la TABLE de sous-type BASE_MODALE
  13. * NBMOD1 = nombre de modes concernes (0 => tous)
  14. * IRIGI1 = matrice utilisee pour faire le produit scalaire
  15. * (0 si aucune)
  16. * SORTIES : ILCHP2 = pointeur vers l'objet LISTCHPO contenant les
  17. * coefficients de projection en fonction du temps
  18. ************************************************************************
  19. * SYNTAXE (GIBIANE) :
  20. *
  21. * LCHPO2 = PJBA | LCHPO1 | (LIPDT1) TBAS1 (NMOD1) (RIGI1) ;
  22. * | TAB1 (MOT1) |
  23. *
  24. ************************************************************************
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8 (A-H,O-Z)
  27. -INC CCOPTIO
  28. -INC SMLCHPO
  29. -INC SMCHPOI
  30. -INC SMELEME
  31. -INC SMLENTI
  32. -INC SMLMOTS
  33. -INC SMTABLE
  34. -INC CCHAMP
  35. *
  36. SEGMENT,ICHMOD(NMO)
  37. SEGMENT,XNOMOD(NMO)*D
  38. SEGMENT,IPOMOD(NMO)
  39. *
  40. CHARACTER*8 CHA8
  41. CHARACTER*12 CH12
  42. *
  43. LOGICAL ZLOGI
  44. *
  45. *
  46. * NOMBRE DE MODES CONTENUS DANS LA TABLE
  47. * ======================================
  48. CALL ACCTAB(ITBAS1,'MOT',0,0.D0,'MODES',.TRUE.,0,
  49. & 'TABLE',IVAL,XVAL,CHA8,ZLOGI,MTAB1)
  50. SEGACT,MTAB1
  51. MLOTA=MTAB1.MLOTAB
  52. NBMOD2=0
  53. DO I=1,MLOTA
  54. IF (MTAB1.MTABTI(I).EQ.'ENTIER') NBMOD2=NBMOD2+1
  55. ENDDO
  56. SEGDES,MTAB1
  57. IF (NBMOD2.EQ.0) THEN
  58. MOTERR(1:8)='TABLE'
  59. CALL ERREUR(1027)
  60. RETURN
  61. ENDIF
  62. *
  63. *
  64. * NOMBRE DE MODES SUR LESQUELS CALCULER LA PROJECTION
  65. * ===================================================
  66. IF (NBMOD1.GT.0) THEN
  67. IF (NBMOD1.GT.NBMOD2) THEN
  68. INTERR(1)=NBMOD1
  69. CALL ERREUR(36)
  70. RETURN
  71. ENDIF
  72. NMO=NBMOD1
  73. ELSE
  74. NMO=NBMOD2
  75. ENDIF
  76. *
  77. *
  78. * MEMORISATION DU POINTEUR DU CHPOINT, DE SA NORME EUCLIDIENNE
  79. * (AU CARRE) ET DU NOEUD DE CHAQUE MODE
  80. * ============================================================
  81. SEGINI,XNOMOD,ICHMOD,IPOMOD
  82. DO IMO=1,NMO
  83. CALL ACCTAB(MTAB1,'ENTIER',IMO,0.D0,'MOT',.TRUE.,0,
  84. & 'TABLE',IVAL,XVAL,CHA8,ZLOGI,ITAB2)
  85. IF (IERR.NE.0) RETURN
  86. *
  87. CALL ACCTAB(ITAB2,'MOT',0,0.D0,'DEFORMEE_MODALE',.TRUE.,0,
  88. & 'CHPOINT',IVAL,XVAL,CHA8,ZLOGI,ICHP3)
  89. IF (IERR.NE.0) RETURN
  90. ICHMOD(IMO)=ICHP3
  91. *
  92. IF (IRIGI1.GT.0) THEN
  93. CALL XTMX(ICHP3,IRIGI1,VAL)
  94. ELSE
  95. CALL XTX1(ICHP3,VAL)
  96. ENDIF
  97. IF (IERR.NE.0) RETURN
  98. XNOMOD(IMO)=VAL
  99. *
  100. CALL ACCTAB(ITAB2,'MOT',0,0.D0,'POINT_REPERE',.TRUE.,0,
  101. & 'POINT',IVAL,XVAL,CHA8,ZLOGI,IPOI3)
  102. IF (IERR.NE.0) RETURN
  103. IPOMOD(IMO)=IPOI3
  104. *
  105. ENDDO
  106. *
  107. *
  108. * CREATION DU MAILLAGE SUPPORT DES CHPOINTS DANS L'ESPACE MODAL
  109. * =============================================================
  110. NBNN=1
  111. NBELEM=NMO
  112. NBSOUS=0
  113. NBREF=0
  114. SEGINI,MELEME
  115. IMAI1=MELEME
  116. ITYPEL=1
  117. DO I=1,NBELEM
  118. NUM(1,I)=IPOMOD(I)
  119. ENDDO
  120. SEGSUP,IPOMOD
  121. SEGDES,MELEME
  122. *
  123. *
  124. * CORRESPONDANCE ENTRE LES NOMS DES COMPOSANTES (NECESSAIRE SI
  125. * AUCUNE MATRICE N'EST FOURNIE)
  126. * ============================================================
  127. *
  128. MLCHP1=ILCHP1
  129. SEGACT,MLCHP1
  130. N1=MLCHP1.ICHPOI(/1)
  131. *
  132. SEGINI,MLCHP2
  133. ILCHP2=MLCHP2
  134. *
  135. IF (N1.EQ.0) GOTO 999
  136. *
  137. IF (IRIGI1.EQ.0) THEN
  138. *
  139. * COMPOSANTES DU SIGNAL CONTENU DANS LE LISTCHPO => MLENT1
  140. ICHP1=MLCHP1.ICHPOI(1)
  141. CALL PRIDUA(ICHP1,ICOTY1,MLENT1)
  142. IF (IERR.NE.0) RETURN
  143. SEGACT,MLENT1
  144. JG=MLENT1.LECT(/1)
  145. DO I=2,N1
  146. ICHP1=MLCHP1.ICHPOI(I)
  147. CALL PRIDUA(ICHP1,ICOD1,MLENTI)
  148. IF (IERR.NE.0) RETURN
  149. IF (ICOTY1.NE.ICOD1.OR.ICOD1.EQ.-1) THEN
  150. CALL ERREUR(1053)
  151. RETURN
  152. ENDIF
  153. SEGACT,MLENTI
  154. NBC=LECT(/1)
  155. DO 10 J=1,NBC
  156. JJ=LECT(J)
  157. DO K=1,JG
  158. IF (JJ.EQ.MLENT1.LECT(K)) GOTO 10
  159. ENDDO
  160. JG=JG+1
  161. SEGADJ,MLENT1
  162. MLENT1.LECT(JG)=JJ
  163. 10 CONTINUE
  164. SEGSUP,MLENTI
  165. ENDDO
  166. JG1=JG
  167. *
  168. * COMPOSANTES DES MODES DE LA TABLE BASE_MODALE => MLENT2
  169. ICHP2=ICHMOD(1)
  170. CALL PRIDUA(ICHP2,ICOTY2,MLENT2)
  171. IF (IERR.NE.0) RETURN
  172. SEGACT,MLENT2
  173. JG=MLENT2.LECT(/1)
  174. DO I=2,NMO
  175. ICHP2=ICHMOD(I)
  176. CALL PRIDUA(ICHP2,ICOD2,MLENTI)
  177. IF (IERR.NE.0) RETURN
  178. IF (ICOTY2.NE.ICOD2.OR.ICOD2.EQ.-1) THEN
  179. CALL ERREUR(1053)
  180. RETURN
  181. ENDIF
  182. SEGACT,MLENTI
  183. NBC=LECT(/1)
  184. DO 20 J=1,NBC
  185. JJ=LECT(J)
  186. DO K=1,JG
  187. IF (JJ.EQ.MLENT2.LECT(K)) GOTO 20
  188. ENDDO
  189. JG=JG+1
  190. SEGADJ,MLENT2
  191. MLENT2.LECT(JG)=JJ
  192. 20 CONTINUE
  193. SEGSUP,MLENTI
  194. ENDDO
  195. JG2=JG
  196. *
  197. * COMPOSANTES COMMUNES ENTRE LE SIGNAL ET LA BASE MODALE
  198. JG=MAX(JG1,JG2)
  199. SEGINI,MLENTI
  200. JG=0
  201. DO 30 J1=1,JG1
  202. JJ1=MLENT1.LECT(J1)
  203. DO J2=1,JG2
  204. IF (JJ1.EQ.MLENT2.LECT(J2)) THEN
  205. JG=JG+1
  206. LECT(JG)=JJ1
  207. GOTO 30
  208. ENDIF
  209. ENDDO
  210. 30 CONTINUE
  211. SEGSUP,MLENT1,MLENT2
  212. *
  213. IF (JG.EQ.0) THEN
  214. CALL ERREUR(21)
  215. RETURN
  216. ENDIF
  217. *
  218. * CREATION DES OBJETS LISTMOTS
  219. JGN=4
  220. JGM=JG
  221. SEGINI,MLMOT1,MLMOT2
  222. DO K=1,JG
  223. IF (ICOTY1.EQ.1) THEN
  224. MLMOT1.MOTS(K)=NOMDD(LECT(K))
  225. ELSE
  226. MLMOT1.MOTS(K)=NOMDU(LECT(K))
  227. ENDIF
  228. IF (ICOTY2.EQ.1) THEN
  229. MLMOT2.MOTS(K)=NOMDD(LECT(K))
  230. ELSE
  231. MLMOT2.MOTS(K)=NOMDU(LECT(K))
  232. ENDIF
  233. ENDDO
  234. SEGSUP,MLENTI
  235. *
  236. ENDIF
  237. *
  238. *
  239. * CALCUL DE LA PROJECTION SUR CHAQUE MODE, POUR CHAQUE PAS DE TEMPS
  240. * =================================================================
  241. *
  242. * BOUCLE SUR LES PAS DE TEMPS
  243. DO IT=1,N1
  244. ICHPO1=MLCHP1.ICHPOI(IT)
  245. MCHPO1=ICHPO1
  246. SEGACT,MCHPO1
  247. *
  248. * CREATION DU CHPOINT POUR LE PAS DE TEMPS IT
  249. NC=1
  250. N=NMO
  251. SEGINI,MPOVA3,MSOUP3
  252. MSOUP3.NOCOMP(1)='ALFA'
  253. MSOUP3.NOHARM(1)=0
  254. MSOUP3.IGEOC=IMAI1
  255. MSOUP3.IPOVAL=MPOVA3
  256. NAT=1
  257. NSOUPO=1
  258. SEGINI,MCHPO3
  259. MLCHP2.ICHPOI(IT)=MCHPO3
  260. MCHPO3.MTYPOI=' '
  261. WRITE(CH12,FMT='(I12)') IT
  262. CALL LIMCHA(CH12,I1,I2)
  263. WRITE(CHA8,FMT='(I8)') ICHPO1
  264. CALL LIMCHA(CHA8,I3,I4)
  265. WRITE(MCHPO3.MOCHDE,FMT='(5A)')
  266. & 'COEF PROJ TPS #',CH12(I1:I2),' (CHPOINT ',CHA8(I3:I4),')'
  267. MCHPO3.IFOPOI=IFOUR
  268. MCHPO3.JATTRI(1)=MCHPO1.JATTRI(1)
  269. MCHPO3.IPCHP(1)=MSOUP3
  270. SEGDES,MCHPO3,MSOUP3
  271. *
  272. * BOUCLE SUR LES MODES
  273. DO IMO=1,NMO
  274. ICHP2=ICHMOD(IMO)
  275. XNOR2=XNOMOD(IMO)
  276. IF (IRIGI1.GT.0) THEN
  277. CALL YTMX(MCHPO1,ICHP2,IRIGI1,VAL)
  278. ELSE
  279. CALL XTY1(MCHPO1,ICHP2,MLMOT1,MLMOT2,VAL)
  280. ENDIF
  281. IF (IERR.NE.0) RETURN
  282. MPOVA3.VPOCHA(IMO,1)=VAL/XNOR2
  283. ENDDO
  284. *
  285. SEGDES,MCHPO1,MPOVA3
  286. *
  287. ENDDO
  288. *
  289. IF (IRIGI1.EQ.0) SEGSUP,MLMOT1,MLMOT2
  290. 999 CONTINUE
  291. SEGDES,MLCHP1,MLCHP2
  292. SEGSUP,XNOMOD,ICHMOD
  293. *
  294. RETURN
  295. *
  296. END
  297. *
  298. *
  299.  
  300.  

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