Télécharger chcha2.eso

Retour à la liste

Numérotation des lignes :

  1. C CHCHA2 SOURCE BP208322 17/07/10 21:15:00 9488
  2. SUBROUTINE CHCHA2 (IBAS,ILEN1,ILEN2,ICONT)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C====================================================================
  6. C SUBROUTINE POUR CHERCHER DANS UNE TABLE DE SOUSTYPE
  7. C "BASE_DE_MODES" LES DEFORMEES MODALES ET LES POINTS REPERES ASSOCIE
  8. C UTILISE PR EVRECO
  9. C IBAS (E) POINTEUR SUR LA TABLE DONT ON PART
  10. C ILEN1 (S) POINTEUR SUR LA LISTE DES DEFORMEE-MODALES
  11. C ILEN2 (S) POINTEUR SUR LA LISTE DES POINTS REPERE
  12. C======================================================================
  13. LOGICAL L0,L1
  14. CHARACTER*8 TYPRET
  15. -INC CCOPTIO
  16. -INC SMTABLE
  17. -INC SMLENTI
  18. *
  19. ILEN1 = 0
  20. ILEN2 = 0
  21. *
  22. MTABLE = IBAS
  23. SEGACT MTABLE
  24. * NINDIC = nombre de tables de modes.
  25. * Le premier indice est le SOUSTYPE
  26. * Le deuxi}me indice est le MAILLAGE
  27. NINDIC = MLOTAB-2
  28. SEGDES MTABLE
  29. JG = NINDIC
  30. SEGINI MLENT1
  31. ILEN1 = MLENT1
  32. SEGINI MLENT2
  33. ILEN2 = MLENT2
  34. *
  35. * on boucle sur les modes
  36. *
  37. JG=0
  38. DO 100 IN = 1 , NINDIC
  39. TYPRET=' '
  40. CALL ACCTAB(IBAS,'ENTIER',IN,X0,' ',L0,IP0,
  41. & TYPRET,I1,X1,' ',L1,ITMOD)
  42. IF(TYPRET.ne.'TABLE') GOTO 100
  43. JG=JG+1
  44. IF (ICONT.EQ.0) THEN
  45. CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0,
  46. & 'CHPOINT',I1,X1,' ',L1,ICDEP)
  47. ELSE IF (ICONT.EQ.2) THEN
  48. CALL ACCTAB(ITMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0,
  49. & 'CHPOINT',I1,X1,' ',L1,ICDEP)
  50. ELSE
  51. CALL ACCTAB(ITMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
  52. & 'MCHAML',I1,X1,' ',L1,ICHAM)
  53. IF (IERR.NE.0) RETURN
  54. CALL CHAMPO(ICHAM,1,ICDEP,IRET)
  55. IF ( IRET .NE. 1) RETURN
  56. ENDIF
  57. MLENT1.LECT(IN) = ICDEP
  58. CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
  59. & 'POINT',I1,X1,' ',L1,IPTR)
  60. MLENT2.LECT(IN) = IPTR
  61. 100 CONTINUE
  62. SEGADJ,MLENT1,MLENT2
  63. SEGDES MLENT1
  64. SEGDES MLENT2
  65. *
  66. END
  67.  
  68.  
  69.  

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