Esope source files

   1 : C KDOM0     SOURCE    CHAT      11/03/16    21:26:06     6902           
   2 :       SUBROUTINE KDOM0
   3 : C
   4 : C************************************************************************
   5 : C
   6 : C PROJET            :  CASTEM 2000
   7 : C
   8 : C NOM               :  KDOM0
   9 : C
  10 : C DESCRIPTION       :  Modele EULER
  11 : C                      Creation/Lecture et restitution de la table 
  12 : C                      domaine
  13 : C     
  14 : C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15 : C      
  16 : C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF                        
  17 : C
  18 : C************************************************************************
  19 : C
  20 : C
  21 : C**** Variables de COOPTIO
  22 : C
  23 :       IMPLICIT INTEGER(I-N)
  24 :       INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  25 :      &     ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  26 :      &     ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  27 :      &     ,IECHO,   IIMPI,  IOSPI
  28 :      &     ,IDIM,    IFICLE, IPREFI     
  29 :      &     ,MCOORD
  30 :      &     ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  31 :      &     ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  32 :      &     ,NORINC,NORVAL,NORIND,NORVAD
  33 :      &     ,NUCROU, IPSAUV, IREFOR, ISAFOR
  34 : C
  35 :       INTEGER IRET, N1, I1, MTAB
  36 :       CHARACTER*8 TYPE
  37 : C
  38 : -INC SMMODEL
  39 : -INC CCOPTIO
  40 : -INC SMELEME
  41 : C
  42 : C**** We create the TABLE DOMAINE or we
  43 : C     recover it if it already exists
  44 : C
  45 :       TYPE='MMODEL'
  45 :       CALL LIROBJ(TYPE,MMODEL,1,IRET)
  46 :       IF(IERR.NE.0) RETURN
  47 : C
  48 :       SEGACT MMODEL
  49 :       N1=MMODEL.KMODEL(/1)
  50 :       DO I1=1,N1,1
  51 :          IMODEL=MMODEL.KMODEL(I1)
  52 :          SEGACT IMODEL*MOD
  53 : C
  54 : C********** For the moment no coupling
  55 : C
  56 :          IF(IMODEL.FORMOD(1).NE.'EULER')THEN
  57 :             WRITE(IOIMP,*) 'No coupling in VF'
  57 :             CALL ERREUR(21)
  58 :             RETURN
  59 :          ENDIF
  60 :       ENDDO
  61 : C     
  62 : C**** If existing the domain table is hidden into
  63 : C     MMODEL.KMODEL(1).INFMOD(2)
  64 : C
  65 :       IMODEL=MMODEL.KMODEL(N1)
  66 :       MTAB=IMODEL.INFMOD(2)
  67 : C
  68 :       IF(MTAB.EQ.0)THEN
  69 : C
  70 : C****** We recreate the global mesh
  71 : C
  72 :          IMODEL=MMODEL.KMODEL(1)
  73 :          MELEME=IMODEL.IMAMOD
  74 :          SEGACT MELEME
  75 :          DO I1=2,N1,1
  76 :             IMODEL=MMODEL.KMODEL(I1)
  77 :             IPT1=IMODEL.IMAMOD
  78 :             SEGACT IPT1
  78 :             CALL ECROBJ('MAILLAGE',MELEME)
  78 :             CALL ECROBJ('MAILLAGE',IPT1)
  78 :             CALL PRFUSE
  78 :             CALL LIROBJ('MAILLAGE',IPT2,1,IRET)
  79 :             SEGDES MELEME
  80 :             SEGDES IPT1
  81 :             MELEME=IPT2
  82 :          ENDDO
  83 : C
  84 : C******* Table domaine does not exist
  85 : C        We create it
  86 : C
  86 :          CALL KDOM1(MELEME,MTAB)
  87 :          IF(IERR .NE. 0) RETURN
  88 : C
  89 :          IMODEL=MMODEL.KMODEL(N1)
  90 :          IMODEL.INFMOD(2)=MTAB
  91 :       ENDIF
  92 : C
  93 :       DO I1=1,N1,1
  94 :          IMODEL=MMODEL.KMODEL(I1)
  95 :          SEGDES IMODEL
  96 :       ENDDO
  97 : C
  98 :       SEGDES MMODEL
  99 : C
 100 : C**** Now the TABLE DOMAINE exists and it is filled
 101 : C
 101 :       CALL ECROBJ('TABLE',MTAB)
 102 :       RETURN
 103 :       END
 104 :  
 105 :  
 106 :  
 107 :  
 108 :  
 109 :  
 110 :  
 111 :