Télécharger la plaquette Cast3M


fr en

Télécharger evreco.eso

Retour à la liste

Numérotation des lignes : 

evreco

  1. C EVRECO    SOURCE    BP208322  22/09/09    21:15:04     11448          
  2.       SUBROUTINE EVRECO(LCOUL)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C   OPTION RECO DE L'OPERATEUR EVOL
  7. C
  8. C.1.EVOLUTION D'UN DDL DANS L'OBJET SOLUTION:
  9. C       MEVOL = EVOL COUL RECO MSOLUT BASE TYPE  PT1 COMP (INSTANTS) ;
  10. C               ----      ----             ----      ----
  11. C
  12. C.2.EVOLUTION DE PLUSIEURS DDL DANS L'OBJET SOLUTION:
  13. C       MEVOL = EVOL COUL RECO MSOLUT BASE TYPE CHP1      (INSTANTS) ;
  14. C
  15. C.3.EVOLUTION DE PLUSIEURS DDL DANS L'OBJET TABLE
  16. C       MEVOL = EVOL COUL RECO TRESU TBASE TYPE PT1 COMP  (INSTANTS) ;
  17. C               ----      ----             ----     ----
  18. C
  19. C         COUL   : COULEUR DE LA (OU DES) COURBE(S)
  20. C         MEVOL  : OBJET DE TYPE EVOLUTION
  21. C         MSOLUT : OBJET SOLUTION
  22. C         TYPE   : MOT CLE:TYPE DE LA VARIABLE (DEPL,VITE,ACCE,CONT..)
  23. C         COMP   : NOM DE LA COMPOSANTE CHOISIE
  24. C        INSTANTS: PROCEDURE FACULTATIVE POUR CHOISIR LES CAS DE SORTIE
  25. C              PROGX :OBJET LISTREEL, LISTE DES TEMPS A SORTIR
  26. C              LECTC :OBJET LISTENTI, LISTE DES CAS A SORTIR
  27. C              RIEN  :L'OBJET EVOLUTION PORTE SUR TOUS LES CAS PRESENTS
  28. C                     DANS LE MSOLUT
  29. C
  30. C         BASE   : BASE ELEMENTAIRE
  31. C                  BASE STRU N
  32. C
  33. C         PT1    : POINT OU MELEME A EXTRAIRE
  34. C         CHP1   : CHPOINT CONTENANT LES POINTS ET DDL (FABRIQUE PAR
  35. C                  EXEMPLE PAR MANU CHPO )
  36. C
  37. C         LES OBJETS PT1,CHP1 SERVENT A REPERER DANS LES CHAMPS
  38. C         CHOISIS, LE(S) POINT(S) QUI INTERESSENT L'EVOLUTION.
  39. C
  40. C   CREATION    : 16/10/85, FARVACQUE
  41. C
  42. C=======================================================================
  43.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC SMSOLUT
  47. -INC SMTABLE
  48. -INC SMBASEM
  49. -INC SMEVOLL
  50. -INC SMELEME
  51. -INC SMLENTI
  52. -INC SMLREEL
  53. -INC SMLMOTS
  54. -INC SMCHPOI
  55.       LOGICAL L0,L1
  56.       SEGMENT NUMOO
  57.        INTEGER NUMO(N),KLIST(N)
  58.        CHARACTER*(LOCHPO) NUDDL(N)
  59.       ENDSEGMENT
  60.       CHARACTER*4 TI1,CHA4
  61.       CHARACTER*8 ITYPE,ITYP1,CTYP,TYPRET,CHARRE
  62.       CHARACTER*72 TI,MCHA,NOMCO,MTIT1
  63.       PARAMETER(NCLE=5)
  64.       CHARACTER*4  MOTIT1(1),MOCLE(NCLE)
  65.       CHARACTER*12 MOCLE2(NCLE),MODYN
  66.       DATA MOTIT1/'LEGE'/
  67.       DATA MOCLE/'DEPL','VITE','ACCE','CONT','REAC'/
  68.       DATA MOCLE2/'DEPLACEMENT','VITESSE','ACCELERATION',
  69.      &            'DEPLACEMENT','DEPLACEMENT'/
  70.       POINTEUR LCOUL.MLENTI
  71. C
  72. C  LECTURE OPTIONNELLE DU TITRE DE LA SOUS EVOLUTION DE LA COURBE (LEGE) :
  73.       MTIT1=' '
  74.       ITIT1=0
  75.       CALL LIRMOT(MOTIT1,1,ITIT1,0)
  76.       IF(ITIT1.EQ.1) THEN
  77.          CALL LIRCHA(MTIT1,1,IRETOU)
  78.          IF(IERR.NE.0) RETURN
  79.       ENDIF
  80.  
  81. C=======================================================================
  82.       ICONT=0
  83.       KPSMO=0
  84.       ISOLU=0
  85.       ITABL=0
  86. *
  87. *---- type du prochain objet a lire ( TABLE ou SOLUTION )
  88. *
  89.       CALL QUETYP (CTYP,1,IRETOU)
  90.       IF (IERR.NE.0) RETURN
  91.  
  92. c-----------------------------------------------------------------------
  93. c     SYNTAXE AVEC LISTCHPO
  94. c-----------------------------------------------------------------------
  95.       IF (CTYP.EQ.'LISTCHPO') THEN
  96. *
  97. *         LISTCHPO DES COEFFICIENTS DE PROJECTION
  98. *         =======================================
  99.           CALL LIROBJ('LISTCHPO',ILCHP1,1,IRET)
  100.           CALL ACTOBJ('LISTCHPO',ILCHP1,1)
  101.           IF (IERR.NE.0) RETURN
  102. *
  103. *         LISTE DES INSTANTS
  104. *         ==================
  105.           CALL LIROBJ('LISTREEL',ILREE1,1,IRET)
  106.           CALL ACTOBJ('LISTREEL',ILREE1,1)
  107.           IF (IERR.NE.0) RETURN
  108. *
  109. *         TABLE DE MODES
  110. *         ==============
  111.           CALL LIRTAB('BASE_MODALE',ITBAS1,1,IRET)
  112.           IF (IERR.NE.0) RETURN
  113. *
  114. *         NOMBRE DE MODES
  115. *         ===============
  116.           CALL LIRENT(NMOD1,0,IRET)
  117.           IF (IRET.EQ.0) NMOD1=0
  118. *
  119. *         LISTE DES COMPOSANTES
  120. *         =====================
  121.           ILMOT1=0
  122.           CALL LIROBJ('LISTMOTS',ILMOT1,0,IRET)
  123.           IF (IRET.EQ.0) THEN
  124.               CALL LIRCHA(CHA4,0,IRETOU)
  125.               IF (IRETOU.GT.0) THEN
  126.                   JGN=4
  127.                   JGM=1
  128.                   SEGINI,MLMOTS
  129.                   MOTS(1)=CHA4
  130.                   ILMOT1=MLMOTS
  131.               ENDIF
  132.           ENDIF
  133. *
  134. *         GEOMETRIE
  135. *         =========
  136.           CALL LIROBJ('POINT   ',IPO1,0,IRET)
  137.           IF (IRET.NE.0) THEN
  138.              NBNN=1
  139.              NBELEM=1
  140.              NBSOUS=0
  141.              NBREF=0
  142.              SEGINI,MELEME
  143.              ITYPEL=1
  144.              NUM(1,1)=IPO1
  145.              IMA1=MELEME
  146.           ELSE
  147.              CALL LIROBJ('MAILLAGE',IMA1,1,IRET)
  148.              CALL ACTOBJ('MAILLAGE',IMA1,1)
  149.           ENDIF
  150. *
  151. *         CALCUL DE LA RECOMBINAISON MODALE
  152. *         =================================
  153.           CALL RECLCH(ILCHP1,ITBAS1,NMOD1,ILCHP2)
  154.           IF (IERR.NE.0) RETURN
  155. *
  156. *         CREATION DE L'OBJET EVOLUTION
  157. *         =============================
  158.           CALL CREVLC(ILREE1,ILCHP2,IMA1,ILMOT1,LCOUL,MTIT1,IEVOL1)
  159.           IF (IERR.NE.0) RETURN
  160.           CALL ACTOBJ('EVOLUTIO',IEVOL1,1)
  161.           CALL ECROBJ('EVOLUTIO',IEVOL1)
  162. *
  163.           RETURN
  164.  
  165.       ENDIF
  166.  
  167.  
  168. c-----------------------------------------------------------------------
  169. c     SYNTAXE AVEC TABLE ou SOLUTION
  170. c-----------------------------------------------------------------------
  171.       SEGACT,LCOUL
  172.       ICOUL=LCOUL.LECT(1)
  173.       SEGDES,LCOUL
  174.  
  175. *
  176. * --- on lit le type du champ a traiter et le nom de la composante
  177. cbp  -deb-
  178. c      CALL LIRCHA(MCHA,1,IRETOU)
  179.       CALL LIRMOT(MOCLE,NCLE,ICLE,1)
  180.       IF(IERR.NE.0) RETURN
  181.       MCHA=' '
  182.       MCHA(1:4)=MOCLE(ICLE)
  183.       LCHALU=4
  184.       MODYN=MOCLE2(ICLE)
  185. cbp  -fin-
  186.       IF (MCHA.EQ.'CONT') ICONT = 1
  187.       IF (MCHA.EQ.'REAC') ICONT = 2
  188. cbp      LCHALU=IRETOU
  189.       CALL LIRCHA(NOMCO,0,IRETOU)
  190.       IF(IRETOU.EQ.0) NOMCO=' '
  191. *
  192. * --- on recupere le point ou le maillage ou le chpoint
  193.       CALL LIROBJ('POINT   ',IRET,0,IRETOU)
  194.       IF (IRETOU.EQ.0) THEN
  195.          CALL LIROBJ('MAILLAGE',IRET,0,IRETOU)
  196.          IF (IRETOU.EQ.0) THEN
  197.             CALL LIROBJ('CHPOINT ',IRET,0,IRETOU)
  198.             IF (IRETOU.EQ.0) THEN
  199. *              on ne trouve pas le support qui contient les points
  200.                CALL ERREUR(248)
  201.                RETURN
  202.             ELSE
  203.                ITYPE='CHPOINT'
  204.                CALL ACTOBJ('CHPOINT ',IRET,1)
  205.             ENDIF
  206.          ELSE
  207.             ITYPE='MAILLAGE'
  208.             CALL ACTOBJ('MAILLAGE',IRET,1)
  209.          ENDIF
  210.       ELSE
  211.         ITYPE='POINT'
  212.       ENDIF
  213.       iptu = iret
  214.  
  215. *--------------------------------------------
  216. *---cas d'un objet de type TABLE ------------
  217. *--------------------------------------------
  218.  
  219. *------ sous cas d'une table PASAPAS --------
  220.  
  221.         call lirtab('PASAPAS',ITAP,0,iretou)
  222.         if (iretou.gt.0) then
  223.           call lirobj('MMODEL  ', IPMODE,1,iretou)
  224.           call actobj('MMODEL  ', IPMODE,1)
  225.           if (ierr.ne.0) return
  226.  
  227.           CALL LIROBJ('MCHAML  ',IPIN,1,IRETOU)
  228.           CALL ACTOBJ('MCHAML  ',IPIN,1)
  229.           if (ierr.ne.0) return
  230.           CALL REDUAF(IPIN,IPMODE,IPCHA1,0,IR,KER)
  231.           IF(IR   .NE. 1) CALL ERREUR(KER)
  232.           IF(IERR .NE. 0) RETURN
  233.  
  234.           if (iretou.gt.0) call EVREC6(itap,ipmode,ipcha1,mcha,nomco,
  235.      &itype,iptu,ipevo)
  236.            if (ierr.ne.0) return
  237.           if (ipevo.gt.0) then
  238.             call actOBJ('EVOLUTION',ipevo,1)
  239.             call ECROBJ('EVOLUTION',ipevo)
  240.           endif
  241.           return
  242.         endif
  243.  
  244. *------ sous cas d'une table DYNE --------
  245.  
  246.       IF (CTYP(1:5).EQ.'TABLE') THEN
  247.         ITABL = 1
  248.         CALL LIRTAB ('RESULTAT_DYNE',ISTA,1,IRETOU)
  249.         IF (IERR.NE.0) RETURN
  250.         CALL LIRTAB ('BASE_MODALE',ISBM,0,IRETOU)
  251.         IF (IRETOU.EQ.0) THEN
  252.            CALL LIRTAB ('ENSEMBLE_DE_BASES',ISEB,1,IRETOU)
  253.            IF (IERR.NE.0) RETURN
  254.            IT = 0
  255.  56        CONTINUE
  256.            IT = IT + 1
  257.            TYPRET = ' '
  258.            CALL ACCTAB (ISEB,'ENTIER',IT,X0,' ',L0,IRET0,
  259.      &                         TYPRET,I1,X1,CHARRE,L1,ISBM)
  260.            IF (ISBM.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  261.               CALL ACCTAB (ISBM,'MOT',I0,X0,'MODES',L0,IRET0,
  262.      &                        'TABLE',I1,X1,' ',L1,ISTB)
  263.               CALL ACCTAB (ISTB,'MOT',I0,X0,'MAILLAGE',L0,IRET0,
  264.      &                        'MAILLAGE',I1,X1,' ',L1,IMAIL)
  265.               CALL EXTR12(IMAIL,IRET,IRE12)
  266. c             => avec un ENSEMBLE_DE_BASES seule la syntaxe avec 1 point
  267.               IF (IRE12.EQ.0) GOTO 56
  268.               TYPRET = ' '
  269.               CALL ACCTAB (ISBM,'MOT',I0,X0,'PSEUDO_MODES',L0,IRET0,
  270.      &                         TYPRET,I1,X1,CHARRE,L1,ITPS)
  271.               IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') KPSMO = 1
  272.            ELSE
  273.               RETURN
  274.            ENDIF
  275.         ELSE
  276.            CALL ACCTAB (ISBM,'MOT',I0,X0,'MODES',L0,IRET0,
  277.      &                     'TABLE',I1,X1,' ',L1,ISTB)
  278.            TYPRET = ' '
  279.            CALL ACCTAB (ISBM,'MOT',I0,X0,'PSEUDO_MODES',L0,IRET0,
  280.      &                      TYPRET,I1,X1,CHARRE,L1,ITPS)
  281.            IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') KPSMO = 1
  282.         ENDIF
  283.       ENDIF
  284.  
  285. *--------------------------------------------
  286. *---cas d'un objet de type SOLUTION ---------
  287. *--------------------------------------------
  288.  
  289.       IF  (CTYP(1:8).EQ.'SOLUTION') THEN
  290.         CALL LIROBJ('SOLUTION',KSOLU,1,IRETOU)
  291.         IF(IERR.NE.0) RETURN
  292.         ISOLU = 1
  293.         MSOLUT=KSOLU
  294. C       lecture de la base elementaire
  295.         CALL LIRBAS(1,IBOBAS,IBOSEM)
  296.         MSOBAS=IBOBAS
  297. C        MBASEM=IBOSEM
  298.         IF(IERR.NE.0) RETURN
  299.       ENDIF
  300.  
  301. *----------------------------------------------------------
  302. *-------  fin des cas TABLE/SOLUTION 
  303. *         et sous cas TABLE PASAPAS / TABLE DYNE  ---------
  304. *----------------------------------------------------------
  305.  
  306.  
  307. C---- lecture du chargement pour les pseudo-modes
  308.       KCHAR = 0
  309.       CALL LIROBJ('CHARGEME',KCHAR,0,IRETOU)
  310.       IF(IRETOU .EQ. 1)CALL ACTOBJ('CHARGEME',KCHAR,1)
  311.  
  312. C---- lecture des instants
  313.       IPX=0
  314.       ITOUS=0
  315.       ILX=0
  316.       CALL LIROBJ('LISTREEL',IPX,0,IRETOU)
  317.       IF(IRETOU.EQ.0) CALL LIROBJ('LISTENTI',ILX,0,IRETOU)
  318.       IF(IRETOU.EQ.0) ITOUS=1
  319.  
  320. C----------------------------------------------------
  321. c     remplissage des tableaux de NUMOO
  322. C----------------------------------------------------
  323. c     sortie : NUMOO.NUMO(i) = numero de noeud du i^eme ddl a traiter
  324. c              NUMOO.NUDDL(i)= composante du i^eme ddl a traiter
  325.       CALL EVNUMO(ITYPE,IRET,NOMCO,IBOO)
  326.       NUMOO=IBOO
  327.       IF(IERR.NE.0) RETURN
  328.  
  329.  
  330. *--------------------------------------------
  331. *---cas d'un objet de type SOLUTION ---------
  332. *--------------------------------------------
  333.       IF (ISOLU.EQ.1) THEN
  334.  
  335.          SEGACT MSOLUT
  336.          IF (MCHA.EQ.'CONT') MCHA = 'DEPL'
  337.          MOTERR(1:8)=ITYSOL
  338.          CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT)
  339.          IF(ICHA.EQ.0) THEN
  340. *           erreur dans le type du champ
  341.             MOTERR(1:8)='SOLUTION'
  342.             MOTERR(9:26)=ITYSOL
  343.             MOTERR(30:38)=MCHA
  344.             CALL ERREUR(235)
  345.             RETURN
  346.          ENDIF
  347.          MSOLEN=MSOLIS(ICHA)
  348.          IF(MSOLEN.EQ.0) THEN
  349. *           ce type de champ est vide dans le MSOLUT
  350.             MOTERR(1:8)='SOLUTION'
  351.             MOTERR(9:26)=ITYSOL
  352.             MOTERR(30:38)=MCHA
  353.             CALL ERREUR(235)
  354.             RETURN
  355.          ENDIF
  356.          IF (ITYSOL.NE.'DYNAMIQU') THEN
  357. *           option non disponible
  358.             MOTERR(1:8)='SOLUTION'
  359.             MOTERR(9:16)=ITYSOL
  360.             CALL ERREUR(131)
  361.             RETURN
  362.          ENDIF
  363.          IF (MSOLIT(ICHA).NE.2) THEN
  364. *           la sortie porte sur des CHAMELEM
  365. *           option non disponible
  366.             CALL ERREUR(19 )
  367.             RETURN
  368.          ENDIF
  369.          IBOS=MSOLUT
  370. *        verification des instants de sortie
  371. *        dans IPX le LISTREEL a mettre dans IPROGX
  372. *        dans ILEX le LISTENTI qui contient les numeros des champs
  373.          CALL VERIDY(IBOS,IPX,ICHA,ITOUS,ILEX,ITYP1)
  374.          IF(IERR.NE.0) RETURN
  375.          MSOLUT=IBOS
  376. *
  377.          IBOBAS=MSOBAS
  378.          IBOO=NUMOO
  379.          CALL EVOL2(IBOO,ILEX,IBOBAS,ICONT)
  380.          IF(IERR.NE.0) RETURN
  381.          MSOBAS=IBOBAS
  382.          NUMOO=IBOO
  383.          MLENTI=ILEX
  384.          SEGSUP MLENTI
  385. *
  386. *        prise en compte des pseudo-modes
  387. *
  388.          SEGACT MSOBAS
  389.          IMODE = IBSTRM(2)
  390.          ILIAI = IBSTRM(4)
  391.          KPSMO = IBSTRM(5)
  392.          SEGDES MSOBAS
  393.          IF (KPSMO.NE.0) THEN
  394.             IF (ILIAI.NE.0) THEN
  395.                MSOLUT = KSOLU
  396.                SEGACT MSOLUT
  397.                MOTERR(1:8) = ITYSOL
  398.                MCHA = 'LIAI'
  399.                CALL CHRCHA(MCHA,MOTERR(1:8),ICHA,ISOLIT)
  400.                IF (ICHA.EQ.0) THEN
  401.                   MOTERR(1:8)='SOLUTION'
  402.                   MOTERR(9:26)=ITYSOL
  403.                   MOTERR(30:38)=MCHA
  404.                   CALL ERREUR(235)
  405.                   RETURN
  406.                ENDIF
  407.                MSOLEN = MSOLIS(ICHA)
  408.                IF (MSOLEN.EQ.0) THEN
  409.                   MOTERR(1:8)='SOLUTION'
  410.                   MOTERR(9:26)=ITYSOL
  411.                   MOTERR(30:38)=MCHA
  412.                   CALL ERREUR(235)
  413.                   RETURN
  414.                ENDIF
  415.                SEGDES MSOLUT
  416.                ITOU2 = 0
  417.                IBOS = KSOLU
  418.                CALL VERIDY(IBOS,IPX,ICHA,ITOU2,ILEX2,ITYP1)
  419.                IF (IERR.NE.0) RETURN
  420.             ELSE
  421.                ILEX2 = 0
  422.             ENDIF
  423.             IBOO = NUMOO
  424.             CALL PSEVO1(IMODE,KPSMO,IBOO,IPX,ILEX2,KCHAR,ICONT)
  425.             NUMOO = IBOO
  426.          ENDIF
  427.  
  428.       ENDIF
  429.  
  430. *-------------------------------------------------
  431. *---cas d'un objet de type TABLE DYNE ------------
  432. *-------------------------------------------------
  433.  
  434.       IF (ITABL.EQ.1) THEN
  435.  
  436.  
  437. cbp      QUEL TYPE DE SORTIE DE LA TABLE DYNE (CHPOINT OU LISTREEEL)?
  438.  
  439. * ------ sous cas d'un LISTREEL 
  440. *        dans la table . 'DEPLACEMENT' . ptalfa --------
  441.  
  442. c        existe-t-il le LISTREEL dans la table . 'DEPLACEMENT' ?
  443.          TYPRET=' '
  444.          CALL ACCTAB (ISTA ,'MOT',I0,X0,MODYN,L0,IRET0,
  445.      &                      TYPRET,I1,X1,' ',L1,IDYN1) 
  446.  
  447.          IF(TYPRET.EQ.'TABLE'.AND.IDYN1.NE.0) THEN
  448.  
  449. *          sortie : ILEN1 = liste des deformees modales [phi_j]
  450. *                   ILEN2 = liste des points reperes
  451.            CALL CHCHA2 (ISTB,ILEN1,ILEN2,ICONT)
  452.            IF(IERR.NE.0) RETURN 
  453.  
  454. c          ILEN3 =liste des LISTREEL des alpha_j(t)
  455.            MLENT2=ILEN2
  456.            SEGACT,MLENT2
  457.            JG=MLENT2.LECT(/1)
  458.            SEGINI,MLENT3
  459.            ILEN3=MLENT3
  460.            DO I=1,JG
  461.              IPREP2=MLENT2.LECT(I)
  462.              CALL ACCTAB (IDYN1,'POINT',I0,X0,' ',L0,IPREP2,
  463.      &                          'LISTREEL',I1,X1,' ',L1,IRET1)     
  464.              MLENT3.LECT(I)=IRET1
  465.            ENDDO
  466. claisse actif            SEGDES,MLENT2,MLENT3
  467.  
  468. c          creation d'une listenti des indices a sortir pour l'evolution 
  469.            CALL VERIT3(ISTA,IPX,ITOUS,ILEX,ITYP1)
  470.  
  471. *          Travail effectif (= Recombinaison modale)
  472. *          sortie : NUMOO.KLIST(k) = pointeur vers le k^ieme listreel resultat
  473.            IBOO=NUMOO
  474.            CALL EVOL23(IBOO,ILEX,ILEN1,ILEN3)
  475.            SEGDES,MLENT2,MLENT3
  476.  
  477.            GOTO 2001
  478.  
  479.          ENDIF         
  480.  
  481. * ------ sous cas de CHPOINTS dans la table . I . 'DEPL' --------
  482.  
  483.          ICHA =0
  484. *        on prend l'indice 1 de la table (IRET1 = table du pas 1)
  485.          CALL ACCTAB (ISTA ,'ENTIER',1,X0,' ',L0,IRET0,
  486.      &                       'TABLE',I1,X1,' ',L1,IRET1)     
  487.  
  488. c        recherche de l'indice MCHA dans la table du pas 1
  489.          IF (ICONT.EQ.1) MCHA = 'DEPL'
  490.          IF (ICONT.EQ.2) MCHA = 'DEPL'
  491.          IBOBO=IRET1
  492.          CALL CHTCHA (MCHA,LCHALU,IBOBO,ICHA)
  493.          IF (ICHA.EQ.0) THEN
  494. *           erreur dans le type du champ :
  495. cbp            MOTERR(1:8)= MCHA(1:8)
  496.             MOTERR(1:8)='TABLE   '
  497.             MOTERR(9:26)='RESULTAT_DYNE   '
  498.             MOTERR(30:38)=MCHA
  499.             CALL ERREUR(235)
  500. c Dans l'objet solution de type DEPL on ne trouve pas la liste des DEPL
  501.             RETURN
  502.          ENDIF
  503.  
  504. *        verification des instants de sortie
  505. *        entree : IPX = LISTREEL des instants (a mettre dans IPROGX)
  506. *                 ITOUS = 1 si IPX non fourni (on recherche alors tous 
  507. *                         les instants), =0 sinon
  508. *        sortie : ILEX = LISTENTI des pointeurs vers les champs 
  509. *                        aux temps souhaites { alpha(t_1) ... }
  510.          CALL VERITA(ISTA,IPX,ICHA,ITOUS,ILEX,ITYP1)
  511.          IF (IERR.NE.0) RETURN
  512. *         
  513. *        sortie : ILEN1 = liste des deformees modales [phi_j]
  514. *                 ILEN2 = liste des points reperes
  515.          CALL CHCHA2 (ISTB,ILEN1,ILEN2,ICONT)
  516.          IF(IERR.NE.0) RETURN
  517. *         
  518. *        Travail effectif (= Recombinaison modale)
  519. *        sortie : NUMOO.KLIST(k) = pointeur vers le k^ieme listreel resultat
  520.          IBOO=NUMOO
  521.          CALL EVOL22 (IBOO,ILEX,ILEN1,ILEN2)
  522.          IF(IERR.NE.0) RETURN
  523.          NUMOO=IBOO
  524.  
  525.  
  526. * ------ partie commune aux 2 sous cas --------
  527.  2001    CONTINUE
  528. *
  529. *       prise en compte de la rotation des corps rigides
  530. *
  531.          IF (MCHA(1:4).EQ.'DEPL') THEN
  532. *  On regarde si on a une base de corps rigide
  533.              CALL VERRIG(ISTB,IROT,ICDG,ILEN1,ILEN2,IDEFO)
  534.              IF (IROT.NE.0) THEN
  535.                 IBOO = NUMOO
  536. *  Recombinaison des deplacements
  537.                 CALL EVORIG(IROT,ICDG,IBOO,ILEX,0,0,0,IDEFO)
  538.                 NUMOO = IBOO
  539.              ENDIF
  540.          ELSE
  541.              IF (MCHA(1:4).EQ.'VITE') THEN
  542. *  On regarde si on a une base de corps rigide
  543.                CALL VERRIG(ISTB,IROT,ICDG,ILEN1,ILEN2,IDEFO)
  544.                IF (IROT.NE.0) THEN
  545. *  On recupere les angles de rotation
  546.                  CALL CHTCHA('DEPL',4,IBOBO,ICHARO)
  547.                  IF (ICHARO.EQ.0) THEN
  548. c                    MOTERR(1:8)=MCHA(1:8)
  549. c                    MOTERR(9:12)=MCHA
  550.                    MOTERR(1:8)='TABLE   '
  551.                    MOTERR(9:26)='RESULTAT_DYNE   '
  552.                    MOTERR(30:38)=MCHA
  553.                    CALL ERREUR(235)
  554.                    RETURN
  555.                  ENDIF
  556.                  CALL VERITA(ISTA,IPX,ICHARO,ITOUS,ILEXRO,ITYP1)
  557.                  IBOO = NUMOO
  558. *  On recombine les vitesses
  559.                  CALL EVORIG(IROT,ICDG,IBOO,ILEX,1,ILEXRO,0,IDEFO)
  560.                  NUMOO = IBOO
  561.                ENDIF
  562.              ELSE
  563.                IF (MCHA(1:4).EQ.'ACCE') THEN
  564. *  On regarde si on a une base de corps rigide
  565.                  CALL VERRIG(ISTB,IROT,ICDG,ILEN1,ILEN2,IDEFO)
  566.                  IF (IROT.NE.0) THEN
  567. *  On recupere les angles de rotation
  568.                    CALL CHTCHA('DEPL',4,IBOBO,ICHARO)
  569.                    IF (ICHARO.EQ.0) THEN
  570. c                      MOTERR(1:8)=MCHA(1:8)
  571. c                      MOTERR(9:12)=MCHA
  572.                      MOTERR(1:8)='TABLE   '
  573.                      MOTERR(9:26)='RESULTAT_DYNE   '
  574.                      MOTERR(30:38)=MCHA
  575.                      CALL ERREUR(235)
  576.                      RETURN
  577.                    ENDIF
  578.                    CALL VERITA(ISTA,IPX,ICHARO,ITOUS,ILEXRO,ITYP1)
  579. *  On recupere les vitesses de rotation
  580.                    CALL CHTCHA('VITE',4,IBOBO,ICHAVI)
  581.                    IF (ICHAVI.EQ.0) THEN
  582. c                      MOTERR(1:8)=MCHA(1:8)
  583. c                      MOTERR(9:12)=MCHA
  584.                      MOTERR(1:8)='TABLE   '
  585.                      MOTERR(9:26)='RESULTAT_DYNE   '
  586.                      MOTERR(30:38)=MCHA
  587.                      CALL ERREUR(235)
  588.                      RETURN
  589.                    ENDIF
  590.                    CALL VERITA(ISTA,IPX,ICHAVI,ITOUS,ILEXVI,ITYP1)
  591.                    IBOO = NUMOO
  592. *  On recombine les accelerations
  593.                    CALL EVORIG(IROT,ICDG,IBOO,ILEX,-1,ILEXRO,
  594.      &ILEXVI,IDEFO)
  595.                    NUMOO = IBOO
  596.                  ENDIF
  597.                ENDIF
  598.              ENDIF
  599.          ENDIF
  600.          MLENTI=ILEN1
  601.          SEGSUP MLENTI
  602.          MLENTI=ILEN2
  603.          SEGSUP MLENTI
  604.          MLENTI=ILEX
  605.          SEGSUP MLENTI
  606. *
  607. *        prise en compte des pseudo-modes
  608. *
  609.          IF (KPSMO.EQ.1) THEN
  610.             IF (KCHAR.NE.0) THEN
  611.                IBOO = NUMOO
  612.                CALL PSEVRC(ICONT,ITPS,ISTB,IBOO,IPX,KCHAR)
  613.                NUMOO = IBOO
  614.             ELSE
  615.                CALL ERREUR(430)
  616.             ENDIF
  617.          ENDIF
  618.       ENDIF
  619.  
  620. *--------------------------------------------
  621. *   initialisation du MEVOLL resultat
  622. *--------------------------------------------
  623. * 
  624.       IF (ICONT.EQ.1) MCHA='CONT'
  625.       IF (ICONT.EQ.2) MCHA='REAC'
  626.       N=NUMO(/1)
  627.       SEGINI MEVOLL
  628.       ITYEVO='REEL'
  629.       TI(1:72)=TITREE
  630.       IEVTEX=TI
  631.       DO 2080 I=1,N
  632.          SEGINI KEVOLL
  633.          TYPX='LISTREEL'
  634.          TYPY='LISTREEL'
  635.          IPROGX=IPX
  636.          IPROGY=KLIST(I)
  637.          NOMEVX=ITYP1
  638.          NOMEVY(1:4)=MCHA
  639.          WRITE (NOMEVY(5:8),FMT='(I4)') NUMO(I)
  640.          NOMEVY(9:12)=NUDDL(I)
  641. c          KEVTEX=TI
  642.          IF(ITIT1.EQ.0) MTIT1(1:12)=NOMEVY(1:12)
  643.          KEVTEX=MTIT1
  644.          NUMEVY='REEL'
  645.          NUMEVX=ICOUL
  646.          SEGDES KEVOLL
  647.          IEVOLL(I)=KEVOLL
  648.  2080 CONTINUE
  649.       SEGDES MEVOLL
  650.       SEGSUP NUMOO
  651.       CALL ACTOBJ('EVOLUTIO',MEVOLL,1)
  652.       CALL ECROBJ('EVOLUTIO',MEVOLL)
  653. *
  654.       END
  655.  
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales