Télécharger la plaquette Cast3M


fr en

Télécharger fpmass.eso

Retour à la liste

Numérotation des lignes : 

fpmass

  1. C FPMASS    SOURCE    MB234859  25/09/08    21:15:28     12358          
  2.  
  3. C_____________________________________________________________________
  4. C
  5. C   CALCULE LES FORCES DE PRESSIONS APPLIQUEES SUR DES MASSIFS
  6. C
  7. C   ENTREES :
  8. C   ---------
  9. C
  10. C    IPCHE1   CHPOINT CONTENANT LES VALEURS DES PRESSIONS AUX NOEUDS
  11. C              DE LA FACE D UN MASSIF
  12. C    IPCHM1   CHAMELEM CONTENANT LES VALEURS DES PRESSIONS AUX NOEUDS
  13. C              DE LA FACE D UN MASSIF
  14. C    IPMODL   OBJET MODELE  SUR LEQUEL S APPLIQUE LA PRESSION
  15. C
  16. C    JPMAIL   POINTEUR SUR LE MAILLAGE SI ON A LU UN FLOTTANT ET
  17. C             UN MAILLAGE, SINON 0
  18. C
  19. C    XP       LA VALEUR DE LA PRESSION SI ON L'A LUE
  20. C
  21. C  SORTIES  :
  22. C  ----------
  23. C
  24. C    IPTFP  = CHPOINT DES FORCES NODALES EQUIVALENTES
  25. C    IRET   = 1 OU 0 SUIVANT SUCCES OU NON
  26. C
  27. C     REVISION JACQUELINE BROCHARD  SEPTEMBRE 86
  28. C     MISE A JOUR P VERPEAUX MAI 88
  29. C
  30. C     PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 17 09 90
  31. C_______________________________________________________________________
  32.  
  33.       SUBROUTINE FPMASS(IPCHE1,IPCHM1,IPMODL,IPTFP,JPMAIL,XP,IRET)
  34.  
  35.       IMPLICIT INTEGER(I-N)
  36.       IMPLICIT REAL*8(A-H,O-Z)
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC CCREEL
  41. -INC CCHAMP
  42.  
  43. -INC SMCOORD
  44. -INC SMELEME
  45. -INC SMMODEL
  46. -INC SMCHAML
  47. -INC SMCHPOI
  48. -INC SMINTE
  49.  
  50. -INC TMPTVAL
  51.  
  52.       SEGMENT NOTYPE
  53.         CHARACTER*16 TYPE(NBTYPE)
  54.       ENDSEGMENT
  55.  
  56.       segment netn(nonetn)
  57.       segment ietn(letn)
  58.  
  59.       CHARACTER*4 MOSTRI,MOAPPU,MOGEOM
  60.       CHARACTER*(NCONCH) CONM
  61.       PARAMETER (NINF=3)
  62.       INTEGER INFOS(NINF)
  63.       LOGICAL LSUPFO,ltelq
  64.  
  65.       DATA MOAPPU/'APPU'/,MOSTRI/'STRI'/
  66.       DATA MOGEOM/'GEOM'/
  67.  
  68.       IRET = 0
  69.       IGEOM = 0
  70.  
  71.       NHRM=NIFOUR
  72.  
  73. C-----------------------------------------------------------------------
  74. C LECTURE DU CHAMP DE CARACTERISTIQUES
  75. C-----------------------------------------------------------------------
  76.       IPCHE2 = 0
  77.       ISUPCA = 0
  78. C Prevoir la lecture en amont !
  79.       CALL LIROBJ('MCHAML  ',IPCHE2,0,irt2)
  80.       IF (IERR.NE.0) RETURN
  81.       IF (IPCHE2.NE.0) THEN
  82.         CALL ACTOBJ('MCHAML  ',IPCHE2,1)
  83.         IF (IERR.NE.0) RETURN
  84.  
  85.         CALL REDUAF(IPCHE2,MODORI,ipche20,0,iretca,kerr)
  86.         if (iretca.ne.1) call erreur(kerr)
  87.         IF (IERR.NE.0) RETURN
  88.         IPCHE2 = ipche20
  89. C
  90. C   Verification du lieu support du MCHAML de caracteristiques
  91. C
  92.         CALL QUESUP(IPMODL,IPCHE2,3,1,ISUPCA,iretca)
  93.         IF (ISUPCA.GT.1) RETURN
  94.       ENDIF
  95. C-----------------------------------------------------------------------
  96. C   CAS OU UN CHPOINT EST FOURNI
  97. C   ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS SI BESOIN
  98.       IF (JPMAIL.EQ.0.AND.IPCHM1.EQ.0) THEN
  99.         MCHPOI=IPCHE1
  100.         ltelq=.false.
  101.         DO I=1,IPCHP(/1)
  102.            MSOUPO=IPCHP(I)
  103.            IF (I.GT.1) THEN
  104.               CALL FUSE(IGEOM,IGEOC,IPPT,ltelq)
  105.               IGEOM=IPPT
  106.            ELSE
  107.               IGEOM=IGEOC
  108.            ENDIF
  109.         ENDDO
  110.         IF (IERR.NE.0) RETURN
  111.       ENDIF
  112. C-----------------------------------------------------------------------
  113. C   CAS OU UN CHAMELEM EST FOURNI
  114. C   ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS SI BESOIN
  115.       IF (IPCHM1.NE.0) THEN
  116.         MCHEL2 = IPCHM1
  117.         ltelq=.false.
  118.         DO I=1,MCHEL2.IMACHE(/1)
  119.           IMTMP=MCHEL2.IMACHE(I)
  120.           IF (I.GT.1) THEN
  121.             CALL FUSE(IGEOM,IMTMP,IPPT,ltelq)
  122.             IGEOM=IPPT
  123.           ELSE
  124.             IGEOM=IMTMP
  125.           ENDIF
  126.         ENDDO
  127.         IF (IERR.NE.0) RETURN
  128.       ENDIF
  129.  
  130. C= Cas des modes de calculs en DEFORMATIONS GENERALISEES
  131.       IF (IFOUR.EQ.-3) THEN
  132.         NDPGE=3
  133.       ELSE IF (IFOUR.EQ.11) THEN
  134.         NDPGE=2
  135.       ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ. 9.OR.
  136.      &         IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN
  137.         NDPGE=1
  138.       ELSE
  139.         NDPGE=0
  140.       ENDIF
  141.  
  142. C- Un petit segment toujours utile :
  143.       nbtype = 1
  144.       SEGINI,notype
  145.       notype.TYPE(1) = 'REAL*8  '
  146.       MOTYR8 = notype
  147.  
  148. c- Segments utiles pour accelerer la recherche des elements touchant un noeud.
  149.       SEGACT,mcoord
  150.       nonetn = nbpts+1
  151.       netn = 0
  152.       ietn = 0
  153. C
  154. C     TRAITEMENT DU MODELE
  155. C
  156.       MMODEL = IPMODL
  157.       NSOUS  = mmodel.KMODEL(/1)
  158.  
  159.       IRRT=0
  160.       DO 100 ISOUS = 1, NSOUS
  161. C
  162.         ISOK = 0
  163.         MOCARA = 0
  164.         IVACAR = 0
  165. C
  166. C        TRAITEMENT DU MODELE
  167. C
  168.         IMODEL = mmodel.KMODEL(ISOUS)
  169.         IPMAIL = imodel.IMAMOD
  170.         CONM   = imodel.CONMOD
  171.         MELM   = imodel.NEFMOD
  172.  
  173. C*         write(*,*) ISOUS,'/',NSOUS,' : ',IMODEL,'NEFMOD=',MELM
  174.          if ((melm .eq. 22).OR.(melm .eq. 259)) then
  175. C      ... Ici sous modele de multiplicateur de lagrange on
  176. C          incrémente le compteur et on passe à la zone suivante ...
  177.             IRRT=IRRT+1
  178.             GOTO 100
  179.          endif
  180. C
  181. C        ON RECUPERE LES ELTS DE L ENVELOPPE DU MASSIF APPUYES
  182. C        STRICTEMENT SUR LE CHPOINT DE PRESSIONS OU appartenant au
  183. C        MAILLAGE DONNE
  184. C
  185.          CALL ECROBJ('MAILLAGE',IPMAIL)
  186.          IF (IDIM.EQ.2) THEN
  187.            CALL PRCONT
  188.          ELSE IF (IDIM.EQ.3) THEN
  189.            CALL ENVELO
  190.          ELSE IF (IDIM.EQ.1) THEN
  191.            CALL PREX1D
  192.          ENDIF
  193.          IF (IERR.NE.0) GOTO 9900
  194.          CALL LIROBJ('MAILLAGE',ienvel,1,iretou)
  195.          IF (IERR .NE. 0) GOTO 9900
  196.          CALL ACTOBJ('MAILLAGE',ienvel,1)
  197.  
  198. C     ... si un CHPOINT a été donné, on va chercher la partie de
  199. C         l'enveloppe s'appuyant strictement sur le support du CHPOINT ...
  200.          IF (JPMAIL.EQ.0) THEN
  201.               CALL ECROBJ('MAILLAGE',IGEOM)
  202.               CALL ECRCHA(MOSTRI)
  203.               CALL ECRCHA(MOAPPU)
  204.               CALL ECROBJ('MAILLAGE',ienvel)
  205.               CALL EXTREL(IRR,0,IBNOR)
  206.          ELSE
  207. C      ... sinon, on va chercher l'intersection de l'enveloppe avec
  208. C          le maillage fourni ...
  209.               CALL INTERB(ienvel,jpmail,irr,IPOGEO)
  210.          ENDIF
  211. C      ... Ici on teste si intersection est vide, si OUI on
  212. C          incrémente le compteur et on passe à la zone suivante ...
  213.          IF (irr.gt.0) THEN
  214.               IRRT=IRRT+1
  215.               GOTO 100
  216.          ENDIF
  217.          IF (JPMAIL.EQ.0) THEN
  218.              CALL LIROBJ('MAILLAGE',IPOGEO,1,iret)
  219.              IF (IERR.NE.0) GOTO 9900
  220.              CALL ACTOBJ('MAILLAGE',IPOGEO,1)
  221.          ENDIF
  222.  
  223. C  pour accelerer la recherche, utilisation d'un tableau des elements touchant un noeud.
  224.         if (netn.EQ.0) THEN
  225.           segini,netn
  226.         else
  227.           do i = 1, nonetn
  228.             netn(i) = 0
  229.           enddo
  230.         endif
  231.         IPT1 = IPMAIL
  232.         nbnn1 = ipt1.num(/1)
  233.         nbel1 = ipt1.num(/2)
  234.         do j = 1, nbel1
  235.           do i = 1, nbnn1
  236.             ino = ipt1.num(i,j)
  237.             netn(ino) = netn(ino)+1
  238.           enddo
  239.         enddo
  240.         do i = 2, nonetn
  241.           netn(i) = netn(i) + netn(i-1)
  242.         enddo
  243.         letn = netn(nonetn)
  244.         if (ietn.eq.0) then
  245.           segini,ietn
  246.         else
  247.           if (letn.gt.ietn(/1)) segadj,ietn
  248.           do i = 1, letn
  249.             ietn(i) = 0
  250.           enddo
  251.         endif
  252.         do j = 1, nbel1
  253.           do i = 1, nbnn1
  254.             ino = ipt1.num(i,j)
  255.             ietn(netn(ino)) = j
  256.             netn(ino) = netn(ino)-1
  257.           enddo
  258.         enddo
  259.         ietn1 = ietn
  260.         netn1 = netn
  261.  
  262. C_______________________________________________________________________
  263. C
  264. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  265. C_______________________________________________________________________
  266.         NBROBL = 0
  267.         NBRFAC = 0
  268.         IF (IPCHE2.NE.0 .AND. IFOUR.EQ.-2) THEN
  269. C
  270. C       CREATION DU TABLEAU INFOS
  271. C
  272.           CALL IDENT(IPMAIL,CONM,IPCHE2,0,INFOS,IRTD)
  273.           IF (IRTD.EQ.0) GOTO 9900
  274. C
  275.           NBRFAC=1
  276.           SEGINI,NOMID
  277.           LESFAC(1)='DIM3'
  278.           MOCARA = NOMID
  279. C
  280.           IF (ISUPCA.NE.1) THEN
  281.             CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYR8,0,
  282.      &                                     INFOS,3,IVACAR)
  283.             IF (IERR.NE.0) GOTO 9900
  284.           ENDIF
  285.         ENDIF
  286.         NCARA  = NBROBL
  287.         NCARF  = NBRFAC
  288.         NCARR  = NCARA+NCARF
  289. C
  290. C     ON DETERMINE LA FORMULATION ASSOCIEE A L OBJET
  291. C     GEOMETRIQUE ELEMENTAIRE DE SURFACE
  292. C
  293.         IPT3 = IPOGEO
  294.         NBSOU3 = IPT3.LISOUS(/1)
  295.         IPT2=IPT3
  296. C
  297. C     BOUCLE SUR LES SOUS ZONES DE L ENVELOPPE
  298. C
  299.         DO 110 IB=1,MAX(1,NBSOU3)
  300.  
  301.           MOFORC = 0
  302.           IVAFOR = 0
  303.           IVACA1 = 0
  304.           IPMOD1 = 0
  305.           IPTVPR = 0
  306.           lsupfo = .false.
  307.           ISOK = 0
  308.  
  309.           IF (NBSOU3.NE.0) THEN
  310.             IPT2=IPT3.LISOUS(IB)
  311.           ENDIF
  312.           IPOGEO=IPT2
  313.  
  314.           NBNN  = IPT2.NUM(/1)
  315.           LETYP = IPT2.ITYPEL
  316. C
  317. C     PETIT TEST SUR LE TYPE
  318.           IF (LETYP.EQ.1.AND.IDIM.NE.1) THEN
  319.             CALL ERREUR(16)
  320.             GOTO 9990
  321.           ENDIF
  322.           CALL TYPFAC(MELM,NBNN,MELE)
  323. C          write(*,*) 'TYPFAC --> MELE=',MELE
  324. C  ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR PRESSI POUR
  325. C           LES ELEMENTS DE FORMULATION MELM
  326.           IF (MELE.EQ.0) THEN
  327.             MOTERR(1:8)=NOMTP(MELM)
  328.             CALL ERREUR(193)
  329.             GOTO 9990
  330.           ENDIF
  331. C
  332. C     CAS OU UN CHAMP PAR POINT A ETE FOURNI
  333. C     ON CREE L OBJET MODEL ASSOCIE A LA SURFACE ELEMENTAIRE
  334. C     ON TRANSFORME LE CHPOINT DE PRESSION EN CHELEM ELEMENTAIRE
  335.           N1 = 1
  336.           SEGINI,MMODE1
  337.           NFOR = imodel.FORMOD(/2)
  338.           NMAT = imodel.MATMOD(/2)
  339.           MN3    = imodel.INFMOD(/1)
  340.           NOBMOD = 0
  341.           SEGINI,IMODE1
  342.           imode1.IMAMOD = IPOGEO
  343.           imode1.NEFMOD = MELE
  344.           imode1.CONMOD = imodel.CONMOD
  345.           DO i = 1, NFOR
  346.             imode1.FORMOD(i) = imodel.FORMOD(i)
  347.           ENDDO
  348.           DO i = 1, NMAT
  349.             imode1.MATMOD(i) = imodel.MATMOD(i)
  350.           ENDDO
  351. c*          DO i = 1, MN3
  352. c*            imode1.INFMOD(i) = imodel.INFMOD(i)
  353. c*          ENDDO
  354. c*          lzero = 0
  355. c*          call inomid(imode1,lzero,lzero,lzero,lzero)
  356. c*          call prquoi(imode1)
  357.           mmode1.KMODEL(1) = IMODE1
  358. C
  359. C         INFORMATION SUR L'ELEMENT FINI
  360. C
  361.           CALL PRQUOI(IMODE1)
  362.           IF (IERR.NE.0) GOTO 9990
  363. C
  364.           IPMOD1 = MMODE1
  365. c* Il faut redefinir a chaque fois IPMOD1 pour eviter rappel du
  366. c* preconditionnement dans CHAME1 qui ne cree pas
  367.           IF (JPMAIL.EQ.0.AND.IPCHM1.EQ.0) THEN
  368.             CALL CHAME1(0,IPMOD1,IPCHE1,' ',ICHELP,3)
  369.             IF (IERR.NE.0) GOTO 9990
  370.             MCHEL1=ICHELP
  371.             MCHAM1=MCHEL1.ICHAML(1)
  372.             IPTVPR=MCHAM1.IELVAL(1)
  373.           ENDIF
  374.          iptint=imode1.infele(11)
  375.          MFR   =INFELE(13)
  376. C*OF En DIMEnsion 1, on force FORMULATION MASSIVE pour POI1
  377.          IF (IDIM.EQ.1.AND.MELE.EQ.45) MFR=1
  378.          IPPORE=0
  379.          IF (MFR.EQ.33) IPPORE=NBNN
  380. C Destruction immediate du segment
  381. C_______________________________________________________________________
  382. C
  383. C RECHERCHE DES NOMS DE COMPOSANTES
  384. C_______________________________________________________________________
  385.           MOFORC = imodel.lnomid(2)
  386.           if (moforc.ne.0) then
  387.             lsupfo = .false.
  388.             nomid = moforc
  389.             nfor = lesobl(/2)
  390.             nfac = 0
  391. C            write(*,*) 'nomid deja existant dans IMODEL',IMODEL
  392.           else
  393.             lsupfo = .true.
  394.             CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC)
  395.             write(ioimp,*) 'FPMASS : appel a IDFORC pour creer nomid'
  396.           endif
  397.           NCOMP=NFOR-NDPGE
  398.           NOMID=MOFORC
  399.  
  400. Cbp     on verifie qu on a suffisamment de composantes d'effort
  401.           NFO=0
  402.           IF (MELE.EQ.2  .OR. MELE.EQ.3) NFO=2
  403.           IF (MELE.EQ.31 .OR. MELE.EQ.32 .OR. MELE.EQ.33 .OR.
  404.      &        MELE.EQ.34) NFO=3
  405.           IF (MELE.EQ.45) NFO=1
  406.           IF (NFO.ne.0) THEN
  407.             IF (NCOMP.lt.NFO) GOTO 444
  408.             DO ICOMP=1,NFO
  409.               IF(LESOBL(ICOMP)(1:1).NE.'F') GOTO 444
  410.             ENDDO
  411.             GOTO 440
  412.           ENDIF
  413. C         -erreur
  414.  444      CONTINUE
  415.           write(IOIMP,*) 'on attend un MODELE avec au moins',NFO,
  416.      &                   'composantes de FORCES !'
  417.           write(IOIMP,*) 'Ici, on a :',(LESOBL(i),i=1,NCOMP)
  418.           MOTERR(1:16)='MECANIQUE, ...  '
  419.           CALL ERREUR(719)
  420.           GOTO 9990
  421. C         -pas d'erreur
  422.  440      CONTINUE
  423. C
  424. C        CAS OU UN CHAMP PAR ELEMENT A ETE FOURNI
  425. C        -> Verification de son support
  426. C
  427.          IF (IPCHM1.NE.0) THEN
  428.            CALL QUESUP(0,IPCHM1,0,0,ISUP1,ISUP2)
  429.            MCHEL2=IPCHM1
  430.            MCHAM2 = MCHEL2.ICHAML(1)
  431.            IF (ISUP2.NE.3) THEN
  432.              IF (ISUP2.EQ.4) THEN
  433.                CALL ERREUR(609)
  434.                GOTO 9990
  435.              ELSE IF (ISUP2.EQ.5) THEN
  436.                IPTVPR = MCHAM2.IELVAL(1)
  437.              ELSE IF (ISUP2.EQ.1.OR.ISUP2.EQ.2) THEN
  438.                IVPRES = MCHAM2.IELVAL(1)
  439.                CALL VALMEL(IVPRES,IPTINT,IPTVPR)
  440.              ENDIF
  441.            ELSE
  442.              IPTVPR = MCHAM2.IELVAL(1)
  443.            ENDIF
  444.          ENDIF
  445. C
  446. C        INITIALISATION DU CHELEM ELEMENTAIRE DES FORCES NODALES
  447. C
  448.          N1=1
  449.          L1=6
  450.          N3=6
  451.          SEGINI MCHELM
  452.          TITCHE='FORCES'
  453.          IFOCHE=IFOUR
  454.          IPCHEL=MCHELM
  455. C
  456.          IMACHE(1)=IPOGEO
  457.          INFCHE(1,1)=0
  458.          INFCHE(1,2)=0
  459.          INFCHE(1,3)=NHRM
  460.          INFCHE(1,4)=IPTINT
  461.          INFCHE(1,5)=0
  462.          INFCHE(1,6)=3
  463. C
  464. C        RECHERCHE DE LA TAILLE DES MELVALS
  465. C
  466.          MELEME=IPOGEO
  467.          N1PTEL=NUM(/1)
  468.          N1EL  =NUM(/2)
  469.          N2PTEL=0
  470.          N2EL  =0
  471. C
  472. C        CREATION DU MCHAML DE LA SOUS ZONE
  473. C
  474.          N2=NCOMP
  475.          SEGINI MCHAML
  476.          ICHAML(1)=MCHAML
  477.          NSR=1
  478.          NCOSOR=NCOMP
  479.          SEGINI MPTVAL
  480.          IVAFOR=MPTVAL
  481.          nomid = MOFORC
  482.  
  483.          DO ICOMP=1,NCOMP
  484.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  485.             TYPCHE(ICOMP)='REAL*8'
  486.             SEGINI MELVAL
  487.             IELVAL(ICOMP)=MELVAL
  488.             IVAL(ICOMP)=MELVAL
  489.          ENDDO
  490. C____________________________________________________________________
  491. C
  492. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  493. C____________________________________________________________________
  494.           IF (MOCARA.NE.0) THEN
  495.             IVACA1 = IVACAR
  496.             IF (ISUPCA.EQ.1) THEN
  497.               CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYR8,0,
  498.      &                                       INFOS,3,IVACA1)
  499.               IF (IERR.NE.0) GOTO 9900
  500.               CALL VALCHE(IVACA1,NCARR,IPTINT,IPPORE,MOCARA,MELE)
  501.               IF (IERR.NE.0) THEN
  502.                 ISUPCA = 0
  503.                 GOTO 9990
  504.               ENDIF
  505.             ENDIF
  506.           ENDIF
  507. C
  508. C        CALCUL DES FORCES NODALES EQUIVALENTES
  509. C        DEBRANCHEMENT SUIVANT LE TYPE DES ELEMENTS
  510. C
  511. C           CAS DES ELEMENTS MASSIFS BIDIMENSIONNELS
  512. C           FACES ASSOCIEES SEG2 OU SEG3
  513. C
  514.          IF (MELE.EQ.2.OR.MELE.EQ.3) THEN
  515.             CALL FPMA2D(IPTVPR,IPOGEO,ipt1,IPTINT,IVAFOR,IVACA1,XP
  516.      +                   ,netn1,ietn1)
  517. C
  518. C           CAS DES ELEMENTS MASSIFS TRIDIMENSIONNELS
  519. C           FACES ASSOCIEES FAC3,FAC4,FAC6 OU FAC8
  520. C
  521.          ELSE IF(MELE.EQ.31.OR.MELE.EQ.32.OR.MELE.EQ.33.
  522.      +                                   OR.MELE.EQ.34)THEN
  523.             CALL FPMA3D(IPTVPR,IPOGEO,ipt1,IPTINT,IVAFOR,XP
  524.      +                  ,netn1,ietn1)
  525. C
  526. C= Cas des elements MASSIFs UNIDIMENSIONNELs (1D)
  527. C= Face associee : POI1 (numero 45)
  528.          ELSE IF (MELE.EQ.45) THEN
  529.             CALL FPMA1D(IPTVPR,IPOGEO,ipt1,IPTINT,IVAFOR,XP
  530.      +                  ,netn1,ietn1)
  531. C
  532. C           ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE
  533. C
  534.          ELSE
  535.             MOTERR(1:4)=NOMTP(MELE)
  536.             MOTERR(5:12)='FPMASS'
  537.             CALL ERREUR (86)
  538.             GOTO 9990
  539.          ENDIF
  540. C
  541. C        ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN
  542. C        ET ON ADDITIONNE LES CHAM/POIN ELEMENTAIRES
  543. C
  544.          CALL CHAMPO(IPCHEL,0,IPCHPO,IPPT)
  545.          CALL DTCHAM(IPCHEL)
  546.          IF (IPPT.EQ.0) THEN
  547.             GOTO 9990
  548.          ENDIF
  549.          IF ((ISOUS-IRRT).GT.1.OR.IB.GT.1) THEN
  550.             CALL ADCHPO(IPCHPO,IPTFP,IPPT,1D0,1D0)
  551. C            CALL ECRCHA(MOGEOM)
  552.             CALL DTCHPO(IPCHPO)
  553. C            CALL ECRCHA(MOGEOM)
  554.             CALL DTCHPO(IPTFP)
  555.             IF (IPPT.EQ.0) GOTO 9990
  556.             IPTFP=IPPT
  557.          ELSE
  558.             IPTFP=IPCHPO
  559.          ENDIF
  560.  
  561.           ISOK = 1
  562.  
  563.  9990     CONTINUE
  564.           mptval = IVAFOR
  565.           IF (IVAFOR.NE.0) SEGSUP,mptval
  566.           nomid = MOFORC
  567.           if (MOFORC.NE.0 .and. lsupfo) SEGSUP,nomid
  568.           IF (IVACA1.NE.0 .AND. ISUPCA.EQ.1) THEN
  569.             CALL DTMVAL(IVACA1,3)
  570.           ENDIF
  571.           IF (IPMOD1.NE.0) CALL DTMODL(IPMOD1)
  572.           IF (ISOK.EQ.0) GOTO 9900
  573.  
  574.  110    CONTINUE
  575. C- Fin de la boucle sur les sous zones de l'enveloppe
  576.  
  577.  9900   CONTINUE
  578.         nomid = MOCARA
  579.         IF (MOCARA.NE.0) SEGSUP,nomid
  580.         IF (IVACAR.NE.0) CALL DTMVAL(IVACAR,1)
  581.         IF (ISOK.EQ.0) GOTO 9000
  582.  
  583.  100  CONTINUE
  584.  
  585.       IF (IRRT.EQ.NSOUS) THEN
  586.          IRET = 0
  587.          CALL ERREUR(395)
  588.       ELSE
  589.          IRET = 1
  590.       ENDIF
  591.  
  592.  9000 CONTINUE
  593.       notype = MOTYR8
  594.       SEGSUP,notype
  595.       if (netn.ne.0) SEGSUP,netn
  596.       if (ietn.ne.0) SEGSUP,ietn
  597.  
  598.       RETURN
  599.       END
  600.  
  601.  
  602.  
  603.  

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