Télécharger la plaquette Cast3M


fr en

Télécharger cneqp.eso

Retour à la liste

Numérotation des lignes : 

cneqp

  1. C CNEQP     SOURCE    OF166741  24/10/03    21:15:07     12022          
  2.  
  3.       SUBROUTINE CNEQP(IPMODL,IPCHE1,IPCHPO,IPCHE2,IPCHE3,IRET)
  4.  
  5. C_______________________________________________________________________
  6. C
  7. C  Entrees:
  8. C  ________
  9. C
  10. C     IPMODL  Pointeur sur un MMODEL
  11. C     IPCHE1  Pointeur sur un MCHAML de forces volumiques
  12. C     IPCHPO  Pointeur sur un CHPOINT de forces volumiques
  13. C     IPCHE2  Pointeur sur un MCHAML de caracteristiques (FACULTATIF)
  14. C
  15. C  SORTIES:
  16. C  ________
  17. C
  18. C     IPCHE3  Pointeur sur un MCHAML de forces aux noeuds
  19. C     IRET =1  OU  0   suivant succes ou pas (Message d'erreur
  20. C                                         imprime dans ce cas
  21. C
  22. C_______________________________________________________________________
  23. C
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCHAMP
  30.  
  31. -INC SMCHAML
  32. -INC SMCHPOI
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMMODEL
  36.       POINTEUR NOMID1.NOMID
  37. -INC SMINTE
  38.  
  39.       SEGMENT INFO
  40.         INTEGER INFELL(JG)
  41.       ENDSEGMENT
  42.  
  43.       SEGMENT NOTYPE
  44.         CHARACTER*16 TYPE(NBTYPE)
  45.       ENDSEGMENT
  46.  
  47.       SEGMENT MPTVAL
  48.         INTEGER IPOS(NS)    ,NSOF(NS)
  49.         INTEGER      IVAL(NCOSOU)
  50.         CHARACTER*16 TYVAL(NCOSOU)
  51.       ENDSEGMENT
  52.  
  53.       PARAMETER ( NINF=3 , ISUPC=3)
  54.       INTEGER INFOS(NINF)
  55.       CHARACTER*8 CMATE
  56.       CHARACTER*(NCONCH) CONM
  57.       LOGICAL lsupfo
  58.       INTEGER ISUP1, ISUP2
  59.  
  60.       IRET = 0
  61.       ISUP1 = 0
  62.       ISUP2 = 0
  63.  
  64.       nbtype = 1
  65.       SEGINI,notype
  66.       notype.TYPE(1) = 'REAL*8'
  67.       MOTYR8 = notype
  68.  
  69. * Premieres verifications sur le modele (formulation)
  70.       MMODEL = IPMODL
  71.       NSOUS = KMODEL(/1)
  72.  
  73.       IMECA = 0
  74.       IELEC = 0
  75.       IMAGN = 0
  76.       DO ISOUS = 1, NSOUS
  77.         IMODEL = KMODEL(ISOUS)
  78.         NFOR = FORMOD(/2)
  79.         IF (NFOR.EQ.1) THEN
  80.           IF (FORMOD(1).EQ.'MECANIQUE' .OR. FORMOD(1).EQ.'POREUX') THEN
  81.             IMECA = 1
  82.           ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  83.             IELEC = 1
  84.           ELSE IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  85.             IMAGN = 1
  86.           ELSE
  87.             MOTERR(1:8) = FORMOD(1)
  88.             CALL ERREUR(193)
  89.             GOTO 9991
  90.           ENDIF
  91.         ELSE IF (NFOR.GT.1) THEN
  92.           MOTERR(1:8) = FORMOD(1)
  93.           CALL ERREUR(193)
  94.           GOTO 9991
  95.         ENDIF
  96.       ENDDO
  97.       IF (IMECA+IELEC+IMAGN .NE. 1) THEN
  98. *AV Affiner l'erreur !
  99.         write(ioimp,*) 'Une seule formulation dans le modele !'
  100.         CALL ERREUR(21)
  101.         GOTO 9990
  102.       ENDIF
  103.  
  104. *   PASSAGE DU CHPOINT EN MCHAML
  105.       IF (IPCHE1.EQ.0) THEN
  106.         CALL CHAME1(0,IPMODL,IPCHPO,'VOLUMIQUE',IPCHE1,1)
  107.       ENDIF
  108.  
  109. *   Verification du lieu support du MCHAML de forces volumiques
  110.       CALL QUESUP(IPMODL,IPCHE1,ISUPC,0,ISUP1,IRET1)
  111.       IF (ISUP1.GT.1) THEN
  112.          CALL ERREUR(609)
  113.          GOTO 9990
  114.       ENDIF
  115.  
  116. *     Verification du lieu support du MCHAML de caracteristiques
  117.       IF (IPCHE2.NE.0) THEN
  118.          CALL QUESUP(IPMODL,IPCHE2,ISUPC,1,ISUP2,IRET2)
  119.          IF (ISUP2.GT.1) THEN
  120.             CALL ERREUR(609)
  121.             GOTO 9990
  122.          ENDIF
  123.       ENDIF
  124.  
  125. *_______________________________________________________________________
  126. *     INITIALISATION DU MCHELM DE VALEURS NODALES
  127. *_______________________________________________________________________
  128.       L1=6
  129.       N1=NSOUS
  130.       N3=6
  131.       SEGINI MCHELM
  132.       IPCHE3=MCHELM
  133.       IFOCHE=IFOUR
  134.       TITCHE='FORCES'
  135.  
  136. C  Initialisation de quelques variables (MECANIQUE ou POREUX)
  137.       IF (IMECA.EQ.1) THEN
  138.       IF (IFOUR.EQ.-3) THEN
  139.         NFORDG=3
  140.       ELSE IF (IFOUR.EQ.11) THEN
  141.         NFORDG=2
  142.       ELSE IF ((IFOUR.GE.7.AND.IFOUR.LE.10).OR.IFOUR.EQ.14) THEN
  143.         NFORDG=1
  144.       ELSE
  145.         NFORDG=0
  146.       ENDIF
  147.       ELSE
  148.         NFORDG=0
  149.       ENDIF
  150. C_______________________________________________________________________
  151. C
  152. C     BOUCLE SUR LES SOUS ZONES
  153. C_______________________________________________________________________
  154.  
  155.       DO 200 ISOUS=1,NSOUS
  156. C
  157. C   INITIALISATION
  158. C
  159.       IPMINT = 0
  160.       IVACAR = 0
  161.       IVAFOR = 0
  162.       IVAFVO = 0
  163.       MOCARA = 0
  164.       MOFORC = 0
  165.       MOFOVO = 0
  166.       MCHAML = 0
  167. C
  168. C     TRAITEMENT DU MODELE
  169. C
  170.       IMODEL=KMODEL(ISOUS)
  171.  
  172.       MELE=NEFMOD
  173.       IPMAIL=IMAMOD
  174.       CONM  =CONMOD
  175.       IIPDPG = imodel.IPDPGE
  176.       IIPDPG = IPTPOI(IIPDPG)
  177.  
  178.       CMATE = imodel.CMATEE
  179. C____________________________________________________________________
  180. C
  181. C     ACTIVATION DU MELEME
  182. C
  183.       MELEME=IPMAIL
  184.       NBNN   = meleme.NUM(/1)
  185.       NBELEM = meleme.NUM(/2)
  186. C
  187. C     CREATION DU TABLEAU INFOS
  188. C
  189.       CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  190.       IF (IRTD.EQ.0) GOTO 510
  191. C_______________________________________________________________________
  192. C
  193. C     INFORMATIONS SUR L'ELEMENT FINI
  194. C_______________________________________________________________________
  195. C
  196.        iplaz=3
  197.        IF (IMAGN .EQ. 1) iplaz=2
  198.        if (infmod(/1).lt.2+iplaz) then
  199.         CALL ELQUOI(MELE,0,iplaz,IPINF,IMODEL)
  200.         IF (IERR.NE.0) GOTO 510
  201.         INFO=IPINF
  202.         NBPGAU= INFELL(4)
  203.         NBG   = INFELL(6)
  204.         IPMINT= INFELL(11)
  205.         MFR   = INFELL(13)
  206.         LW    = INFELL(7)
  207.         NDDL  = INFELL(15)
  208.         LRE   = INFELL(9)
  209.         IPORE = INFELL(8)
  210.         IPMIN1=INFELL(12)
  211.         SEGSUP,INFO
  212.       ELSE
  213.         NBPGAU= INFELE(4)
  214.         NBG   = INFELE(6)
  215.         IPMINT= INFMOD(2+iplaz)
  216. **        IPMIN1= INFELE(12)
  217.         IPMIN1= INFMOD(8)
  218.         MFR   = INFELE(13)
  219.         LW    = INFELE(7)
  220.         NDDL  = INFELE(15)
  221.         LRE   = INFELE(9)
  222.         IPORE = INFELE(8)
  223.       ENDIF
  224.       IPPORE=0
  225.       IF(MFR.EQ.33) IPPORE=NBNN
  226.       NHRM   = NIFOUR
  227. C
  228.       MINTE = IPMINT
  229.       NBNO = SHPTOT(/2)
  230. C
  231. C     RECOPIE DU MCHELM
  232. C
  233.       IMACHE(ISOUS)=IPMAIL
  234.       CONCHE(ISOUS)=CONMOD
  235.       INFCHE(ISOUS,1)=0
  236.       INFCHE(ISOUS,2)=0
  237.       INFCHE(ISOUS,3)=NIFOUR
  238.       INFCHE(ISOUS,4)=0
  239.       INFCHE(ISOUS,5)=0
  240.       INFCHE(ISOUS,6)=1
  241. C_______________________________________________________________________
  242. C
  243. C     NOMS DE COMPOSANTES EN SORTIE ( FORCES POUR L'INSTANT ,
  244. C          COMPTE TENU DES FORMULATIONS DISPONIBLES )
  245. C  +    CREATION DU MCHAML
  246. C_______________________________________________________________________
  247. C
  248. C*     IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  249.       IF (IMAGN .EQ. 1) THEN
  250.         CALL IDPVIN(MFR,IFOUR,MOFORC,NFOR,NFAC)
  251.         IF ( NFAC.NE.0 ) THEN
  252.            CALL ERREUR(19)
  253.            GO TO 510
  254.         ENDIF
  255.         NOMID1=MOFORC
  256.         lsupfo=.true.
  257.         NCOMP=NFOR
  258.         N2=1
  259.         SEGINI MCHAML
  260.         ICHAML(ISOUS)=MCHAML
  261.         NOMCHE(1)='ED'
  262.         TYPCHE(1)='REAL*8'
  263.       ELSE
  264.         moforc=lnomid(2)
  265.         if (moforc.eq.0) then
  266.           write(ioimp,*) 'CNEQP : MOFORC = lnomid(2) = 0'
  267.           call erreur(5)
  268.         endif
  269.         nomid1=moforc
  270.         nfor =nomid1.lesobl(/2)
  271.         nfac =nomid1.lesfac(/2)
  272.         IF (NFAC.NE.0 .OR. NFOR.NE.NDDL) THEN
  273.           CALL ERREUR(19)
  274.           GO TO 510
  275.         ENDIF
  276.         lsupfo=.false.
  277.         NCOMP=NFOR-NFORDG
  278.         NDDL =NDDL-NFORDG
  279.         N2=NCOMP
  280.         SEGINI,MCHAML
  281.         ICHAML(ISOUS)=MCHAML
  282.         DO 110 ICOMP=1,NCOMP
  283.           NOMCHE(ICOMP)=NOMID1.LESOBL(ICOMP)
  284.           TYPCHE(ICOMP)='REAL*8'
  285.  110    CONTINUE
  286.       ENDIF
  287. *_______________________________________________________________________
  288.  
  289. *     TRAITEMENT DU CHAMP DE VALEURS NODALES EN ENTREE
  290. *_______________________________________________________________________
  291.  
  292. *   ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
  293. *   MAIS ON LES  MET EN FACULTATIF
  294. *    PUIS ON CREE LE SEGMENT MOFOVO
  295.       NBROBL=0
  296.       NBRFAC=NCOMP
  297.       NFOVO=NBRFAC
  298.       SEGINI NOMID
  299.       MOFOVO=NOMID
  300.       DO 120 ICOMP=1,NCOMP
  301.         LESFAC(ICOMP)=NOMID1.LESOBL(ICOMP)
  302.  120  CONTINUE
  303.  
  304. *     RECUPERATION DES COMPOSANTES PRESENTES
  305.       CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOFOVO,MOTYR8,0,INFOS,3,IVAFVO)
  306.       IF (IERR.NE.0) GOTO 510
  307.  
  308. *   ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
  309.  
  310.        MPTVAL = IVAFVO
  311.        NCOSOU = IVAL(/1)
  312.        NFOVOL = 0
  313.        DO 50 I=1,NCOSOU
  314.          IF (IVAL(I).NE.0) NFOVOL=NFOVOL+1
  315.    50  CONTINUE
  316.        IF(NFOVOL.EQ.0) THEN
  317.            CALL ERREUR(665)
  318.            GO TO 510
  319.        ENDIF
  320.  
  321. *      CHANGEMENT DE SUPPORT SI BESOIN
  322.         IF (ISUP1.EQ.1) THEN
  323.            CALL VALCHE(IVAFVO,NFOVO,IPMINT,IPPORE,MOFOVO,MELE)
  324.         ENDIF
  325. C____________________________________________________________________
  326. C
  327. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  328. C____________________________________________________________________
  329.         NBROBL=0
  330.         NBRFAC=0
  331.         NOMID =0
  332.         IVECT=0
  333.         NOTYPE = MOTYR8
  334.  
  335. C*        IF (FORMOD(1).NE.'MECANIQUE' .AND.
  336. C*   &        FORMOD(1).NE.'POREUX'    ) GO TO 777
  337.         IF (IMECA .NE. 1) GO TO 777
  338.  
  339. * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
  340.         IF ((MFR.EQ.1.OR.MFR.EQ.33).AND.IFOUR.EQ.-2.
  341.      +               AND.IPCHE2.NE.0)THEN
  342.           NBRFAC=1
  343.           SEGINI NOMID
  344.           LESFAC(1)='DIM3'
  345.  
  346. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  347.         ELSEIF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  348.            NBROBL=1
  349.            IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  350.              NBRFAC=2
  351.            ELSE
  352.              NBRFAC=1
  353.            ENDIF
  354.            SEGINI NOMID
  355.            LESOBL(1)='EPAI'
  356.            LESFAC(1)='EXCE'
  357.            IF(MFR.EQ.3.AND.IFOUR.EQ.-2)  LESFAC(2)='DIM3'
  358.  
  359. * SECTION POUR LES BARRES
  360.  
  361.         ELSE IF (MFR.EQ.27) THEN
  362.            NBROBL=1
  363.            SEGINI NOMID
  364.            LESOBL(1)='SECT'
  365.  
  366. * CARACTERISTIQUES POUR LES POUTRES
  367.  
  368.          ELSE IF (MFR.EQ.7 ) THEN
  369.            NBROBL=4
  370.            NBRFAC=5
  371.            SEGINI NOMID
  372.            LESOBL(1)='TORS'
  373.            LESOBL(2)='INRY'
  374.            LESOBL(3)='INRZ'
  375.            LESOBL(4)='SECT'
  376.            LESFAC(1)='SECY'
  377.            LESFAC(2)='SECZ'
  378.            LESFAC(3)='VX'
  379.            LESFAC(4)='VY'
  380.            LESFAC(5)='VZ'
  381.            IVECT=1
  382.  
  383. * CARACTERISTIQUES POUR LES TUYAUX
  384.  
  385.          ELSE IF (MFR.EQ.13) THEN
  386.            NBROBL=2
  387.            NBRFAC=4
  388.            SEGINI NOMID
  389.            LESOBL(1)='EPAI'
  390.            LESOBL(2)='RAYO'
  391.            LESFAC(1)='RACO'
  392.            LESFAC(2)='VX  '
  393.            LESFAC(3)='VY  '
  394.            LESFAC(4)='VZ  '
  395.            IVECT=1
  396.  
  397. * CARACTERISTIQUES POUR LES LINESPRING
  398.  
  399.          ELSE IF (MFR.EQ.15) THEN
  400.            NBROBL=5
  401.            SEGINI NOMID
  402.            LESOBL(1)='EPAI'
  403.            LESOBL(2)='FISS'
  404.            LESOBL(3)='VX  '
  405.            LESOBL(4)='VY  '
  406.            LESOBL(5)='VZ  '
  407.  
  408. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  409.  
  410.          ELSE IF (MFR.EQ.17) THEN
  411.            NBROBL=9
  412.            SEGINI NOMID
  413.            LESOBL(1)='RAYO'
  414.            LESOBL(2)='EPAI'
  415.            LESOBL(3)='VX  '
  416.            LESOBL(4)='VY  '
  417.            LESOBL(5)='VZ  '
  418.            LESOBL(6)='VXF '
  419.            LESOBL(7)='VYF '
  420.            LESOBL(8)='VZF '
  421.            LESOBL(9)='ANGL'
  422.  
  423. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  424.  
  425.          ELSE IF (MFR.EQ.37) THEN
  426.            IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  427.              NBROBL=4
  428.              SEGINI NOMID
  429.              LESOBL(1)='SCEL'
  430.              LESOBL(2)='SFLU'
  431.              LESOBL(3)='EPS '
  432.              LESOBL(4)='XINE'
  433.            ELSE
  434.              NBROBL=3
  435.              SEGINI NOMID
  436.              LESOBL(1)='SCEL'
  437.              LESOBL(2)='SFLU'
  438.              LESOBL(3)='EPS '
  439.            ENDIF
  440.          ENDIF
  441.  
  442.          NCARA=NBROBL
  443.          NCARF=NBRFAC
  444.          NCARR=NCARA+NCARF
  445.          MOCARA = NOMID
  446.          MOTYPE = NOTYPE
  447.  
  448.          IF (MOCARA.NE.0)  THEN
  449.             IF (IPCHE2.EQ.0)  THEN
  450.                IF (MOTYPE.NE.MOTYR8) SEGSUP NOTYPE
  451.                MOTERR(1:8)='CARACTER'
  452.                MOTERR(9:12)=NOMTP(MELE)
  453.                MOTERR(13:20)='CNEQ   '
  454.                CALL ERREUR(145)
  455.                GOTO 510
  456.             ENDIF
  457.                CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
  458.      $                     IVACAR)
  459.                IF (MOTYPE.NE.MOTYR8) SEGSUP NOTYPE
  460.                IF (IERR.NE.0) GOTO 510
  461.                IF (ivect.eq.1) IVECT=2
  462.  
  463.             IF (ISUP2.EQ.1) THEN
  464.               CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  465.               IF (IERR.NE.0)THEN
  466.                    ISUP2=0
  467.                    GOTO 510
  468.               ENDIF
  469.             ENDIF
  470.          ENDIF
  471. C
  472. C      TAILLES DE MELVAL
  473. C
  474.   777 CONTINUE
  475. C
  476.       N1EL  =NBELEM
  477.       N1PTEL=NBNN
  478.       N2PTEL=0
  479.       N2EL=0
  480.       NBPTEL=NBPGAU
  481.       NEL   =N1EL
  482. C
  483. C     CREATION DU MELVAL DE FORCES NODALES
  484. C
  485.       NS=1
  486. C*    IF (FORMOD(1).EQ.'MAGNETODYNAMIQUE') THEN
  487.       IF (IMAGN .EQ. 1) THEN
  488.         NCOSOU=1
  489.       ELSE
  490.         NCOSOU=NCOMP
  491.       ENDIF
  492.       SEGINI MPTVAL
  493.       IVAFOR=MPTVAL
  494.       DO 100 ICOMP=1,NCOSOU
  495.         SEGINI MELVAL
  496.         IELVAL(ICOMP)=MELVAL
  497.         IVAL(ICOMP)=MELVAL
  498.   100 CONTINUE
  499. C_______________________________________________________________________
  500. C
  501. C     NUMERO DES ETIQUETTES      :
  502. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  503. C     Les elements sont groupes comme suit :
  504. C      - massif, poreux ---------------------------------> CNEQ1
  505. C      - coq3,dkt,coq4,coq8,coq2 ------------------------> CNEQ2
  506. C      - poutre,tuyau,linespring,tuyau fissure,barre ----> CNEQ3
  507. C_______________________________________________________________________
  508. C
  509.       IF(MELE.EQ.128) GO TO 128
  510.       GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  511.      1      99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99,
  512.      2      27,29,29,27,99,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
  513.      3      99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  514.      4       4, 4, 4,99,99,99,99,99,99,99,99,99,27,99,99,99,99),MELE
  515. C
  516.       IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  517.    99 CONTINUE
  518.       MOTERR(1:4)=NOMTP(MELE)
  519.       MOTERR(5:8)='CNEQ'
  520.       CALL ERREUR(86)
  521.       GOTO 510
  522. C_______________________________________________________________________
  523. C
  524. C     massifs, poreux
  525. C_______________________________________________________________________
  526. C
  527.    4  CONTINUE
  528.       IF (MFR.EQ.71) THEN
  529.         CALL CNEQEL(IPMAIL,IVAFVO,IPMINT,NBPGAU,IVAFOR,NCOMP)
  530.       ELSE
  531.       CALL CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT,IVACAR,
  532.      &            IPORE,NCOMP,IVAFOR,IIPDPG)
  533.       ENDIF
  534.       GOTO 510
  535. C_______________________________________________________________________
  536. C
  537. C     coq3,dkt,coq4,coq8,coq2,dst
  538. C_______________________________________________________________________
  539. C
  540.   27  CONTINUE
  541.       CALL CNEQ2(IPMAIL,LRE,NDDL,IVAFVO,LW,NBPGAU,IVACAR,CMATE,
  542.      & NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,IMAT,IVAFOR)
  543.       GOTO 510
  544. C_______________________________________________________________________
  545. C
  546. C     poutre,tuyau,linespring,tuyau fissure,barre
  547. C_______________________________________________________________________
  548. C
  549.   29  CONTINUE
  550.       GO TO 99
  551. C_______________________________________________________________________
  552. C
  553. C     Element fini rot3 pour la magnetodynamique
  554. C_______________________________________________________________________
  555. C
  556.   128 CONTINUE
  557.       CALL CNEQMG(IPMAIL,IPMINT,IVAFVO,IVAFOR,MOFOVO,MELE)
  558.       GO TO 510
  559. C_______________________________________________________________________
  560. C
  561. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  562. C_______________________________________________________________________
  563. C
  564.   510 CONTINUE
  565.  
  566.       IF(ISUP1.EQ.1)THEN
  567.            CALL DTMVAL(IVAFVO,3)
  568.       ELSE
  569.            CALL DTMVAL(IVAFVO,1)
  570.       ENDIF
  571.  
  572.       IF(ISUP2.EQ.1)THEN
  573.            CALL DTMVAL(IVACAR,3)
  574.       ELSE
  575.            CALL DTMVAL(IVACAR,1)
  576.       ENDIF
  577.  
  578.       NOMID=MOFORC
  579.       if (nomid.NE.0 .AND. lsupfo) SEGSUP NOMID
  580.       NOMID=MOFOVO
  581.       if (nomid.NE.0) SEGSUP NOMID
  582.       NOMID=MOCARA
  583.       if (nomid.NE.0) SEGSUP NOMID
  584.  
  585.       IF (IERR.EQ.0) THEN
  586.         CALL DTMVAL(IVAFOR,1)
  587.       ELSE
  588.         CALL DTMVAL(IVAFOR,3)
  589.         IF (MCHAML.NE.0) SEGSUP MCHAML
  590.         SEGSUP MCHELM
  591.         IRET = 0
  592.         GO TO 9990
  593.       ENDIF
  594.  
  595.   200 CONTINUE
  596.  
  597.       IRET = 1
  598.  
  599. C Desactivation (modele,mchaml) dans tous les cas
  600.  9990 CONTINUE
  601.       notype = MOTYR8
  602.       SEGSUP,notype
  603.  9991 CONTINUE
  604.  
  605. C      RETURN
  606.       END
  607.  
  608.  
  609.  

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