Télécharger la plaquette Cast3M


fr en

Télécharger pjblch.eso

Retour à la liste

Numérotation des lignes : 

pjblch

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

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