Télécharger la plaquette Cast3M


fr en

Télécharger mise.eso

Retour à la liste

Numérotation des lignes : 

mise

  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