Download litdmd.eso

Back to the list

   1 : C LITDMD    SOURCE    CHAT      11/03/16    21:27:03     6902           
   2 :       SUBROUTINE LITDMD(MMODEL,MTABD,IRET)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*************************************************************************
   6 : C
   7 : C     ce SP lit une table DOMAINE ou un modele NAVIER_STOKES
   8 : C                                           ou DARCY ou EULER
   9 : C     Si OK IRET=1 MMODEL ou MTABD ne 0
  10 : C     Sinon IRET=0 MMODEL=0 et MTABD=0
  11 : C
  12 : C*************************************************************************
  13 :       CHARACTER*8 TYPC,TYPE,TYPS
  14 : -INC CCOPTIO
  15 : -INC SMMODEL
  16 : C***
  17 :       MTABD=0
  18 :       MMODEL=0
  19 : 
  19 :       CALL QUETYP(TYPE,0,IRET)
  20 : 
  21 :       IF(IRET.EQ.0)GO TO 99
  22 : 
  23 :       IF(TYPE.EQ.'MMODEL')THEN
  23 :          CALL LIROBJ('MMODEL',MMODEL,0,IRET)
  24 :          SEGACT MMODEL
  25 :          N1=KMODEL(/1)
  26 :          DO 1 L=1,N1
  27 :          IMODEL=KMODEL(L)
  28 :          SEGACT IMODEL
  29 :          IF(FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'DARCY'.AND.
  30 :      &      FORMOD(1).NE.'EULER')GO TO 99
  31 :          SEGDES IMODEL
  32 :  1       CONTINUE
  33 :          SEGDES MMODEL
  34 :          IRET=1
  35 :          RETURN
  36 :       ELSEIF(TYPE.EQ.'TABLE')THEN
  36 :          CALL LIROBJ(TYPE,MTABD,0,IRET)
  37 :          TYPC=' '
  37 :          CALL ACMO(MTABD,'SOUSTYPE',TYPC,IRET)
  38 :           IF(TYPC.EQ.'MOT     ')THEN
  38 :           CALL ACMM(MTABD,'SOUSTYPE',TYPS)
  39 :             IF(TYPS.EQ.'DOMAINE')THEN
  40 :             IRET=1
  41 :             RETURN
  42 :             ENDIF
  43 :           ENDIF
  44 :       ENDIF
  45 : 
  46 :  99   CONTINUE
  47 :       IRET=0
  48 : C% On veut un modèle de type %m1:16 .
  49 :           MOTERR( 1:16) = 'NAVIER_STOKES   '
  49 :           CALL ERREUR(719)
  50 :           WRITE(IOIMP,*)' ou une table de soustype DOMAINE '
  51 :           RETURN
  52 :       END
  53 :  
  54 :  
  55 :  
  56 :  
  57 :  
  58 :  
  59 :  
  60 :  
  61 :  
  62 :  

© Cast3M 2003 - All rights reserved.
Disclaimer