Sources Esope | Cast3M

evol23
C EVOL23    SOURCE    BP208322  22/09/09    21:15:04     11448          
C 
      SUBROUTINE EVOL23(IBOO,ILEX,ILEN1,ILEN3)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C=======================================================================
C ILEX CONTIENT LA SUITE DES CHPOINTS DES CONTRIBUTIONS MODALES.
C POUR LES COUPLES POINTS COMPOSANTES CONTENUS DANS NUMOO,
C ON RECOMBINE LES MODES dont les deformee sont CONTENUeS DANS ILEN1
C RESULTAT DANS LE(S) LISTREEL KLIST.
C APPELE PAR EVRECO
C APPELLE : ERREUR(61,243,18) IANUL PROSC1
C CREATION:BP, 2017-07-18 : inspire de EVOL22
C=======================================================================
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLREEL
-INC SMLENTI
-INC SMELEME
-INC SMTABLE
-INC SMCOORD
      SEGMENT/ITRAV1/(TRAV(LDEPL,N)*D)
      SEGMENT/ITRAV2/(TRAVV(LDEPL,LTEMP)*D)
      SEGMENT NUMOO
       INTEGER NUMO(N),KLIST(N)
       CHARACTER*(LOCHPO) NUDDL(N)
      ENDSEGMENT
      CHARACTER*4 NUJ
C
      LDEPL=0
      NUMOO=IBOO
      SEGACT NUMOO*MOD
      N=NUMO(/1)
 
C     MLENT1 = LISTE DES DEFORMEES MODALES
C     MLENT3 = LISTE DES LISTREEL alpha_i(t)
      MLENT1=ILEN1
      MLENT3=ILEN3
      SEGACT MLENT1,MLENT3
 
C ---------------------------------------------------------------------
C     FABRICATION DU TABLEAU ITRAV1.TRAV(LDEPL,N)
C     DES MODES REDUITS AUX POINTS DE SORTIE
C ---------------------------------------------------------------------
 
      LDEPL=MLENT1.LECT(/1)      
      SEGINI ITRAV1
 
C --- BOUCLE SUR LES MODES ----------------------------------
      LDEP=MLENT1.LECT(/1)
      DO 40 I=1,LDEP
 
        ICHP=MLENT1.LECT(I)
 
C   --- BOUCLE SUR LES DDL ----------------------------------
        DO 41 IP=1,N
c         recup du noeud et du nom de composante
          MPOINT=NUMO(IP)
          NUJ=NUDDL(IP)
          call EXTRA9(ICHP,MPOINT,NUJ,0,.FALSE.,XFLOT,IRET)
c         TRAV(I^eme mode,IP^eme ddl)=[ \phi_I(x_IP) ]_{I=1...LDEP}
          TRAV(I,IP)=XFLOT
 41     CONTINUE
 
 40   CONTINUE
 
C ---------------------------------------------------------------------
C     CREATION DE N LISREELS (OU N=NOMBRE DE DDLS A SORTIR)
C     DE TAILLE LTEM = NOMBRE DE PAS DE TEMPS A SORTIR
C ---------------------------------------------------------------------
C
      MLENTI=ILEX
      SEGACT MLENTI
      LTEM=LECT(/1)
      JG=LTEM
      DO 99 IP=1,N
        SEGINI MLREEL
        KLIST(IP)=MLREEL
 99   CONTINUE
 
C ---------------------------------------------------------------------
C     FABRICATION DU TABLEAU ITRAV2.TRAVV(LDEPL)
C     DES ALPHA_I AUX TEMPS DE SORTIE
C ---------------------------------------------------------------------
      LTEMP=LTEM
      SEGINI ITRAV2
 
C --- BOUCLE SUR LES MODES ----------------------------------
      DO 60 I=1,LDEP
 
c       alpha_i(t)
        MLREEL=MLENT3.LECT(I)
        segact,MLREEL
 
c   --- BOUCLE SUR LES PAS DE TEMPS ------------------------ 
        DO 62 JL=1,LTEM
          J=LECT(JL)
          TRAVV(I,JL)=PROG(J)
 62     CONTINUE
 
        segdes,MLREEL
 
 60   CONTINUE
 
C ---------------------------------------------------------------------
C     CALCUL DE x(t) DEMANDE
C ---------------------------------------------------------------------
 
c --- BOUCLE SUR LES DDL ----------------------------------- 
      DO 51 IP=1,N
 
        MLREEL=KLIST(IP)
 
C   --- BOUCLE SUR LES PAS DE TEMPS A SORTIR ------------------------ 
        DO 52 JL=1,LTEM
 
c         x_ip(t_J) = \sum_I  alpha_I(t_J)  * \phi_I(x_IP)
          CALL PROSC1(TRAVV(1,JL),TRAV(1,IP),X,LDEP)
          PROG(JL)=X
 
 52     CONTINUE
 
 51   CONTINUE
 
 
C ---------------------------------------------------------------------
c     SUPPRESSION ET FERMETURE DES SEGMENTS
C ---------------------------------------------------------------------
C
      SEGSUP ITRAV1,ITRAV2      
      SEGDES MLENT1,MLENT3
      DO 98 JJ=1,N
        MLREEL=KLIST(JJ)
        SEGDES MLREEL
  98  CONTINUE  
      SEGDES MLENTI
 
 5000 CONTINUE
      RETURN
      END