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

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