Télécharger la plaquette Cast3M


fr en

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