Sources Esope | Cast3M

evtemp
C EVTEMP    SOURCE    CB215821  22/08/22    21:15:02     11429          
      SUBROUTINE EVTEMP(LCOUL)                                                  
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
************************************************************************
* NOM         : EVRESU
* DESCRIPTION : Evolution temporelle d'un resultat de calcul pour un
*               ensemble de noeuds et un ensemble d'instants donnes
************************************************************************
* APPELE PAR : evol.eso
************************************************************************
* SYNTAXE (GIBIANE) :
*
* EVOL1 = EVOL (|COUL1 |) 'TEMP' |LCHP1 LREE1| (LIPDT1)  --------+
*               |LCOUL1|         |TAB1 (MOT1)|                   |
*                                                                |
*                                     +--------------------------+
*                                     |
*                                     +--->   |COMP1  | |POIN1   | ;
*                                             |LCOMP1 | |MAIL1   |
*                                                       |N1 N2 N3|
 
************************************************************************     
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC SMTABLE
-INC SMLENTI
-INC SMLMOTS
*
      POINTEUR LCOMP.MLMOTS
      POINTEUR LCOUL.MLENTI
      CHARACTER*(LOCOMP) MOCMP1
      CHARACTER*8 CHA8,CHB8
      CHARACTER*32 CH32
      CHARACTER*72 CH72
      LOGICAL ZLOGI
*
*
*     SI ON EST DANS LE CAS D'UNE VARIABLE DE TYPE MCHAML DANS UNE TABLE
*     PASAPAS => BRANCHEMENT VERS EVTEM1 (ANCIENNE SUBROUTINE EVTEMP
*     REBAPTISEE DEPUIS)
      LCH32=0
      CALL LIROBJ('TABLE',ITAB1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 1
      CHA8=' '
      CALL ACCTAB(ITAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,
     &                   CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2)
      IF (CHA8.NE.'MOT') THEN
         MOTERR(1:8)='TABLE'
         CALL ERREUR(302)
         RETURN
      ENDIF
      IF (CHB8.NE.'PASAPAS') GOTO 1
      CALL LIRCHA(CH32,0,LCH32)
      IF (LCH32.EQ.0) GOTO 1
      CHA8=' '
      CALL ACCTAB(ITAB1,'MOT',0,0.D0,CH32(1:LCH32),.TRUE.,0,
     &                  'TABLE',IVAL,XVAL,CHB8,ZLOGI,ITAB2)
      IF (IERR.NE.0) RETURN
      MTABLE=ITAB2
      SEGACT,MTABLE
      IF (MTABTV(1).NE.'MCHAML') GOTO 1
*     => APPEL A EVTEM1
      ICOUL=LCOUL.LECT(1)
      CALL ECRCHA(CH32)
      CALL ECROBJ('TABLE',ITAB1)
      CALL EVTEM1(ICOUL)
      RETURN
*
*
  1   CONTINUE
      IF (LCH32.GT.0)  CALL ECRCHA(CH32)
      IF (IRETOU.NE.0) CALL ECROBJ('TABLE',ITAB1)
*
*
*
*
*     +---------------------------------------------------------------+
*     |                                                               |
*     |           L E C T U R E   D E S   A R G U M E N T S           |
*     |                                                               |
*     +---------------------------------------------------------------+
*
*
*     ===============
*     SIGNAL D'ENTREE
*     ===============
*
      ITYP=0
      CALL LIRRES(ILCHP1,1,ITYP,CH32,NCH,1,ILREE1)
      IF (IERR.NE.0) RETURN
*
*
*     =====================
*     LISTE DES COMPOSANTES
*     =====================
*
      LCOMP=0
      CALL LIROBJ('LISTMOTS',LCOMP,0,ILCOMP)
      IF (ILCOMP.EQ.0) THEN
          CALL LIRCHA(MOCMP1,0,LCH4)
          IF (LCH4.GT.0) THEN
              JGN=LOCOMP
              JGM=1
              SEGINI,LCOMP
              LCOMP.MOTS(1)=MOCMP1
          ENDIF
      ENDIF
*      
*     
*     =========
*     GEOMETRIE
*     =========
*
*     OBJET DE TYPE POINT
      CALL LIROBJ('POINT',IPO1,0,IRET)
      IF (IRET.NE.0) THEN
         NBNN=1
         NBELEM=1
         NBSOUS=0
         NBREF=0
         SEGINI,MELEME
         ITYPEL=1
         NUM(1,1)=IPO1
         IMA1=MELEME
      ELSE
*
*        OBJET DE TYPE MAILLAGE
         CALL LIROBJ('MAILLAGE',IMA1,0,IRET)
 
*        OBJET DE TYPE INCOMPATIBLE
         IF (IRET.EQ.0) THEN
            MOTERR(1:40)='POINT   MAILLAGE'
            CALL ERREUR(471)
            RETURN
         ENDIF
*
      ENDIF
*
*
*     +---------------------------------------------------------------+
*     |                                                               |
*     |     C O N S T R U C T I O N   D E   L ' E V O L U T I O N     |
*     |                                                               |
*     +---------------------------------------------------------------+
*
*
      CH72=' '
      CALL CREVLC(ILREE1,ILCHP1,IMA1,LCOMP,LCOUL,CH72,IEVOL1)
      IF (IERR.NE.0) RETURN
*
      IF (ILCOMP.EQ.0.AND.LCOMP.GT.0) SEGSUP,LCOMP
*
      CALL ACTOBJ('EVOLUTIO',IEVOL1,1)
      CALL ECROBJ('EVOLUTIO',IEVOL1)
*
      RETURN
*
      END
*
*