C CRSOL1 SOURCE BP208322 09/03/20 21:15:07 6331 ************************************************************************ * * CRSOL1 * ----------- * * FONCTION: * --------- * * -- CONSTRUCTION D'UN OBJET SOLUTION, A PARTIR DE LA LISTE * DES FREQUENCES PROPRES ET DE CELLE DES MODES PROPRES. * LES LISTES SONT SUPPOSES TRIEES, LES FREQUENCES SHIFTEES, * ET LES MODES ORTHONORMALISES. -- * * MODE D'APPEL: * ------------- * * CALL CRSOL1 (FREQ,IPLVAR,IPLVAI,IPLVER, IPLVEI, NBMOD, IPKW2M, IPMASS, * & MTAB3, ICOMP, I) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IPLVAR 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 IMAGINAIRES * IPLVER 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. * NBMOD ENTIER (E) NOMBRE DE MODES A INSERER DANS LA SOLUTION * ON A: NBMOD .LE. DIMENSION( IPLVAL ) * * IPKW2M, IPMASS (E) MATRICES DE RIGIDITE (DECALEE) ET DE MASSE * * FREQ REEL (E) FREQUENCE UTILISEE POUR LE DECALLAGE * * MTAB3 ENTIER (S) POINTEUR SUR LA SOLUTION CREEE. * * * AUTEUR, DATE DE CREATION: * ------------------------- * * C. LE BIDEAU 09 / 2001 ( FORTRAN + ESOPE ) * MODIF Benoit Prabel Mars 2009 * *************************************************** * SUBROUTINE CRSOL1 (FREQ,IPLVAR,IPLVAI,IPLVER, IPLVEI, * & NBMOD,IPKW2M,IPMASS,MTAB3,ICOMP, I) SUBROUTINE CRSOL1 (W2,IPLVAR,IPLVAI,IPLVER,NBMOD,NBMOD2, & IPKW2M,IPMASS,MTAB3,I,INF0) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC SMLCHPO -INC SMLREEL -INC SMLMOTS -INC SMTABLE -INC CCREEL ****** * -- CONSTANTES -- *** PARAMETER (LPROPR = 10) PARAMETER (DEUXPI = (2.D0*XPI)) ****** * -- ARGUMENTS -- *** POINTEUR IPLVER.MLCHPO,IPLVAR.MLREEL,IPLVAI.MLREEL INTEGER NBMOD, IPKW2M, IPMASS ****** * -- VARIABLES LOCALES -- *** POINTEUR IPLMOX.MLMOTS, IPLMOY.MLMOTS INTEGER IPMODE, IPSOL1 REAL*8 W2, PROPRE(LPROPR),PROPR2(LPROPR),XRVP, XIVP ***** ACTIVATIONS **************************************************** SEGACT ,IPLVER, IPLVAR, IPLVAI *-----initialisation NBNEG = 1 NBPOS = 0 ***** BOUCLE SUR LES MODES A ECRIRE ********************************** JVEC = 0 * DO 100 IB100 = 1, NBMOD DO 100 IB100 = 1, NBMOD2 JVEC = JVEC + 1 *------ frequence propre XRVP = IPLVAR.PROG(JVEC) XIVP = IPLVAI.PROG(JVEC) PROPRE(1) = XRVP PROPRE(6) = XIVP *------ numero du mode (indicé selon lambda) * NUMOD2 = JVEC - NNBMOD XLAMBR = (DEUXPI**2) * ((XRVP**2) - (XIVP**2)) * WRITE(6,*) 'CRSOL1: mode',JVEC * WRITE(6,*) ' w=',XRVP,'+i',XIVP,'L=',XLAMBR,'W2=',W2 if(XLAMBR .lt. W2) then NBNEG = NBNEG - 1 NUMOD2 = NBNEG else NBPOS = NBPOS + 1 NUMOD2 = NBPOS endif * write(6,*) 'NBNEG,NBPOS,NUMOD2=',NBNEG,NBPOS,NUMOD2 *------ partie reelle du vecteur propre IPRX = IPLVER.ICHPOI(JVEC) *------ debut masse généralisée + eventuelle recup des mots utiles CALL MUCPRI ( IPRX, IPMASS, IPBXR ) IF (IB100 .EQ. 1) THEN CALL CORRSP(IPMASS, IPRX, IPBXR, IPLMOX, IPLMOY) END IF CALL XTY1(IPRX, IPBXR, IPLMOX, IPLMOY, XRBXR) IF (IERR .NE. 0 ) RETURN *------ Cas d'un mode Réel IF((XRVP .eq. 0.) .or. (XIVP .eq. 0.)) then * valeur propre w réelle pure ou imaginaire pure (car lambda réel pur) * vecteur propre reel = IPRX IPIX = 0 * masse complexe généralisée PROPRE(2) = XRBXR PROPRE(7) = 0.D0 C INTRODUCTION DES COEF. PI OU 2PI EVENTUELS + calcul DEPGEN * CALL MASGEN(XRVP,PROPRE) CALL DEPGEN(IPMASS, IPRX, PROPRE, IPBXR, IPLMOX,IPLMOY) * Ecriture dans MTAB3 du I^eme mode CALL CREBAS (PROPRE, IPRX, IPIX, IPKW2M, INF0, & NUMOD2, MTAB3, I) I = I+1 *------ Cas d'un mode Complexe ELSE IPIX = IPLVER.ICHPOI(JVEC + 1) * valeur et vecteur propre complexe',IPIX * fin du calcul de la masse complexe généralisée CALL XTY1(IPIX, IPBXR, IPLMOX, IPLMOY, XIBXR) CALL MUCPRI(IPIX, IPMASS, IPBXI) CALL XTY1(IPRX, IPBXI, IPLMOX, IPLMOY, XRBXI) CALL XTY1(IPIX, IPBXI, IPLMOX, IPLMOY, XIBXI) PROPRE(2) = XRBXR - XIBXI PROPRE(7) = XIBXR + XRBXI * write(*,*)'masse gene complexe=',(PROPRE(2)),(PROPRE(7)) C INTRODUCTION DES COEF. PI OU 2PI EVENTUELS + calcul DEPGEN CALL DEPGEN(IPMASS, IPRX, PROPRE, IPBXR, IPLMOX,IPLMOY) CALL DEPGE2(IPMASS, IPRX,IPIX, PROPRE, IPBXR, IPLMOX,IPLMOY) * write(*,*)'* on decale JVEC...' JVEC = JVEC + 1 if(XLAMBR .lt. W2) then NBNEG = NBNEG - 1 else NBPOS = NBPOS + 1 endif * Ecriture dans MTAB3 du I^eme mode CALL CREBAS (PROPRE, IPRX, IPIX, IPKW2M, INF0, & NUMOD2, MTAB3, I) I = I+1 * Ecriture dans MTAB3 du I+1^eme mode (=conjugué du 1er) PROPR2(1) = IPLVAR.PROG(JVEC) PROPR2(6) = IPLVAI.PROG(JVEC) PROPR2(2) = -1.*PROPRE(2) PROPR2(7) = -1.*PROPRE(7) call MUCHPO(IPIX,-1.,IPIXCONJ,1) CALL CREBAS (PROPR2, IPRX, IPIXCONJ, IPKW2M, INF0, & NUMOD2, MTAB3, I) I = I+1 ENDIF *-------fin de la distinction Mode reel/complexe CALL DTCHPO ( IPBXR ) if((XRVP .ne. 0.) .and. (XIVP .ne. 0.)) & CALL DTCHPO ( IPBXI ) IF ( IERR .NE. 0 ) RETURN if(JVEC .ge. NBMOD2) goto 900 100 CONTINUE 900 CONTINUE SEGDES ,IPLVER, IPLVAR, IPLVAI RETURN END