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

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