C MISE SOURCE AF221230 13/08/01 21:15:04 7808 C MISE SOURCE SUBROUTINE MISE IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C======================================================================= C OPERATEUR MISE : C ECRITURE DES FICHIERS DE DONNEES POUR LE CALCUL MISS C C SYNTAXE : C * MISE TAB1 ; C C TAB1 TABLE FABRIQUEE PAR LA PROCEDURE PREPMISS C C======================================================================= -INC CCOPTIO C external long CHARACTER*72 lemot CHARACTER*20 NOMETU CHARACTER*80 REPER CHARACTER*105 FICMISS CHARACTER*8 TYPRET LOGICAL LOGI,CALDYN CHARACTER*6 RIFOND PARAMETER(NMAIL=51,NCHP=52,NIMP=53,NMIS=54) C C lecture table CALL LIROBJ('TABLE ',MTAB1,1,IRETOU) IF (IERR.NE.0) RETURN C C On regarde deja si calcul dynamique ou impedances seulement CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'TYPE_CALCUL',.TRUE.,0, & 'MOT',IP,RR,lemot,LOGI,IO) CALDYN=.FALSE. IF(lemot(1:9).EQ.'DYNAMIQUE')CALDYN=.TRUE. C C lecture nom etude et ouverture des fichiers CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NOM_ETUDE',.TRUE.,0, & 'MOT',IP,RR,NOMETU,LOGI,IO) LE=long(NOMETU) CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'REPERTOIRE_MISS',.TRUE.,0, & 'MOT',IP,RR,REPER,LOGI,IO) LR=long(REPER) FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.mail' OPEN(UNIT=NMAIL,FILE=FICMISS,ACCESS='SEQUENTIAL', & FORM='FORMATTED',STATUS='UNKNOWN') FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.chp' OPEN(UNIT=NCHP,FILE=FICMISS,ACCESS='SEQUENTIAL', & FORM='FORMATTED',STATUS='UNKNOWN') FICMISS=REPER(1:LR)//'/'//'MISS.IN' OPEN(UNIT=NMIS,FILE=FICMISS,ACCESS='SEQUENTIAL', & FORM='FORMATTED',STATUS='UNKNOWN') IF (CALDYN)THEN FICMISS=REPER(1:LR)//'/'//NOMETU(1:LE)//'.imp' OPEN(UNIT=NIMP,FILE=FICMISS,ACCESS='SEQUENTIAL', & FORM='FORMATTED',STATUS='UNKNOWN') C C Impression matrices reduites TYPRET=' ' CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NB_MODPROP',.TRUE.,0, & TYPRET,NMOD,RR,lemot,LOGI,IZ) CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NB_MODSTAT',.TRUE.,0, & TYPRET,NSTA,RR,lemot,LOGI,IZ) WRITE(NIMP,202)NMOD+NSTA 202 FORMAT('MSMF ',I4,' 0 AMOR') CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'MASSE_REDUITE',.TRUE.,0, & 'RIGIDITE',IP,RR,lemot,LOGI,IMAS) CALL PRRIMI(IMAS,NIMP) CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'RIGIDITE_REDUITE',.TRUE.,0, & 'RIGIDITE',IP,RR,lemot,LOGI,IRIG) CALL PRRIMI(IRIG,NIMP) CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'AMOR_REDUITE',.TRUE.,0, & 'RIGIDITE',IP,RR,lemot,LOGI,IAMO) CALL PRRIMI(IAMO,NIMP) WRITE(NIMP,203) 203 FORMAT('EOF') ENDIF C C Impression liaisons statiques et maillage interface CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'MAILLAGE_INTERFACE',.TRUE.,0, & 'MAILLAGE',IP,RR,lemot,LOGI,IMAI) TYPRET=' ' IF(CALDYN)THEN CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'LIAISONS_STATIQUES',.TRUE.,0, & 'TABLE',IP,RR,lemot,LOGI,MTAB2) ELSE CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'CDG_FONDATION',.TRUE.,0, & 'POINT',IP,RR,lemot,LOGI,IG) ENDIF IF(CALDYN)THEN CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'CHAMPS_INTERFACE',.TRUE.,0, & 'TABLE',IP,RR,lemot,LOGI,MTAB3) ENDIF CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'NB_NOEUDS',.TRUE.,0, & 'ENTIER',NNO,RR,lemot,LOGI,IZ) C C fondation souple ou rigide CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'RIGI_FONDATION',.TRUE.,0, & 'MOT',IP,RR,RIFOND,LOGI,IZ) IRIG=0 IF(RIFOND.EQ.'SOUPLE')IRIG=1 CALL PRLIMI(CALDYN,IG,MTAB3,NCHP,IRIG,NMOD,IMAI,NNO,NMAIL) C C Impression du fichier de donnees MISS.IN CALL PRDOMI(CALDYN,NMIS,NOMETU,LE,MTAB1) C CLOSE(NIMP) CLOSE(NCHP) CLOSE(NMAIL) CLOSE(NMIS) C END