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

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