Télécharger la plaquette Cast3M


fr en

Télécharger ccsolu.eso

Retour à la liste

Numérotation des lignes : 

ccsolu

  1. C CCSOLU    SOURCE    CB215821  20/11/25    13:19:07     10792          
  2.       SUBROUTINE CCSOLU (W2,IPLVAL,IPLVAI,IPLVEC,IPLVEI,
  3.      &                          IPKW2M,IPMASS,IPSOLU,INF0)
  4.  
  5. ************************************************************************
  6. *
  7. *                                C C S O L U
  8. *
  9. *
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. *     CONSTRUCTION D'UN OBJET SOLUTION, A PARTIR DES LISTES DES
  15. *     FREQUENCES PROPRES ET DES MODES PROPRES POUR UN PROBLEME NON
  16. *     SYMETRIQUE
  17. *
  18. *     NB: LES LISTES SONT SUPPOSES NON TRIEES, UN TRI EST FAIT PAR
  19. *     ORDRE DE CROISSANCE DE LA PARTIE REELE DES FREQUENCES PROPRES
  20. *
  21. *     SOUS PROGRAMME INSPIRE DU CRSOLU ADAPTE AU CAS COMPLEXE
  22. *
  23. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  24. * -----------
  25. *
  26. *     W2      REEL DP   (E)  FREQUENCE DE SHIFT
  27. *
  28. *     IPLVAL  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  29. *                            LA SUITE DES FREQUENCES PROPRES REELLES
  30. *
  31. *     IPLVAI  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  32. *                            LA SUITE DES FREQUENCES PROPRES IMAGINAIRES
  33. *
  34. *     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  35. *                            LA SUITE DES MODES PROPRES REELS
  36. *
  37. *     IPLVEI  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  38. *                            LA SUITE DES MODES PROPRES IMAGINAIRES
  39. *
  40. *     IPKW2M, IPMASS    (E)  MATRICES DE RIGIDITE (DECALEE) ET DE MASSE
  41. *
  42. *
  43. *     IPSOLU  ENTIER    (S)  POINTEUR SUR LA SOLUTION CREE
  44. *
  45. *
  46. * AUTEUR, DATE DE CREATION:
  47. * -------------------------
  48. *
  49. *     PASCAL BOUDA      8 JUILLET 2015
  50. *
  51. ************************************************************************
  52.  
  53.  
  54.       IMPLICIT INTEGER(I-N)
  55.       IMPLICIT REAL*8 (A-H,O-Z)
  56.  
  57.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC SMLCHPO
  61. -INC SMCHPOI
  62. -INC SMLREEL
  63. -INC SMLMOTS
  64. -INC CCREEL
  65. -INC SMSOLUT
  66.  
  67.  
  68.       PARAMETER (LPROPR = 10)
  69.  
  70.  
  71.       POINTEUR IPLVEC.MLCHPO, IPLVAL.MLREEL
  72.       POINTEUR IPLVEI.MLCHPO, IPLVAI.MLREEL
  73. *pointeurs de travail
  74.       POINTEUR IP2VEC.MLCHPO, IP2VAL.MLREEL
  75.       POINTEUR IP2VEI.MLCHPO, IP2VAI.MLREEL
  76.  
  77.  
  78.       INTEGER NBMOD, IPKW2M, IPMASS, IPSOLU
  79.  
  80.  
  81.       POINTEUR IPLMOX.MLMOTS, IPLMOY.MLMOTS
  82.       INTEGER  IPMX,IPMY, IPMODE, IPSOL1
  83.  
  84.       REAL*8   PROPRE(LPROPR)
  85.  
  86. * PROPRE(1) = PARTIE REELLE DU MODE PRORPE,
  87. * PROPRE(2) = (X)T.|B|.(X) , (X) 'CHPOINT' SOLUTION
  88. * PROPRE(3,4,5) DEPL.GEN. REELS SELON X,Y,Z
  89. * PROPRE(6)= PARTIE IMAGINAIRE DU MODE PROPRE
  90. * PROPRE(7)=PARTIE IM. DE XT.|B|.X
  91. * PROPRE(8,9,10) PARTIE IM DES DEP. GEN.
  92.  
  93.       REAL*8 XMX, XMY, YMY, YMX
  94.  
  95.       REAL*8 BUVAP1,BUVAP2
  96.       INTEGER BUVEP1,BUVEP2
  97.       INTEGER i,j
  98.  
  99.  
  100.  
  101. *                       *******************
  102. *                       ** TRI DES MODES **
  103. *                       *******************
  104.  
  105.       SEGACT IPLVEC*MOD
  106.       SEGACT IPLVAL*MOD
  107.       SEGACT IPLVEI*MOD
  108.       SEGACT IPLVAI*MOD
  109. *Recuparation du nombre de modes
  110.       NBMOD=IPLVAL.PROG(/1)
  111.  
  112. *Initialisation des segements de travail
  113.       JG=NBMOD
  114.       SEGINI IP2VAL
  115.       SEGINI IP2VAI
  116.  
  117.       N1=NBMOD
  118.       SEGINI IP2VEC
  119.       SEGINI IP2VEI
  120.  
  121. *Boucle sur tous les modes existants
  122.       DO 99 i=1,NBMOD
  123. *A chaque iteration, on ajoute un mode en bout de liste
  124.         IP2VAL.PROG(i)=IPLVAL.PROG(i)
  125.         IP2VAI.PROG(i)=IPLVAI.PROG(i)
  126.         IP2VEC.ICHPOI(i)=IPLVEC.ICHPOI(i)
  127.         IP2VEI.ICHPOI(i)=IPLVEI.ICHPOI(i)
  128.  
  129.         IF (i .NE. 1) THEN
  130. *Boucle de tri: tant que la partie reelle de la frequence propre du
  131. *mode est inferieure a celle qui la precede,on la decale vers la gauche
  132.           DO j=1,i-1
  133.  
  134.             IF (IP2VAL.PROG(i-j+1).LE.IP2VAL.PROG(i-j)) THEN
  135.               BUVAP1=IP2VAL.PROG(i-j+1)
  136.               BUVAP2=IP2VAI.PROG(i-j+1)
  137.               BUVEP1=IP2VEC.ICHPOI(i-j+1)
  138.               BUVEP2=IP2VEI.ICHPOI(i-j+1)
  139.  
  140.               IP2VAL.PROG(i-j+1)=IP2VAL.PROG(i-j)
  141.               IP2VAI.PROG(i-j+1)=IP2VAI.PROG(i-j)
  142.               IP2VEC.ICHPOI(i-j+1)=IP2VEC.ICHPOI(i-j)
  143.               IP2VEI.ICHPOI(i-j+1)=IP2VEI.ICHPOI(i-j)
  144.  
  145.               IP2VAL.PROG(i-j)=BUVAP1
  146.               IP2VAI.PROG(i-j)=BUVAP2
  147.               IP2VEC.ICHPOI(i-j)=BUVEP1
  148.               IP2VEI.ICHPOI(i-j)=BUVEP2
  149.             ELSE
  150.               GOTO 99
  151.             ENDIF
  152.           ENDDO
  153.         ENDIF
  154.  99   CONTINUE
  155. *On ecrase les listes non triees par les listes triees
  156.       IPLVAL=IP2VAL
  157.       IPLVEC=IP2VEC
  158.       IPLVAI=IP2VAI
  159.       IPLVEI=IP2VEI
  160.  
  161. *               **************************************
  162. *               ** CONSTRUCTION DE L'OBJET SOLUTION **
  163. *               **************************************
  164. *Boucle sur chacun des modes
  165.       DO 100 IB = 1,NBMOD
  166. *on récupère les chpoints reels et imaginaires
  167.          IPVECP=IPLVEC.ICHPOI(IB)
  168.          IPVECI=IPLVEI.ICHPOI(IB)
  169.  
  170.          CALL MUCPRI ( IPVECP, IPMASS, IPMX )
  171.          CALL MUCPRI ( IPVECI, IPMASS, IPMY )
  172.  
  173. * On calcule les quotients de rayleigh
  174.          CALL CORRSP ( IPMASS, IPVECP, IPMX, IPLMOX,IPLMOY )
  175.          CALL XTY1 ( IPVECP, IPMX, IPLMOX,IPLMOY,XMX )
  176.          CALL CORRSP ( IPMASS, IPVECP, IPMY, IPLMOX,IPLMOY )
  177.          CALL XTY1 ( IPVECP, IPMY, IPLMOX,IPLMOY,XMY )
  178.          CALL CORRSP ( IPMASS, IPVECI, IPMX, IPLMOX,IPLMOY )
  179.          CALL XTY1 ( IPVECI, IPMX, IPLMOX,IPLMOY,YMX )
  180.          CALL CORRSP ( IPMASS, IPVECI, IPMY, IPLMOX,IPLMOY )
  181.          CALL XTY1 ( IPVECI, IPMY, IPLMOX,IPLMOY,YMY )
  182.  
  183. *Remplissage de propre qui contient les infos modales
  184.          PROPRE(1) = IPLVAL.PROG(IB)
  185.          PROPRE(6) = IPLVAI.PROG(IB)
  186.          PROPRE(2) = XMX - YMY
  187.          PROPRE(7) = YMX + XMY
  188.  
  189. *Calcul des deplcaments generalises
  190.          CALL DEPGE2 (IPMASS, IPVECP, IPVECI, PROPRE, IPMX,
  191.      &           IPLMOX, IPLMOY)
  192.          IF ( IERR .NE. 0 ) RETURN
  193. * La partie reelle du mode est stocke dans un objet solution (ipmode)
  194.          CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,IB,IPMODE)
  195.  
  196.          IF ( IERR .NE. 0 ) RETURN
  197.          IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE )
  198. * On fusionne la partie reelle du mode propre calcule avec l'objet
  199. * solution courant
  200.          IF (IB .EQ. 1) THEN
  201.             IPSOLU = IPMODE
  202.          ELSE
  203.             CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 )
  204.             IF ( IERR .NE. 0 ) RETURN
  205.             CALL DESOLU( IPMODE )
  206.             IF ( IERR .NE. 0 ) RETURN
  207.             CALL DESOLU( IPSOLU )
  208.             IF ( IERR .NE. 0 ) RETURN
  209.             IPSOLU = IPSOL1
  210.          ENDIF
  211. * La partie imaginR du mode est stockee dans un objet solution (ipmode)
  212.          CALL CREMO1 (PROPRE,IPVECI,IPKW2M,INF0,IB,IPMODE)
  213.          IF ( IERR .NE. 0 ) RETURN
  214. * On fusionne la partie imaginaire du mode propre calcule avec l'objet
  215. * solution courant
  216.          IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE )
  217.          CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 )
  218.          IF ( IERR .NE. 0 ) RETURN
  219.          CALL DESOLU( IPMODE )
  220.          IF ( IERR .NE. 0 ) RETURN
  221.          CALL DESOLU( IPSOLU )
  222.          IF ( IERR .NE. 0 ) RETURN
  223.          IPSOLU = IPSOL1
  224.  
  225.  100  CONTINUE
  226.  
  227.       IPMODE = IPSOLU
  228.  
  229.       SEGDES IPLVEC,IPLVAL,IPLVEI,IPLVAI
  230.       SEGDES IP2VEC,IP2VAL,IP2VEI,IP2VAI
  231.  
  232. *on tue les chpoints de travail ...
  233.       CALL DTCHPO(IPMX)
  234.       CALL DTCHPO(IPMY)
  235.  
  236. *... les listreel de travail ...
  237.       CALL DTLREE(IP2VAL)
  238.       CALL DTLREE(IP2VAI)
  239.  
  240. *... et les listchpo de travail
  241.       CALL DTLCHP(IP2VEC)
  242.       CALL DTLCHP(IP2VEI)
  243.  
  244.       RETURN
  245.       END
  246.  
  247.  
  248.  

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