1 : C CREMOD SOURCE BP208322 09/03/20 21:15:06 6331 2 : * SUBROUTINE CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ, 3 : * > NUMODE2,IPMODE) 4 : SUBROUTINE CREMOD (PROPRE,IPVECP,IPKW2M,INF0, 5 : > NUMODE2,IPMODE) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : ************************************************************************ 9 : * 10 : * C R E M O D 11 : * ----------- 12 : * 13 : * FONCTION: 14 : * --------- 15 : * 16 : * CREATION DE L'OBJET REPRESENTANT LE MODE PROPRE CALCULE. 17 : * 18 : * MODE D'APPEL: 19 : * ------------- 20 : * 20 : * CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ,NUMODE2,IPMODE) 21 : * 22 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 23 : * ----------- 24 : * 25 : * PROPRE REEL DP (E) TABLEAU DE CARACTERISTIQUES DU MODE PROPRE 26 : * CALCULE: 27 : * PROPRE(1) = FREQUENCE PROPRE, 28 : * PROPRE(2) = MASSE GENERALISEE, 29 : * PROPRE(3,4 ET 5) = DEPLACEMENTS GENERALISES 30 : * IPVECP ENTIER (E) POINTEUR DU 'CHPOINT' PROPRE. 31 : * IPKW2M ENTIER (E) POINTEUR DE LA 'RIGIDITE' "DECALEE" QUI A 32 : * SERVI AU CALCUL DU MODE PROPRE. 33 : * INF0 ENTIER (E) NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA 34 : * 'RIGIDITE' "K" NON "DECALEE" LORSQU'ELLE 35 : * EST DECOMPOSEE EN LT.D.L.(il est nul.On 36 : * l'a laissé parce qu'on est paresseux) 37 : * FREQ REEL DP (E) FREQUENCE QUI A ETE UTILISEE POUR LE 38 : * DECALAGE DE LA 'RIGIDITE' "K". 39 : * 40 : * NUMODE2 ENTIER (E) TERME CORRECTIF DANS LE CAS DES ITERATIONS 41 : * SIMULTANEES,POUR CALCULER LE NUMERO DU MODE 42 : * (dans les iterations simples numode2=0) 43 : * IPMODE ENTIER (S) POINTEUR DE L'OBJET 'SOLUTION' REPRESENTANT 44 : * LE MODE PROPRE. 45 : * 46 : * SOUS-PROGRAMMES APPELES: 47 : * ------------------------ 48 : * 49 : * DIAGN1, ECR..., LIR.ALL/LIMO. 50 : * 51 : * AUTEUR, DATE DE CREATION: 52 : * ------------------------- 53 : * 54 : * PASCAL MANIGOT 28 NOVEMBRE 1984 55 : * MODIF: Benoit Prabel Mars 2009 56 : * 57 : * LANGAGE: 58 : * -------- 59 : * 60 : * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. 61 : * 62 : ************************************************************************ 63 : * 64 : -INC CCOPTIO 65 : * 66 : REAL*8 PROPRE(*),FREQ,GDEPL1,GDEPL2,GDEPL3,FREQPP,GMASSE 67 : * 68 : * 69 : * 70 : * VALEURS LITTERALES POUR LE SOUS-PROGRAMME "MANUMO": 71 : * 72 : * FREQPP = PROPRE(1) 73 : * GMASSE = PROPRE(2) 74 : * GDEPL1 = PROPRE(3) 75 : * GDEPL2 = PROPRE(4) 76 : * GDEPL3 = PROPRE(5) 77 : * 78 : * -- NUMERO DU MODE TROUVE -- 79 : * 79 : CALL DIAGN1 (IPKW2M,NMODEN) 80 : IF (IERR .NE. 0) RETURN 81 : * IF (NUMODE2.EQ. 0) THEN 82 : * FREQPP = PROPRE(1) 83 : * IF (FREQPP .GE. FREQ) THEN 84 : * NUMODE = NUMODE + 1 85 : * END IF 86 : * ENDIF 87 : NUMODE = NMODEN + NUMODE2 88 : NUMODE = NUMODE - INF0 89 : * write(6,*)'cremod : (NMODEN + NUMODE2) - INFO = NUMODE' 90 : * write(6,*) NMODEN,NUMODE2,INF0,NUMODE 91 : IF (IIMPI .EQ. 747) THEN 92 : WRITE (IOIMP,*) 'NUMERO DU MODE OBTENU = ',NUMODE 93 : WRITE (IOIMP,*) '---------------------' 94 : END IF 95 : * 96 : * RQ: PAR SOUCIS D'ECONOMIE, ON NE CHERCHE PAS LE NUMERO DU MODE 97 : * TROUVE EN DECOMPOSANT LA 'RIGIDITE' DECALEE DE LA VALEUR 98 : * EXACTE DE LA PULSATION PROPRE AU CARRE. 99 : * LE RESULTAT EST QUE, SI L'ON EST EN PRESENCE D'UN MODE 100 : * MULTIPLE DE FREQUENCE PROPRE INFERIEURE AU DECALAGE APPROCHE 101 : * EFFECTUE SUR "K", ALORS "NUMODE" SERA EGAL AU NUMERO D'ORDRE 102 : * DE LA FREQUENCE PROPRE + (ORDRE DE MULTIPLICITE) - 1 AU LIEU 103 : * D'ETRE EGAL SIMPLEMENT AU NUMERO D'ORDRE DE LA FREQUENCE. 104 : * 105 : * -- CREATION DU MODE -- 106 : * 107 : * ATTENTION LES FLOTTANTS PASSES A ECRIRE DOIVENT ETRE 108 : * EN SIMPLE PRECISION 108 : * CALL ECROBJ ('CHPOINT ',IPVECP) 108 : * CALL ECRREE (GDEPL3) 108 : * CALL ECRREE (GDEPL2) 108 : * CALL ECRREE (GDEPL1) 108 : * CALL ECRREE (GMASSE) 108 : * CALL ECRREE (FREQPP) 108 : * CALL ECRENT (NUMODE) 108 : * CALL ECRCHA ('NUME') 108 : * CALL MANUMO 109 : * 109 : CALL MANUSO('MODE ',NUMODE,PROPRE(1),PROPRE(2),PROPRE(3) 110 : C ,PROPRE(4),PROPRE(5),IPVECP,0,0,IPMODE) 111 : * 112 : IF (IERR .NE. 0) RETURN 113 : ICODE = 1 113 : * CALL LIROBJ ('SOLUTION',IPMODE,ICODE,IRETOU) 114 : * IF (IERR .NE. 0) RETURN 115 : * 116 : END 117 : 118 :
© Cast3M 2003 - All rights reserved.
Disclaimer