Télécharger la plaquette Cast3M


fr en

Télécharger rccon2.eso

Retour à la liste

Numérotation des lignes : 

rccon2

  1. C RCCON2    SOURCE    CB215821  20/11/25    13:38:32     10792          
  2.       SUBROUTINE RCCON2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS,
  3.      &                  ITLIA)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Recombine le chpoint ICHPT en contrainte.                      *
  9. *                                                                    *
  10. *     Param}tres:                                                    *
  11. *                                                                    *
  12. * e   IBAS    table repr{sentant une base modale                     *
  13. * e   KCHAR   chargement de la structure                             *
  14. * e   XTEMP   temps de recombinaison                                 *
  15. * e   ITRES   table r{sultat issue de l'op{rateur DYNE               *
  16. * e   IPOS    position de XTEMP dans le listreel des temps           *
  17. * e   ITLIA   table des liaisons                                     *
  18. *                                                                    *
  19. *     Auteur, date de cr{ation:                                      *
  20. *                                                                    *
  21. *     Lionel VIVAN, le 26 avril 1990.                                *
  22. *                                                                    *
  23. *  REMARQUE :NORMALEMENT CHACUN DES MCHAML DE CONTRAINTE MODALE      *
  24. *            SONT SIMILAIRES.LES VERIFICATIONS DE CONFORMITE DE      *
  25. *            CHACUN DES MCHAMLs SERA DONC REDUIT AU MINIMUM.         *
  26. *            A SAVOIR LES SOUS ZONE PORTE BIEN LE MEME POINTEUR DE   *
  27. *            MAILLAGE ET LES NOMS DES COMPOSANTES QUE L ON MULTIPLIE *
  28. *            SONT IDENTIQUES.                                        *
  29. *                                                                    *
  30. *     Passage aux nouveaux chamelem par jm CAMPENON le 01/91         *
  31. *                                                                    *
  32. *--------------------------------------------------------------------*
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMCOORD
  36. -INC SMCHAML
  37.       SEGMENT ICPR(nbpts)
  38.       SEGMENT ITRA1(NSOUS,4)
  39.       SEGMENT TRAV(NPOIN)*D
  40.       LOGICAL L0,L1
  41.       CHARACTER*8 TYPRET,CHARRE
  42. *
  43.       TRAV = KTRAV
  44.       ICPR = KCPR
  45. *
  46.       CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0,
  47.      &               'TABLE',I1,X1,' ',L1,IBBB)
  48. *
  49. *     initialisation du MCHAML
  50. *
  51.       N1 = 1
  52.       CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0,
  53.      &                  'TABLE',I1,X1,' ',L1,ITBMOD)
  54.       TYPRET = ' '
  55.       CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  56.      &                  TYPRET,I1,X1,CHARRE,L1,IPHC1)
  57.       IF (IPHC1.NE.0) THEN
  58.          IF (TYPRET.EQ.'MCHAML  ') GOTO 100
  59.       ENDIF
  60. *
  61.       MOTERR(1:8) = 'RCCON2  '
  62.       INTERR(1) = N1
  63.       CALL ERREUR(169)
  64.       RETURN
  65. *
  66.  100  CONTINUE
  67.       MCHEL1 = IPHC1
  68.       SEGINI,MCHELM=MCHEL1
  69.       ICHCO = MCHELM
  70.       NSOUS= ICHAML(/1)
  71.       SEGINI ITRA1
  72.       DO 60 ISOUS=1,NSOUS
  73.          ITRA1(ISOUS,1)=IMACHE(ISOUS)
  74.          MCHAM1=ICHAML(ISOUS)
  75.          SEGINI,MCHAML=MCHAM1
  76.          ICHAML(ISOUS)=MCHAML
  77.          ITRA1(ISOUS,2)=MCHAML
  78.  60   CONTINUE
  79. *
  80. *     boucle sur le nombre de modes
  81. *
  82.       IM = 0
  83.  40   CONTINUE
  84.       IM = IM + 1
  85.       TYPRET = ' '
  86.       CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  87.      &                   TYPRET,I1,X1,CHARRE,L1,ITBMOD)
  88.       IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  89.          TYPRET = ' '
  90.          CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  91.      &                 TYPRET,I1,X1,CHARRE,L1,IPHC1)
  92. C*       IF (TYPRET.NE.'MCHAML  ') THEN
  93. C*         ERREUR ?
  94. C*       ENDIF
  95.          MCHEL1=IPHC1
  96.          SEGACT MCHEL1
  97.          DO 42 ISOUS=1,NSOUS
  98.             IPMAIL=ITRA1(ISOUS,1)
  99.             IF ( IPMAIL.NE.MCHEL1.IMACHE(ISOUS) ) THEN
  100.                SEGDES MCHEL1
  101.                CALL ERREUR(21)
  102.                GOTO 9990
  103.             ENDIF
  104.             MCHAM1=MCHEL1.ICHAML(ISOUS)
  105.             SEGACT MCHAM1
  106.             MCHAML=ITRA1(ISOUS,2)
  107.             NCOMP=IELVAL(/1)
  108.             NCCHE=MCHAM1.NOMCHE(/2)
  109.             DO 30 ICOMP=1,NCOMP
  110.                CALL PLACE(MCHAM1.NOMCHE,NCCHE,IPLAC,
  111.      &                      NOMCHE(ICOMP))
  112.                IF (IPLAC.EQ.0) THEN
  113.                   SEGDES MCHAM1
  114.                   SEGDES MCHEL1
  115.                   CALL ERREUR(21)
  116.                   GOTO 9990
  117.                ENDIF
  118.                MELVA1=MCHAM1.IELVAL(IPLAC)
  119.                SEGACT MELVA1
  120.                N1PTEL = MELVA1.VELCHE(/1)
  121.                N1EL   = MELVA1.VELCHE(/2)
  122.                ITRA1(ISOUS,3) = MAX(ITRA1(ISOUS,3),N1PTEL)
  123.                ITRA1(ISOUS,4) = MAX(ITRA1(ISOUS,4),N1EL  )
  124.                SEGDES MELVA1
  125.  30         CONTINUE
  126.             SEGDES MCHAM1
  127.  42      CONTINUE
  128.          SEGDES MCHEL1
  129.          GOTO 40
  130.       ENDIF
  131.       NBMODE = IM - 1
  132. *
  133.       DO 50 ISOUS=1,NSOUS
  134.          MCHAML=ITRA1(ISOUS,2)
  135.          N1PTEL = ITRA1(ISOUS,3)
  136.          N1EL   = ITRA1(ISOUS,4)
  137.          N2PTEL = 0
  138.          N2EL   = 0
  139.          NCOMP=IELVAL(/1)
  140.          DO 51 ICOMP=1,NCOMP
  141.             SEGINI MELVAL
  142.             IELVAL(ICOMP) = MELVAL
  143.  51      CONTINUE
  144.  50   CONTINUE
  145. *
  146. *     boucle sur les contraintes modales
  147. *
  148.       DO 300 IM = 1,NBMODE
  149.          CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
  150.      &                     'TABLE',I1,X1,' ',L1,ITBMOD)
  151.          CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  152.      &                    'POINT',I1,X1,' ',L1,IPTR)
  153.          TYPRET = ' '
  154.          CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  155.      &                 TYPRET,I1,X1,CHARRE,L1,IPHC1)
  156. C*       IF (TYPRET.NE.'MCHAML  ') THEN
  157. C*         ERREUR ?
  158. C*       ENDIF
  159.          IMODE = ICPR(IPTR)
  160.          IF (IMODE.EQ.0) THEN
  161. *
  162. *           on ne trouve pas la contrainte modale
  163. *
  164.             MOTERR(1:8) = 'RCCON2'
  165.             INTERR(1) = IM
  166.             CALL ERREUR(169)
  167.             CALL DTCHAM(ICHCO)
  168.             GOTO 9990
  169.          ENDIF
  170.          XVAL = TRAV(IMODE)
  171.          MCHEL1 = IPHC1
  172.          SEGACT MCHEL1
  173.          NSOU1 = MCHEL1.ICHAML(/1)
  174.          DO 320 ISOU1 = 1,NSOU1
  175.             MCHAML=ITRA1(ISOU1,2)
  176.             MCHAM1=MCHEL1.ICHAML(ISOU1)
  177.             SEGACT MCHAM1
  178.             NCOMP=IELVAL(/1)
  179.             NCCHE=MCHAM1.NOMCHE(/2)
  180.             DO 342 ICOMP=1,NCOMP
  181.                CALL PLACE(MCHAM1.NOMCHE,NCCHE,IPLAC,
  182.      &                      NOMCHE(ICOMP))
  183.                MELVA1=MCHAM1.IELVAL(IPLAC)
  184.                SEGACT MELVA1
  185.                MELVAL=IELVAL(ICOMP)
  186.                DO 344 IGAU=1,VELCHE(/1)
  187.                   IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
  188.                   DO 344 IB=1,VELCHE(/2)
  189.                      IBMN=MIN(IB  ,MELVA1.VELCHE(/2))
  190.                      VELCHE(IGAU,IB)=VELCHE(IGAU,IB)
  191.      &                               +XVAL*MELVA1.VELCHE(IGMN,IBMN)
  192.  344           CONTINUE
  193.                SEGDES MELVA1
  194.  342        CONTINUE
  195.             SEGDES MCHAM1
  196.  320     CONTINUE
  197.          SEGDES MCHEL1
  198.  300  CONTINUE
  199.       DO 61 ISOUS=1,NSOUS
  200.          MCHAML=ITRA1(ISOUS,2)
  201.          NCOMP=IELVAL(/1)
  202.          DO 62 ICOMP=1,NCOMP
  203.             MELVAL=IELVAL(ICOMP)
  204.             SEGDES MELVAL
  205.  62      CONTINUE
  206.          SEGDES MCHAML
  207.  61   CONTINUE
  208.       SEGDES MCHELM
  209. *
  210. *     Prise en compte des pseudo-modes
  211. *
  212.       IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN
  213.         TYPRET = ' '
  214.         CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
  215.      &                  TYPRET,I1,X1,CHARRE,L1,ITPS)
  216.        IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  217.        CALL PSRCD2('CONT',ITPS,IBBB,ICHCO,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
  218.        ELSE
  219.           CALL ERREUR(429)
  220.        ENDIF
  221.       ENDIF
  222.       RETURN
  223. *
  224.  9990 CONTINUE
  225.       DO 71 ISOUS=1,NSOUS
  226.          MCHAML=ITRA1(ISOUS,2)
  227.          SEGSUP MCHAML
  228.  71   CONTINUE
  229.       SEGSUP ITRA1
  230. C*    SEGSUP MCHELM
  231.  
  232.       RETURN
  233.       END
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  

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