Télécharger la plaquette Cast3M


fr en

Télécharger exis.eso

Retour à la liste

Numérotation des lignes : 

exis

  1. C EXIS      SOURCE    CB215821  24/04/12    21:15:50     11897          
  2.  
  3.       SUBROUTINE EXIS
  4.  
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC CCHAMP
  12.  
  13. -INC SMSOLUT
  14. -INC SMLMOTS
  15. -INC SMLENTI
  16. -INC SMLREEL
  17. -INC SMCHARG
  18. -INC SMMODEL
  19. -INC SMNUAGE
  20.  
  21.       PARAMETER (NBFORM=20)
  22.       PARAMETER (NLOMAX=5)
  23.       CHARACTER*4 MNLOCA(NLOMAX)
  24.       CHARACTER*(LOCOMP) CMOT
  25.       CHARACTER*8 MOTYP,TYPOBJ,MOTYP1,MONU1
  26.       CHARACTER*(LCONMO) MOFORM(NBFORM)
  27.       CHARACTER*(LOCHAI) ICHAI,CHARRE,CCHAI
  28.       LOGICAL IRET,IBOOL,LOGRE
  29.       INTEGER ICLE
  30. *
  31.       PARAMETER (LSOL = 1)
  32.       CHARACTER*4 MOTSOL(LSOL)
  33.       DATA MOTSOL/'CONT'/
  34.  
  35.       PARAMETER (LMOD = 5)
  36.       CHARACTER*(4) MOTMOD(LMOD)
  37.       DATA MOTMOD/'FORM','CONS','ELEM','MATE','NON_'/
  38.       MACRO,(FORMULATION,CONSTITUANT,ELEMENT,MATERIAU,NON_LOCAL)
  39. *
  40.       PARAMETER (NCLE=2)
  41.       CHARACTER*2 LCLE(NCLE)
  42.       DATA LCLE/'OU','ET'/
  43.  
  44.       PARAMETER (MCLE=1)
  45.       CHARACTER*1 MOTCLE(MCLE)
  46.       DATA MOTCLE/'*'/
  47.       LOGICAL LDUM
  48. *
  49.       ICLE=0
  50.       ILE=1
  51.       IOBJLU=0
  52.       CALL LIROBJ('OBJET   '  ,MTABLE,0,IRETOU)
  53.       IF(IRETOU.NE.0) THEN
  54.         IOBJLU=1
  55.       ELSE
  56.         CALL LIROBJ('TABLE   ',MTABLE,0,IRETOU)
  57.       ENDIF
  58.  
  59.       IF (IRETOU.NE.0) THEN
  60. c       traitement special pour les objets de type TABLE
  61.   4     CONTINUE
  62.         CALL QUETYP(MOTYP,0,IRETOU)
  63.         IF( IRETOU.NE.0) THEN
  64.           IF    (MOTYP.EQ.'ENTIER  ') THEN
  65.              CALL LIRENT(IVAL,1,IRETOU)
  66.              IF(IERR.NE.0) RETURN
  67.           ELSEIF(MOTYP.EQ.'MOT     ')THEN
  68.              CALL LIRCHA(ICHAI,1,ILE)
  69.              IF(IERR.NE.0) RETURN
  70.           ELSEIF(MOTYP.EQ.'LOGIQUE ') THEN
  71.              CALL LIRLOG(IBOOL,1,IRETOU)
  72.              IF(IERR.NE.0) RETURN
  73.           ELSEIF(MOTYP.EQ.'FLOTTANT') THEN
  74.              CALL LIRREE(XRET,1,IRETOU)
  75.              IF(IERR.NE.0) RETURN
  76.           ELSE
  77.              CALL LIROBJ(MOTYP,IOBJ,1,IRETOU)
  78.              IF(IERR .NE. 0) RETURN
  79.              CALL ACTOBJ(MOTYP,IOBJ,1)
  80.           ENDIF
  81.           TYPOBJ=' '
  82.           CALL ACCTAB(MTABLE,MOTYP,IVAL,XRET,ICHAI(1:ILE),IBOOL,
  83.      $         IOBJ,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  84.           IF( TYPOBJ.EQ.'        '.AND.MOTYP.EQ.'MOT     '.
  85.      $    AND.IOBJLU.EQ.1) CALL ACCTAB (MTABLE,'METHODE ',IVAL,
  86.      $      XRET,ICHAI(1:ILE),IBOOL,IOBJ,TYPOBJ,
  87.      $      IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  88.           MTABLE = IOBRE
  89.           IRET=.TRUE.
  90.           IF(TYPOBJ.EQ.'TABLE   ') GOTO 4
  91.           IF(TYPOBJ.EQ.'        ') IRET = .FALSE.
  92.           GOTO 100
  93.  
  94.         ELSE
  95.           IRET=.TRUE.
  96.           GOTO 100
  97.         ENDIF
  98.  
  99.       ELSE
  100.          IRET =.TRUE.
  101.          CALL QUETYP(MOTYP,0,IRETOU)
  102.          IF (IRETOU.EQ.0) THEN
  103.            IRET = .FALSE.
  104.            GOTO 100
  105.          ENDIF
  106.  
  107.  
  108.          CALL LIROBJ(MOTYP,IVAL,1,IRETOU)
  109.          IF(IERR .NE. 0) RETURN
  110.          CALL ACTOBJ(MOTYP,IVAL,1)
  111.  
  112. C        Verification que l'objet demande etait du type demande : toto*'MAILLAGE' par exemple
  113.          CALL LIRMOT(MOTCLE,MCLE,IR,0)
  114.          IF (IR.GT.0) THEN
  115.            CALL LIRCHA(TYPOBJ,1,IRETOU)
  116.            IF (IERR.NE.0) RETURN
  117.            IF (TYPOBJ .EQ. 'FICHIER ')THEN
  118. C            Cas du test d'existence d'un fichier
  119.              IF(MOTYP .NE. 'MOT     ')THEN
  120.                IRET = .FALSE.
  121.  
  122.              ELSE
  123.                CALL QUEVAL(IVAL,'MOT',IRET1,ILON1,XDUM,CCHAI,LDUM,IDUM)
  124. C               PRINT *,'EXIS:',MOTYP,IVAL,':',CCHAI(1:ILON1),':'
  125.                INQUIRE( FILE=CCHAI(1:ILON1), EXIST=IRET )
  126.              ENDIF
  127.  
  128.            ELSEIF (TYPOBJ .NE. MOTYP) THEN
  129.              IRET = .FALSE.
  130.            ENDIF
  131.            GOTO 100
  132.  
  133.          ELSEIF (MOTYP.NE.'CHPOINT ' .AND. MOTYP.NE.'MCHAML  '.AND.
  134.      &           MOTYP.NE.'MMODEL  ' .AND. MOTYP.NE.'LISTMOTS'.AND.
  135.      &           MOTYP.NE.'LISTENTI' .AND. MOTYP.NE.'LISTREEL'.AND.
  136.      &           MOTYP.NE.'NUAGE   ' .AND. MOTYP.NE.'CHARGEME' ) THEN
  137.  
  138.             IF (MOTYP.EQ.'ANNULE  ') THEN
  139.                IRET = .FALSE.
  140.  
  141.             ELSEIF (MOTYP.EQ.'SOLUTION') THEN
  142.                CALL LIRMOT(MOTSOL,LSOL,IPOS,0)
  143.                IF (MOTSOL(IPOS).EQ.'CONT') THEN
  144.                   MSOLUT = IVAL
  145.                   SEGACT MSOLUT
  146.                   MSOLEN = MSOLIS(6)
  147.                   SEGDES MSOLUT
  148.                   IF (MSOLEN.EQ.0) THEN
  149.                      IRET = .FALSE.
  150.                   ENDIF
  151.                ENDIF
  152.             ENDIF
  153.             GOTO 100
  154.          ENDIF
  155.       ENDIF
  156. c
  157. c  existence d une composante dans un mchaml ou un champoint
  158. c
  159.       IF (MOTYP.EQ.'CHPOINT '.OR.MOTYP.EQ.'MCHAML  ') THEN
  160.         CALL LIRCHA(CMOT,0,IRETOU)
  161.         if (IRETOU.EQ.0) then
  162.           if (MOTYP.EQ.'MCHAML  ') then
  163.               CALL QUETYP(MOTYP1,0,IRETO1)
  164.               IF (IRETO1.NE.0) THEN
  165.                   IF (MOTYP1.NE.'MAILLAGE'.AND.MOTYP1.NE.'MMODEL') THEN
  166.                       MOTERR(1:8)=MOTYP1
  167.                       CALL ERREUR(39)
  168.                       RETURN
  169.                   ENDIF
  170.                   call exiszo(ival,iret)
  171.                   IF (IERR.NE.0) RETURN
  172.                   GOTO 100
  173.               ELSE
  174.                   GOTO 122
  175.               ENDIF
  176.           else
  177.               GOTO 122
  178.           endif
  179.         endif
  180.         CALL EXISCO(MOTYP,IVAL,CMOT,IRET)
  181.         IF(IERR.NE.0) RETURN
  182.         GOTO 100
  183. c
  184. c  existence d'un mot/listmots dans un listmots
  185. c
  186.       ELSEIF (MOTYP.EQ.'LISTMOTS') THEN
  187.         MLMOTS=IVAL
  188.         SEGACT,MLMOTS
  189.         JGN   =MOTS(/1)
  190.         JGM   =MOTS(/2)
  191.         ILON  =JGN
  192.         CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETO1)
  193.         IF (IRETO1.NE.0) THEN
  194.             SEGACT MLMOT1
  195.             NTEST=MLMOT1.MOTS(/2)
  196.             IF (NTEST.EQ.0) THEN
  197.                 MOTERR(1:8)='LISTMOTS'
  198.                 INTERR(1)=MLMOT1
  199.                 CALL ERREUR(356)
  200.                 RETURN
  201.             ENDIF
  202.             CALL LIRMOT(LCLE,NCLE,ICLE,0)
  203.         ELSE
  204.             CALL LIRCHA(CCHAI,0,ILON)
  205.             IF (ILON.EQ.0) GOTO 122
  206.             NTEST=1
  207.  
  208.             IF(ILON .GT. JGN)THEN
  209.               MOTERR   =CCHAI
  210.               INTERR(1)=JGN
  211.               CALL ERREUR(-371)
  212.               ILON     =JGN
  213.             ENDIF
  214.         ENDIF
  215.  
  216.         DO 22 I=1,NTEST
  217.             IRET=.FALSE.
  218.             IF (IRETO1.NE.0) CCHAI=MLMOT1.MOTS(NTEST+1-I)
  219.             DO 20 J=1,JGM
  220.                 IF (MOTS(J).EQ.CCHAI(1:ILON)) THEN
  221.                     IRET=.TRUE.
  222.                     IF (ICLE.EQ.0) THEN
  223.                         CALL ECRLOG(IRET)
  224.                     ELSEIF (ICLE.EQ.1) THEN
  225. *                       Mot-clé 'OU' : un mot trouve => on peut sortir
  226.                         GOTO 21
  227.                     ENDIF
  228.                     GOTO 22
  229.                 ENDIF
  230.   20        CONTINUE
  231.             IF (ICLE.EQ.0) THEN
  232.                 CALL ECRLOG(IRET)
  233.             ELSEIF (ICLE.EQ.2) THEN
  234. *               Mot-clé 'ET' : un mot non trouve => on peut sortir
  235.                 GOTO 21
  236.             ENDIF
  237.   22    CONTINUE
  238.   21    IF (ICLE.EQ.0) RETURN
  239.         GOTO 100
  240. c
  241. c  existence d'un entier dans un listenti
  242. c
  243.       ELSEIF (MOTYP.EQ.'LISTENTI') THEN
  244.         CALL LIRENT(ITEST,0,IRETOU)
  245.         IF (IRETOU.EQ.0) GOTO 122
  246.         IRET=.FALSE.
  247.         MLENTI=IVAL
  248.         SEGACT MLENTI
  249.         JG=LECT(/1)
  250.         DO 30 J=1,JG
  251.           IF(LECT(J).EQ.ITEST) THEN
  252.           IRET=.TRUE.
  253.           GOTO 100
  254.           ENDIF
  255.   30    CONTINUE
  256.         GOTO 100
  257. c
  258. c  existence d'un reel dans un listreel
  259. c
  260.       ELSEIF (MOTYP.EQ.'LISTREEL') THEN
  261.         CALL LIRREE(XTEST,0,IRETOU)
  262.         IF (IRETOU.EQ.0) GOTO 122
  263. *       lecture eventuelle d une tolerance
  264.         CALL LIRREE(XTOL,0,IRETOU)
  265.         IRET=.FALSE.
  266.         MLREEL=IVAL
  267.         SEGACT MLREEL
  268.         JG=PROG(/1)
  269.         IF (IRETOU.EQ.0) THEN
  270.           DO 40 J=1,JG
  271.             IF(PROG(J).EQ.XTEST) THEN
  272.             IRET=.TRUE.
  273.             GOTO 100
  274.             ENDIF
  275.   40      CONTINUE
  276.         ELSE
  277.           DO 42 J=1,JG
  278.             IF(abs(PROG(J)-XTEST).LE.XTOL) THEN
  279.             IRET=.TRUE.
  280.             GOTO 100
  281.             ENDIF
  282.   42      CONTINUE
  283.         ENDIF
  284.         GOTO 100
  285. c
  286. c  existence d'une formulation ou un constituant dans
  287. c                     un mmodel
  288. c
  289.       ELSEIF (MOTYP.EQ.'MMODEL  ') THEN
  290.         CALL LIRMOT(MOTMOD,LMOD,IRETOU,0)
  291.         IF (IRETOU.EQ.0) GOTO 122
  292.         CMOT=MOTMOD(LMOD)
  293.         ICOND=1
  294.         INFOR=1
  295. 119     call lircha(moform(infor),icond,ireto)
  296.         IF(IERR.NE.0) RETURN
  297.         ICOND=0
  298.         IF(IRETO.NE.0) THEN
  299.           INFOR=INFOR+1
  300.           IF(INFOR.GT.NBFORM) THEN
  301.             CALL ERREUR(5)
  302.             RETURN
  303.           ENDIF
  304.           GOTO 119
  305.         ENDIF
  306.         INFOR=INFOR-1
  307.  
  308. C       Extension du MMODEL en cas de modele de MELANGE
  309.         CALL MODETE(IVAL,mmodel,IMELAN)
  310.         NSOUS=KMODEL(/1)
  311.         IF(NSOUS .EQ. 0)THEN
  312.           CALL ERREUR(21)
  313.           RETURN
  314.         ENDIF
  315.  
  316.         DO 1119 I=1,NSOUS
  317.           IMODEL=KMODEL(I)
  318.  
  319. C         =============================================================
  320.           CASE, IRETOU
  321. C         -------------------------------------------------------------
  322.           WHEN,FORMULATION
  323. C         -------------------------------------------------------------
  324.            NFOR=FORMOD(/2)
  325.            IF(NFOR.NE.INFOR) GOTO 1119
  326.            IF(NFOR.EQ.1) THEN
  327.             IF(MOFORM(1).EQ.FORMOD(1)) GOTO 1118
  328.            ELSEIF(NFOR.EQ.2) THEN
  329.             IF(((MOFORM(1).EQ.FORMOD(1)).AND.(MOFORM(2).EQ.FORMOD(2))).
  330.      &      OR.((MOFORM(1).EQ.FORMOD(2)).AND.(MOFORM(2).EQ.FORMOD(1))))
  331.      &      GOTO 1118
  332.            ENDIF
  333.  
  334. C         -------------------------------------------------------------
  335.           WHEN,CONSTITUANT
  336. C         -------------------------------------------------------------
  337.            DO 425 IJ=1,INFOR
  338.              IF(MOFORM(IJ).EQ.CONMOD) GOTO 1118
  339.  425       CONTINUE
  340. C         -------------------------------------------------------------
  341.           WHEN,ELEMENT
  342. C         -------------------------------------------------------------
  343.            DO 426 IJ=1,INFOR
  344.              IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GOTO 1118
  345.  426       CONTINUE
  346. C         -------------------------------------------------------------
  347.           WHEN,MATERIAU
  348. C         -------------------------------------------------------------
  349.            NMAT=MATMOD(/2)
  350.            DO 427 IJ=1,INFOR
  351.              IBOOL = .TRUE.
  352.              DO 4275 JJ=1,NMAT
  353.                IBOOL = (MATMOD(JJ).NE.MOFORM(IJ)).AND. IBOOL
  354.  4275        CONTINUE
  355.              IF (IBOOL) GOTO 1119
  356.  427       CONTINUE
  357.            GOTO 1118
  358. C         -------------------------------------------------------------
  359.           WHEN,NON_LOCAL
  360. C         -------------------------------------------------------------
  361.            MN3=INFMOD(/1)
  362.            IF(MN3.LE.12) GOTO 1119
  363.            INLOC=-1*INFMOD(13)
  364.            IF(INLOC.EQ.0) GOTO 1119
  365.            CALL MODNLO(MNLOCA,NLODIM)
  366.            DO 428 IJ=1,INFOR
  367.              IF(MNLOCA(INLOC).EQ.MOFORM(IJ)(1:4)) GOTO 1118
  368.  428       CONTINUE
  369. C         -------------------------------------------------------------
  370.           ENDCASE
  371. C         =============================================================
  372.  
  373. 1119      continue
  374. *
  375.         IRET=.FALSE.
  376.         GOTO 100
  377. *
  378. 1118    continue
  379.         IRET=.TRUE.
  380.         GOTO 100
  381. c
  382. c       cas de l'objet chargeme
  383. c
  384.       ELSEIF (MOTYP.EQ.'CHARGEME') THEN
  385.         CALL LIRCHA(CMOT,0,IRETOU)
  386.         IF (IRETOU.EQ.0) GOTO 122
  387.         IRETO2 = 0
  388.         CALL LIRCHA(MOTYP1,0,IRETO2)
  389.         IRET = .FALSE.
  390.         MCHARG = IVAL
  391.         SEGACT MCHARG
  392.         IDIM1 = KCHARG(/1)
  393.         IF (CMOT.EQ.'LIBR'.OR.CMOT.EQ.'LIE ') THEN
  394.           DO 302 I=1,IDIM1
  395.              IF (CMOT.EQ.CHALIE(I)) THEN
  396.                IRET = .TRUE.
  397.                GOTO 301
  398.              ENDIF
  399.  302      CONTINUE
  400.         ELSE
  401.           DO 300 I=1,IDIM1
  402.              IF (CMOT.EQ.CHANOM(I)) THEN
  403.                IF (IRETO2.EQ.0) THEN
  404.                  IRET = .TRUE.
  405.                  GOTO 301
  406.                ENDIF
  407.                ICHARG=KCHARG(I)
  408.                SEGACT,ICHARG
  409.                IF (MOTYP1.EQ.CHATYP) THEN
  410.                  IRET = .TRUE.
  411.                  GOTO 301
  412.                ENDIF
  413.              ENDIF
  414.  300      CONTINUE
  415.         ENDIF
  416.  301    CONTINUE
  417.         GOTO 100
  418. c
  419. c       cas de l'objet nuage
  420. c
  421.       ELSE
  422.         CALL LIRCHA(MONU1,0,IRETOU)
  423.         IF (IRETOU.EQ.0) GOTO 122
  424.         IRET=.FALSE.
  425.         MNUAGE=IVAL
  426.         SEGACT MNUAGE
  427.         IDIM1 = NUANOM(/2)
  428.         DO 200 I=1,IDIM1
  429.            IF (MONU1.EQ.NUANOM(I)) THEN
  430.              IRET = .TRUE.
  431.              GOTO 201
  432.            ENDIF
  433.  200    CONTINUE
  434.  201    CONTINUE
  435.         GOTO 100
  436.       ENDIF
  437. c
  438.  122  CONTINUE
  439.       IRET=.TRUE.
  440.       IF(MOTYP.NE.'ANNULE  ') GOTO 100
  441.       IRET=.FALSE.
  442.  100  CONTINUE
  443.       CALL ECRLOG(IRET)
  444.       END
  445.  
  446.  
  447.  
  448.  
  449.  
  450.  
  451.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales