Sources Esope | Cast3M

simul7
C SIMUL7    SOURCE    CB215821  20/11/25    13:39:54     10792          
      SUBROUTINE SIMUL7(IPSOLU,IPMASS,IPKW2M,W2,IPLMOX,IPLMOY,IFLU)
C
C***********************************************************************
C
C     SBR APPELE PAR SIMUL1
C
C     VERSION  11/06/86   AUTEUR D. BROCHARD
C     modifs BP 06/01/2012 : ajout cas M non definie positive
C
C     CALCUL MASSE GENERALISEE ET DEPL. GEN. DANS LE CAS OU L ON FAIT
C     UN CALCUL DE MODES (VIBRATION) OPTION SIMULTANEE
C
C     IPSOLU : POINTEUR SUR L OBJET SOLUTION
C     IPMASS : POINTEUR SUR L OBJET RIGIDITE DE TYPE MASSE
C     PROPRE : VOIR ITINV
C
C     SOUS-PROGRAMMES APPELES : XTMX,MASGEN,DEPGEN
C
C***********************************************************************
C
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      REAL*8 PROPRE(5)
-INC CCREEL
-INC SMSOLUT
-INC SMCHPOI
 
-INC PPARAM
-INC CCOPTIO
*
      SEGMENT TRAV
      REAL*8 TT(NM),TT1(NM)
      INTEGER IORD(NM),IPOS(NM)
      ENDSEGMENT
*
      MSOLUT=IPSOLU
      SEGACT MSOLUT
      MSOLEN=MSOLIS(4)
      SEGACT MSOLEN
      NBMOD=ISOLEN(/1)
*
      NM=NBMOD
      SEGINI TRAV
*
      MSOLE1=MSOLIS(5)
      SEGACT MSOLE1
C
C
      DO 10 NMOD=1,NBMOD
      IPX=MSOLE1.ISOLEN(NMOD)
C
C     CALCUL DE XTMX (MASSE GENERALISEE SANS COEFF.)
C
**    CALL XTMX(MCHPOI,IPMASS,X1TMX1)
**    PROPRE(2)=X1TMX1
*
      CALL MUCPRI(IPX,IPMASS,IPBX)
C     IF(NMOD.EQ.1) CALL CORRSP(IPX,IPBX,IPLMOX,IPLMOY)
      CALL XTY1(IPX,IPBX,IPLMOX,IPLMOY,XMG)
      PROPRE(2)=XMG
*
C
C     CALCUL MASSE GEN. AVEC COEF.
C
      CALL MASGEN(IPX,PROPRE)
C
C     CALCUL DEPL. GEN.
C
      CALL DEPGEN(IPMASS,IPX,PROPRE,IPBX,IPLMOX,IPLMOY)
C
C     MODIFICATION DE L OBJET SOLUTION
C
      MMODE=ISOLEN(NMOD)
      SEGACT MMODE*MOD
      TT(NMOD)=FMMODD(1)
      DO 20 I=2,5
      FMMODD(I)=PROPRE(I)
20    CONTINUE
      SEGDES MMODE
10    CONTINUE
C
C     RANGER DANS TT1 LES FREQUENCES PAR ORDRE CROISSANT
C     IPOS(I) POSITION DANS TT DE LA IEME FREQ.
C
      DO 400 I=1,NBMOD
400   TT1(I)=0.E0
C
      TT1(1)=TT(1)
      DO 410 N1=2,NBMOD
      IF(TT(N1).LT.TT1(N1-1)) GOTO 420
      TT1(N1)=TT(N1)
      GOTO 410
420   CONTINUE
      DO 430 N2=1,(N1-1)
      N1M2=N1-N2-1
      IF(N1M2.EQ.0) GOTO 500
      IF(TT(N1).GT.TT1(N1M2)) GOTO 500
430   CONTINUE
C
C
500   CONTINUE
      N1M21=N1M2+1
      J=0
      DO 510 I=N1M21,(N1-1)
      TT1(N1-J)=TT1(N1-J-1)
      J=J+1
510   CONTINUE
      TT1(N1M21)=TT(N1)
410   CONTINUE
C
C     CALCUL DE LA POSITION DE LA IEME FREQUENCE
C
      DO 600 I=1,NBMOD
      FR=TT1(I)
      DO 605 J=1,NBMOD
      IF(FR.EQ.TT(J)) GOTO 610
605   CONTINUE
610   CONTINUE
      TT(J)=-1.
      IPOS(I)=J
600   CONTINUE
C
C
C     CALCUL DU NUMERO DU MODE
C
      CALL DIAGN1(IPKW2M,IND0)
*ajout bp 06/01/2012:
      CALL DIAGN1(IPMASS,nvp0M)
*     correction pour elements fluides (inconnue PI mise à 0 via INITFL)
c       nvp0M = nvp0M - IFLU
*     bp 10/01/2012: nvp0M et NEMSM ne semblent pas bien calculés ...
*     (resultats dependant machine -> cf. dyna7.dgibi)
*     on propose la solution qui suppose que nvp0M si M est LIQUIDE
      if(IFLU.gt.0) nvp0M=0
      if(nvp0M.ne.0) then
        if (W2.gt.0.D0) then
          IND0=nvp0M+IND0
        elseif (W2.lt.0.D0) then
          IND0=nvp0M-IND0
        else
          IND0=nvp0M
        endif
      endif
*rem : le cas ou ni K ni M ne sont defini positifs n est pas prevu pour
*     l instant car le théroème de Sylvester ne s'applique pas.
*     on va donc utiliser la formule ci dessus et planter dans strate
*     (ou au mieux fournir un numero faux)
 
      FIN=SQRT(W2)/(2.0*XPI)
      IF(FIN.LT.TT1(1)) GOTO 120
      IF(FIN.GT.TT1(NBMOD)) GOTO 130
      DO 100 IN=2,NBMOD
      IF(FIN.GE.TT1(IN-1).AND.FIN.LE.TT1(IN)) GOTO 110
100   CONTINUE
C
120   CONTINUE
C
C     FIN INF. A TT1(1) ON ASSOCIE IND0 A TT1(1)
C
      IREP=1
      IND0=IND0+1
      GOTO 140
130   CONTINUE
C
C     FIN SUP TT1(NMOD)  ON ASSOCIE  IND0 A TT1(NMOD)
C
      IREP=NBMOD
      GOTO 140
110   CONTINUE
C
C     CAS GENERAL ON ASSOCIE IND0 AU MODE JUSTE EN DESSOUS
C
C       IREP=IN
C       IF((TT1(IN)-FIN).LE.(FIN-TT1(IN-1)))  GOTO 140
      IREP=IN-1
140   CONTINUE
      DO 220 I=1,NBMOD
      IORD(IPOS(I))=IND0-IREP+I
220   CONTINUE
C
C
      IF(IIMPI.NE.30) GOTO 1500
      WRITE(IOIMP,*) (TT(I),I=1,NBMOD)
      WRITE(IOIMP,*) (TT1(I),I=1,NBMOD)
      WRITE(IOIMP,*) (IPOS(I),I=1,NBMOD)
      WRITE(IOIMP,*) (IORD(I),I=1,NBMOD)
C
C
C     MODIFICATION DE L OBJET SOLUTION
C
1500  CONTINUE
      DO 310 NMOD=1,NBMOD
      MMODE=ISOLEN(NMOD)
      SEGACT MMODE*MOD
      IMMODD(1)=IORD(NMOD)
      SEGDES MMODE
310   CONTINUE
      SEGDES MSOLE1,MSOLEN,MSOLUT
      SEGSUP TRAV
      IPMODE=MSOLUT
C
C     MESSAGE D AVERTISSEMENT
C
      IF (IIMPI.EQ.2) THEN
      WRITE(IOIMP,1000)
1000  FORMAT(/40X,'ATTENTION OPERATEUR VIBRA OPTION SIMUL',
     C       /40X,'--------------------------------------',
     C/10X,'LE NUMERO DU MODE EST CALCULE A PARTIR DU NOMBRE MODES',
     C/10X,' PROPRES INFERIEURS A LA FREQUENCE FOURNIE PAR L  UTILI',
     C     'SATEUR')
C
*     IMPRESSION DU MODE CALCULE:
      WRITE (IOIMP,2000)
 2000 FORMAT ('1MODE PROPRE CALCULE:'/' --------------------'//)
      CALL ECMODE (IPMODE)
      ENDIF
*
C
      RETURN
      END