Download mise.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer