C CREMOD SOURCE BP208322 09/03/20 21:15:06 6331 * SUBROUTINE CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ, * > NUMODE2,IPMODE) SUBROUTINE CREMOD (PROPRE,IPVECP,IPKW2M,INF0, > NUMODE2,IPMODE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) ************************************************************************ * * C R E M O D * ----------- * * FONCTION: * --------- * * CREATION DE L'OBJET REPRESENTANT LE MODE PROPRE CALCULE. * * MODE D'APPEL: * ------------- * * CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ,NUMODE2,IPMODE) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * PROPRE REEL DP (E) TABLEAU DE CARACTERISTIQUES DU MODE PROPRE * CALCULE: * PROPRE(1) = FREQUENCE PROPRE, * PROPRE(2) = MASSE GENERALISEE, * PROPRE(3,4 ET 5) = DEPLACEMENTS GENERALISES * IPVECP ENTIER (E) POINTEUR DU 'CHPOINT' PROPRE. * IPKW2M ENTIER (E) POINTEUR DE LA 'RIGIDITE' "DECALEE" QUI A * SERVI AU CALCUL DU MODE PROPRE. * INF0 ENTIER (E) NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA * 'RIGIDITE' "K" NON "DECALEE" LORSQU'ELLE * EST DECOMPOSEE EN LT.D.L.(il est nul.On * l'a laissé parce qu'on est paresseux) * FREQ REEL DP (E) FREQUENCE QUI A ETE UTILISEE POUR LE * DECALAGE DE LA 'RIGIDITE' "K". * * NUMODE2 ENTIER (E) TERME CORRECTIF DANS LE CAS DES ITERATIONS * SIMULTANEES,POUR CALCULER LE NUMERO DU MODE * (dans les iterations simples numode2=0) * IPMODE ENTIER (S) POINTEUR DE L'OBJET 'SOLUTION' REPRESENTANT * LE MODE PROPRE. * * SOUS-PROGRAMMES APPELES: * ------------------------ * * DIAGN1, ECR..., LIR.ALL/LIMO. * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 28 NOVEMBRE 1984 * MODIF: Benoit Prabel Mars 2009 * * LANGAGE: * -------- * * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. * ************************************************************************ * -INC PPARAM -INC CCOPTIO * REAL*8 PROPRE(*),FREQ,GDEPL1,GDEPL2,GDEPL3,FREQPP,GMASSE * * * * VALEURS LITTERALES POUR LE SOUS-PROGRAMME "MANUMO": * * FREQPP = PROPRE(1) * GMASSE = PROPRE(2) * GDEPL1 = PROPRE(3) * GDEPL2 = PROPRE(4) * GDEPL3 = PROPRE(5) * * -- NUMERO DU MODE TROUVE -- * CALL DIAGN1 (IPKW2M,NMODEN) IF (IERR .NE. 0) RETURN * IF (NUMODE2.EQ. 0) THEN * FREQPP = PROPRE(1) * IF (FREQPP .GE. FREQ) THEN * NUMODE = NUMODE + 1 * END IF * ENDIF NUMODE = NMODEN + NUMODE2 NUMODE = NUMODE - INF0 * write(6,*)'cremod : (NMODEN + NUMODE2) - INFO = NUMODE' * write(6,*) NMODEN,NUMODE2,INF0,NUMODE IF (IIMPI .EQ. 747) THEN WRITE (IOIMP,*) 'NUMERO DU MODE OBTENU = ',NUMODE WRITE (IOIMP,*) '---------------------' END IF * * RQ: PAR SOUCIS D'ECONOMIE, ON NE CHERCHE PAS LE NUMERO DU MODE * TROUVE EN DECOMPOSANT LA 'RIGIDITE' DECALEE DE LA VALEUR * EXACTE DE LA PULSATION PROPRE AU CARRE. * LE RESULTAT EST QUE, SI L'ON EST EN PRESENCE D'UN MODE * MULTIPLE DE FREQUENCE PROPRE INFERIEURE AU DECALAGE APPROCHE * EFFECTUE SUR "K", ALORS "NUMODE" SERA EGAL AU NUMERO D'ORDRE * DE LA FREQUENCE PROPRE + (ORDRE DE MULTIPLICITE) - 1 AU LIEU * D'ETRE EGAL SIMPLEMENT AU NUMERO D'ORDRE DE LA FREQUENCE. * * -- CREATION DU MODE -- * * ATTENTION LES FLOTTANTS PASSES A ECRIRE DOIVENT ETRE * EN SIMPLE PRECISION * CALL ECROBJ ('CHPOINT ',IPVECP) * CALL ECRREE (GDEPL3) * CALL ECRREE (GDEPL2) * CALL ECRREE (GDEPL1) * CALL ECRREE (GMASSE) * CALL ECRREE (FREQPP) * CALL ECRENT (NUMODE) * CALL ECRCHA ('NUME') * CALL MANUMO * CALL MANUSO('MODE ',NUMODE,PROPRE(1),PROPRE(2),PROPRE(3) C ,PROPRE(4),PROPRE(5),IPVECP,0,0,IPMODE) * IF (IERR .NE. 0) RETURN ICODE = 1 * CALL LIROBJ ('SOLUTION',IPMODE,ICODE,IRETOU) * IF (IERR .NE. 0) RETURN * END