Télécharger mise.eso

Retour à la liste

Numérotation des lignes :

  1. C MISE SOURCE AF221230 13/08/01 21:15:04 7808
  2. C MISE SOURCE
  3. SUBROUTINE MISE
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C=======================================================================
  7. C OPERATEUR MISE :
  8. C ECRITURE DES FICHIERS DE DONNEES POUR LE CALCUL MISS
  9. C
  10. C SYNTAXE :
  11. C * MISE TAB1 ;
  12. C
  13. C TAB1 TABLE FABRIQUEE PAR LA PROCEDURE PREPMISS
  14. C
  15. C=======================================================================
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. C
  20. external long
  21. CHARACTER*72 lemot
  22. CHARACTER*20 NOMETU
  23. CHARACTER*80 REPER
  24. CHARACTER*105 FICMISS
  25. CHARACTER*8 TYPRET
  26. LOGICAL LOGI,CALDYN
  27. CHARACTER*6 RIFOND
  28. PARAMETER(NMAIL=51,NCHP=52,NIMP=53,NMIS=54)
  29. C
  30. C lecture table
  31. CALL LIROBJ('TABLE ',MTAB1,1,IRETOU)
  32. IF (IERR.NE.0) RETURN
  33. C
  34. C On regarde deja si calcul dynamique ou impedances seulement
  35. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'TYPE_CALCUL',.TRUE.,0,
  36. & 'MOT',IP,RR,lemot,LOGI,IO)
  37. CALDYN=.FALSE.
  38. IF(lemot(1:9).EQ.'DYNAMIQUE')CALDYN=.TRUE.
  39. C
  40. C lecture nom etude et ouverture des fichiers
  41. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NOM_ETUDE',.TRUE.,0,
  42. & 'MOT',IP,RR,NOMETU,LOGI,IO)
  43. LE=long(NOMETU)
  44. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'REPERTOIRE_MISS',.TRUE.,0,
  45. & 'MOT',IP,RR,REPER,LOGI,IO)
  46. LR=long(REPER)
  47. FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.mail'
  48. OPEN(UNIT=NMAIL,FILE=FICMISS,ACCESS='SEQUENTIAL',
  49. & FORM='FORMATTED',STATUS='UNKNOWN')
  50. FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.chp'
  51. OPEN(UNIT=NCHP,FILE=FICMISS,ACCESS='SEQUENTIAL',
  52. & FORM='FORMATTED',STATUS='UNKNOWN')
  53. FICMISS=REPER(1:LR)//'/'//'MISS.IN'
  54. OPEN(UNIT=NMIS,FILE=FICMISS,ACCESS='SEQUENTIAL',
  55. & FORM='FORMATTED',STATUS='UNKNOWN')
  56. IF (CALDYN)THEN
  57. FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.imp'
  58. OPEN(UNIT=NIMP,FILE=FICMISS,ACCESS='SEQUENTIAL',
  59. & FORM='FORMATTED',STATUS='UNKNOWN')
  60. C
  61. C Impression matrices reduites
  62. TYPRET=' '
  63. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NB_MODPROP',.TRUE.,0,
  64. & TYPRET,NMOD,RR,lemot,LOGI,IZ)
  65. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NB_MODSTAT',.TRUE.,0,
  66. & TYPRET,NSTA,RR,lemot,LOGI,IZ)
  67. WRITE(NIMP,202)NMOD+NSTA
  68. 202 FORMAT('MSMF ',I4,' 0 AMOR')
  69. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'MASSE_REDUITE',.TRUE.,0,
  70. & 'RIGIDITE',IP,RR,lemot,LOGI,IMAS)
  71. CALL PRRIMI(IMAS,NIMP)
  72. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'RIGIDITE_REDUITE',.TRUE.,0,
  73. & 'RIGIDITE',IP,RR,lemot,LOGI,IRIG)
  74. CALL PRRIMI(IRIG,NIMP)
  75. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'AMOR_REDUITE',.TRUE.,0,
  76. & 'RIGIDITE',IP,RR,lemot,LOGI,IAMO)
  77. CALL PRRIMI(IAMO,NIMP)
  78. WRITE(NIMP,203)
  79. 203 FORMAT('EOF')
  80. ENDIF
  81. C
  82. C Impression liaisons statiques et maillage interface
  83. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'MAILLAGE_INTERFACE',.TRUE.,0,
  84. & 'MAILLAGE',IP,RR,lemot,LOGI,IMAI)
  85. TYPRET=' '
  86. IF(CALDYN)THEN
  87. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,0,
  88. & 'TABLE',IP,RR,lemot,LOGI,MTAB2)
  89. ELSE
  90. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'CDG_FONDATION',.TRUE.,0,
  91. & 'POINT',IP,RR,lemot,LOGI,IG)
  92. ENDIF
  93. IF(CALDYN)THEN
  94. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'CHAMPS_INTERFACE',.TRUE.,0,
  95. & 'TABLE',IP,RR,lemot,LOGI,MTAB3)
  96. ENDIF
  97. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NB_NOEUDS',.TRUE.,0,
  98. & 'ENTIER',NNO,RR,lemot,LOGI,IZ)
  99. C
  100. C fondation souple ou rigide
  101. CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'RIGI_FONDATION',.TRUE.,0,
  102. & 'MOT',IP,RR,RIFOND,LOGI,IZ)
  103. IRIG=0
  104. IF(RIFOND.EQ.'SOUPLE')IRIG=1
  105. CALL PRLIMI(CALDYN,IG,MTAB3,NCHP,IRIG,NMOD,IMAI,NNO,NMAIL)
  106. C
  107. C Impression du fichier de donnees MISS.IN
  108. CALL PRDOMI(CALDYN,NMIS,NOMETU,LE,MTAB1)
  109. C
  110. CLOSE(NIMP)
  111. CLOSE(NCHP)
  112. CLOSE(NMAIL)
  113. CLOSE(NMIS)
  114. C
  115. END
  116.  
  117.  

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