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

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