C CCSOLU SOURCE CB215821 20/11/25 13:19:07 10792 SUBROUTINE CCSOLU (W2,IPLVAL,IPLVAI,IPLVEC,IPLVEI, & IPKW2M,IPMASS,IPSOLU,INF0) ************************************************************************ * * C C S O L U * * * * FONCTION: * --------- * * CONSTRUCTION D'UN OBJET SOLUTION, A PARTIR DES LISTES DES * FREQUENCES PROPRES ET DES MODES PROPRES POUR UN PROBLEME NON * SYMETRIQUE * * NB: LES LISTES SONT SUPPOSES NON TRIEES, UN TRI EST FAIT PAR * ORDRE DE CROISSANCE DE LA PARTIE REELE DES FREQUENCES PROPRES * * SOUS PROGRAMME INSPIRE DU CRSOLU ADAPTE AU CAS COMPLEXE * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * W2 REEL DP (E) FREQUENCE DE SHIFT * * IPLVAL ENTIER (E) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT * LA SUITE DES FREQUENCES PROPRES REELLES * * IPLVAI ENTIER (E) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT * LA SUITE DES FREQUENCES PROPRES IMAGINAIRES * * IPLVEC ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT * LA SUITE DES MODES PROPRES REELS * * IPLVEI ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT * LA SUITE DES MODES PROPRES IMAGINAIRES * * IPKW2M, IPMASS (E) MATRICES DE RIGIDITE (DECALEE) ET DE MASSE * * * IPSOLU ENTIER (S) POINTEUR SUR LA SOLUTION CREE * * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL BOUDA 8 JUILLET 2015 * ************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMLCHPO -INC SMCHPOI -INC SMLREEL -INC SMLMOTS -INC CCREEL -INC SMSOLUT PARAMETER (LPROPR = 10) POINTEUR IPLVEC.MLCHPO, IPLVAL.MLREEL POINTEUR IPLVEI.MLCHPO, IPLVAI.MLREEL *pointeurs de travail POINTEUR IP2VEC.MLCHPO, IP2VAL.MLREEL POINTEUR IP2VEI.MLCHPO, IP2VAI.MLREEL INTEGER NBMOD, IPKW2M, IPMASS, IPSOLU POINTEUR IPLMOX.MLMOTS, IPLMOY.MLMOTS INTEGER IPMX,IPMY, IPMODE, IPSOL1 REAL*8 PROPRE(LPROPR) * PROPRE(1) = PARTIE REELLE DU MODE PRORPE, * PROPRE(2) = (X)T.|B|.(X) , (X) 'CHPOINT' SOLUTION * PROPRE(3,4,5) DEPL.GEN. REELS SELON X,Y,Z * PROPRE(6)= PARTIE IMAGINAIRE DU MODE PROPRE * PROPRE(7)=PARTIE IM. DE XT.|B|.X * PROPRE(8,9,10) PARTIE IM DES DEP. GEN. REAL*8 XMX, XMY, YMY, YMX REAL*8 BUVAP1,BUVAP2 INTEGER BUVEP1,BUVEP2 INTEGER i,j * ******************* * ** TRI DES MODES ** * ******************* SEGACT IPLVEC*MOD SEGACT IPLVAL*MOD SEGACT IPLVEI*MOD SEGACT IPLVAI*MOD *Recuparation du nombre de modes NBMOD=IPLVAL.PROG(/1) *Initialisation des segements de travail JG=NBMOD SEGINI IP2VAL SEGINI IP2VAI N1=NBMOD SEGINI IP2VEC SEGINI IP2VEI *Boucle sur tous les modes existants DO 99 i=1,NBMOD *A chaque iteration, on ajoute un mode en bout de liste IP2VAL.PROG(i)=IPLVAL.PROG(i) IP2VAI.PROG(i)=IPLVAI.PROG(i) IP2VEC.ICHPOI(i)=IPLVEC.ICHPOI(i) IP2VEI.ICHPOI(i)=IPLVEI.ICHPOI(i) IF (i .NE. 1) THEN *Boucle de tri: tant que la partie reelle de la frequence propre du *mode est inferieure a celle qui la precede,on la decale vers la gauche DO j=1,i-1 IF (IP2VAL.PROG(i-j+1).LE.IP2VAL.PROG(i-j)) THEN BUVAP1=IP2VAL.PROG(i-j+1) BUVAP2=IP2VAI.PROG(i-j+1) BUVEP1=IP2VEC.ICHPOI(i-j+1) BUVEP2=IP2VEI.ICHPOI(i-j+1) IP2VAL.PROG(i-j+1)=IP2VAL.PROG(i-j) IP2VAI.PROG(i-j+1)=IP2VAI.PROG(i-j) IP2VEC.ICHPOI(i-j+1)=IP2VEC.ICHPOI(i-j) IP2VEI.ICHPOI(i-j+1)=IP2VEI.ICHPOI(i-j) IP2VAL.PROG(i-j)=BUVAP1 IP2VAI.PROG(i-j)=BUVAP2 IP2VEC.ICHPOI(i-j)=BUVEP1 IP2VEI.ICHPOI(i-j)=BUVEP2 ELSE GOTO 99 ENDIF ENDDO ENDIF 99 CONTINUE *On ecrase les listes non triees par les listes triees IPLVAL=IP2VAL IPLVEC=IP2VEC IPLVAI=IP2VAI IPLVEI=IP2VEI * ************************************** * ** CONSTRUCTION DE L'OBJET SOLUTION ** * ************************************** *Boucle sur chacun des modes DO 100 IB = 1,NBMOD *on récupère les chpoints reels et imaginaires IPVECP=IPLVEC.ICHPOI(IB) IPVECI=IPLVEI.ICHPOI(IB) CALL MUCPRI ( IPVECP, IPMASS, IPMX ) CALL MUCPRI ( IPVECI, IPMASS, IPMY ) * On calcule les quotients de rayleigh CALL CORRSP ( IPMASS, IPVECP, IPMX, IPLMOX,IPLMOY ) CALL XTY1 ( IPVECP, IPMX, IPLMOX,IPLMOY,XMX ) CALL CORRSP ( IPMASS, IPVECP, IPMY, IPLMOX,IPLMOY ) CALL XTY1 ( IPVECP, IPMY, IPLMOX,IPLMOY,XMY ) CALL CORRSP ( IPMASS, IPVECI, IPMX, IPLMOX,IPLMOY ) CALL XTY1 ( IPVECI, IPMX, IPLMOX,IPLMOY,YMX ) CALL CORRSP ( IPMASS, IPVECI, IPMY, IPLMOX,IPLMOY ) CALL XTY1 ( IPVECI, IPMY, IPLMOX,IPLMOY,YMY ) *Remplissage de propre qui contient les infos modales PROPRE(1) = IPLVAL.PROG(IB) PROPRE(6) = IPLVAI.PROG(IB) PROPRE(2) = XMX - YMY PROPRE(7) = YMX + XMY *Calcul des deplcaments generalises CALL DEPGE2 (IPMASS, IPVECP, IPVECI, PROPRE, IPMX, & IPLMOX, IPLMOY) IF ( IERR .NE. 0 ) RETURN * La partie reelle du mode est stocke dans un objet solution (ipmode) CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,IB,IPMODE) IF ( IERR .NE. 0 ) RETURN IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE ) * On fusionne la partie reelle du mode propre calcule avec l'objet * solution courant IF (IB .EQ. 1) THEN IPSOLU = IPMODE ELSE CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 ) IF ( IERR .NE. 0 ) RETURN CALL DESOLU( IPMODE ) IF ( IERR .NE. 0 ) RETURN CALL DESOLU( IPSOLU ) IF ( IERR .NE. 0 ) RETURN IPSOLU = IPSOL1 ENDIF * La partie imaginR du mode est stockee dans un objet solution (ipmode) CALL CREMO1 (PROPRE,IPVECI,IPKW2M,INF0,IB,IPMODE) IF ( IERR .NE. 0 ) RETURN * On fusionne la partie imaginaire du mode propre calcule avec l'objet * solution courant IF ( IIMPI .EQ. 2 ) CALL ECMODE ( IPMODE ) CALL FUSOLU( IPSOLU, IPMODE, IPSOL1 ) IF ( IERR .NE. 0 ) RETURN CALL DESOLU( IPMODE ) IF ( IERR .NE. 0 ) RETURN CALL DESOLU( IPSOLU ) IF ( IERR .NE. 0 ) RETURN IPSOLU = IPSOL1 100 CONTINUE IPMODE = IPSOLU SEGDES IPLVEC,IPLVAL,IPLVEI,IPLVAI SEGDES IP2VEC,IP2VAL,IP2VEI,IP2VAI *on tue les chpoints de travail ... CALL DTCHPO(IPMX) CALL DTCHPO(IPMY) *... les listreel de travail ... CALL DTLREE(IP2VAL) CALL DTLREE(IP2VAI) *... et les listchpo de travail CALL DTLCHP(IP2VEC) CALL DTLCHP(IP2VEI) RETURN END