Télécharger la plaquette Cast3M


fr en

Télécharger epsi3.eso

Retour à la liste

Numérotation des lignes : 

epsi3

  1. C EPSI3     SOURCE    CB215821  24/04/12    21:15:47     11897          
  2.       SUBROUTINE EPSI3(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVECT,
  3.      &     IVAMAT,LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,
  4.      &     NCARR,NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,IVAEPS,
  5.      &     IPMIN1,UZDPG,RYDPG,RXDPG,NPINT,IIPDPG)
  6. C---------------------------------------------------------------------*
  7. C                                                                     *
  8. C           CALCUL DES DEFORMATIONS                                   *
  9. C                                                                     *
  10. C  poutres,tuyaux,coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D     *
  11. C                                                                     *
  12. C---------------------------------------------------------------------*
  13. C                                                                     *
  14. C   ENTREES :                                                         *
  15. C   ________                                                          *
  16. C                                                                     *
  17. C        IPMAIL   Pointeur sur un segment  MELEME                     *
  18. C        IVADEP   Pointeur sur le chamelem de deplacements            *
  19. C        IVACAR   Pointeur sur les chamelems de caracteristiques      *
  20. C        NELMAT   Taille maxi des melval du materiau (No d'element)   *
  21. C        NBGMAT   Taille maxi des melval du materiau (pt de gauss)    *
  22. C        IVAMAT   Pointeur sur un segment MPTVAL pour le materiau ou  *
  23. C        LHOOK    Dimension de la matrice de Hooke                    *
  24. C        IMAT     (2 il y a une matrice de HOOKE,1 non  )             *
  25. C        MATE     Numero du materiau                                  *
  26. C        CMATE    Nom du materiau                                     *
  27. C        NMATT    Nombre de composante de materiau (IMAT=1)           *
  28. C        NSTRS    Nombre de composante de contraintes/deformations    *
  29. C                 pour une matrice de hooke                           *
  30. C        MFR      Numero de formulation de l'element fini             *
  31. C        IPMINT   Pointeur sur un segment MINTE                       *
  32. C        IPMIN1   Pointeur sur un segment MINTE                       *
  33. C        NDEP     Nombre de composantes de deplacements               *
  34. C        NBPGAU   Nombre de point d'integration pour la rigidite      *
  35. C        NBPTEL   Nombre de points par element                        *
  36. C        MELE     Numero de l'element fini                            *
  37. C        LRE      Nombre de ddl dans la matrice de rigidite           *
  38. C        LW       Dimension du tableau de travail de l'element        *
  39. C        IRESP2   Flag pour indiquer si on veut les contraintes       *
  40. C                  de Piola-Kirchhoff                                 *
  41. C                 dans le cas des elements de coque integres          *
  42. C                                                                     *
  43. C   SORTIES :                                                         *
  44. C   ________                                                          *
  45. C                                                                     *
  46. C        IVAEPS   pointeur sur un segment MPTVAL contenant les        *
  47. C                 les melvals de déformations
  48. C                                                                     *
  49. C---------------------------------------------------------------------*
  50.       IMPLICIT INTEGER(I-N)
  51.       IMPLICIT REAL*8(A-H,O-Z)
  52. C
  53.  
  54. -INC PPARAM
  55. -INC CCOPTIO
  56. -INC CCHAMP
  57. -INC SMCHAML
  58. -INC SMCHPOI
  59. -INC SMELEME
  60. -INC SMCOORD
  61. -INC SMMODEL
  62. -INC SMINTE
  63. -INC SMLREEL
  64. C
  65.       SEGMENT WRK1
  66.        REAL*8 DDHOOK(NSTRS,NSTRS) ,XDDL(LRE) ,XSTRS(NSTRS)
  67.        REAL*8 XE(3,NBBB),DDHOMU(NSTRS,NSTRS)
  68.       ENDSEGMENT
  69. C
  70.       SEGMENT WRK2
  71.        REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  72.       ENDSEGMENT
  73. C
  74.       SEGMENT WRK3
  75.        REAL*8 WORK(LW)
  76.       ENDSEGMENT
  77. C
  78.       SEGMENT WRK4
  79.        REAL*8 BPSS(3,3) ,XEL(3,NBBB) ,XDDLOC(LRE)
  80.       ENDSEGMENT
  81. C
  82.       SEGMENT WRK5
  83.        REAL*8   XSTRS1(NSTRS1)
  84.       ENDSEGMENT
  85.       segment wrk7
  86.        real*8 out(30),propel(45),wk7d(1),wk7rel(1)
  87.       endsegment
  88. C
  89.       SEGMENT NOTYPE
  90.         CHARACTER*16 TYPE(NBTYPE)
  91.       ENDSEGMENT
  92. C
  93.       SEGMENT MPTVAL
  94.        INTEGER IPOS(NS),NSOF(NS)
  95.        INTEGER IVAL(NCOSOU)
  96.        CHARACTER*16 TYVAL(NCOSOU)
  97.       ENDSEGMENT
  98. C
  99.       SEGMENT,MVELCH
  100.          REAL*8 VALMAT(NV1)
  101.       ENDSEGMENT
  102. C
  103.       CHARACTER*8 CMATE
  104.       CHARACTER*(NCONCH) CONM
  105.       PARAMETER (NINF=3)
  106.       INTEGER INFOS(NINF)
  107.       dimension rel(18,18)
  108. C
  109. C  initialisation pour l'optimiseur
  110.       MELVAL=0
  111.  
  112. C   INITIALISATION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  113. C   DE LA SECTION EN DEFO PLANE GENERALISEE
  114.       IF (IIPDPG.GT.0) THEN
  115. C <- test equivalent ici a IFOUR.EQ.-3
  116. C        SEGACT MCOORD
  117.         IREF=(IIPDPG-1)*(IDIM+1)
  118.         XDPGE=XCOOR(IREF+1)
  119.         YDPGE=XCOOR(IREF+2)
  120.       ELSE
  121.         XDPGE=0.D0
  122.         YDPGE=0.D0
  123.       ENDIF
  124. C
  125.       MELEME=IPMAIL
  126.       NBNN=NUM(/1)
  127.       NBELEM=NUM(/2)
  128. C
  129.       NHRM=NIFOUR
  130. C
  131.       MINTE=IPMINT
  132.       NBBB=NBNN
  133. C_______________________________________________________________________
  134. C
  135. C     NUMERO DES ETIQUETTES      :
  136. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  137. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  138. C     5  CONTINUE
  139. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  140. C     44 CONTINUE
  141. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  142. C_______________________________________________________________________
  143. C
  144.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  145.      1      99,99,99,99,99,99,27,28,27,99,99,99,99,99,99,99,99,99,99,99,
  146.      2      41,27,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  147.      3      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  148.      4      99,99,99,27,85,86,87,88,99,99,99,99,93,99,99,99,99),MELE
  149. C
  150.       GOTO(168,169,170,171,172),MELE-167
  151.       if(mele.eq.260) go to 260
  152. C
  153.       GOTO 99
  154. C_______________________________________________________________________
  155. C ELEMENT SHB8
  156. C_______________________________________________________________________
  157.   260 continue
  158.       SEGINI WRK1,WRK7
  159.        DO  3260 IB=1,NBELEM
  160. C
  161. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  162. C
  163.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  164. C
  165. C     ON CHERCHE LES DEPLACEMENTS
  166. C
  167.          IE=1
  168.          MPTVAL=IVADEP
  169.          DO      IGAU=1,NBNN
  170.             DO      ICOMP=1,NDEP
  171.                MELVAL=IVAL(ICOMP)
  172.                IGMN=MIN(IGAU,VELCHE(/1))
  173.                IBMN=MIN(IB  ,VELCHE(/2))
  174.                XDDL(IE)=VELCHE(IGMN,IBMN)
  175.                IE=IE+1
  176.             enddo    
  177.          enddo    
  178.         propel(1)=1
  179.         propel(2)=0.3
  180.         propel(3)=ireps2
  181.         call shb8(11,xe,wk7d,propel,xddl,wk7rel,out)
  182.  
  183. C  REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  184. C
  185.          MPTVAL=IVAEPS
  186.          IE=1
  187.          DO      IGAU=1,NBPTEL
  188.          DO      ICOMP=1,NSTRS
  189.             MELVAL=IVAL(ICOMP)
  190.             IBMN=MIN(IB  ,VELCHE(/2))
  191.             VELCHE(IGAU,IBMN)=out(IE)
  192.             IE=IE+1
  193.          enddo      
  194.          enddo      
  195. C
  196.  3260 CONTINUE
  197.       SEGSUP WRK1,WRK7
  198.       GOTO 510
  199. C
  200. C_______________________________________________________________________
  201. C
  202. C     ELEMENTS  COQ3   POUTRE ET TUYAU ET POUTRE TIMOSCHENKO
  203. C_______________________________________________________________________
  204. C
  205.   27  CONTINUE
  206.       SEGINI WRK1,WRK3
  207. C
  208. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  209. C
  210.       DO  3027 IB=1,NBELEM
  211. C
  212. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  213. C
  214.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  215. C
  216. C     ON CHERCHE LES DEPLACEMENTS
  217. C
  218.          MPTVAL=IVADEP
  219.          IE=1
  220.          DO      IGAU=1,NBNN
  221.             DO      ICOMP=1,NDEP
  222.                MELVAL=IVAL(ICOMP)
  223.                IGMN=MIN(IGAU,VELCHE(/1))
  224.                IBMN=MIN(IB  ,VELCHE(/2))
  225.                XDDL(IE)=VELCHE(IGMN,IBMN)
  226.                IE=IE+1
  227.             enddo    
  228.          enddo    
  229.          IF(MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.84) GO TO 5029
  230. C     CAS DES COQ3
  231. C
  232. C     ON MET LA MATRICE DE HOOKE A L IDENTITE
  233. C
  234.          CALL HOOKID(DDHOOK,NSTRS)
  235.          CALL COQ3ST(XE,XDDL,XSTRS,DDHOOK)
  236. C
  237.          IF(IREPS2.EQ.1)
  238.      1     CALL DBCO32(XE,DDHOOK,XDDL,WORK,XSTRS)
  239. C
  240.          MPTVAL=IVAEPS
  241.          DO 6027 ICOMP=1,NSTRS
  242.             MELVAL=IVAL(ICOMP)
  243.             IBMN=MIN(IB,VELCHE(/2))
  244.             VELCHE(1,IBMN)=XSTRS(ICOMP)
  245.  6027    CONTINUE
  246. C
  247.          GOTO 3027
  248. C
  249. C        CAS DES POUTRES ET DES TUYAUX
  250. C  ON STOCKE DES CARACTERISTIQUES GEOMETRIQUES DANS WORK
  251. C
  252.  5029    CONTINUE
  253. C
  254. C  pour les poutres et tuyaux on cherche le module d'young et nu si
  255. C  section reduite
  256.        If( mele.eq.29.or.mele.eq.42) then
  257.          mptval = ivamat
  258.          segact mptval
  259.          do itc=1,2
  260.           melval=ival(itc)
  261.           IGMN=MIN(IGAU,VELCHE(/1))
  262.           ibmn= MIN(IB,VELCHE(/2))
  263.           xaa=VELCHE(IGMN,IBMN)
  264.           if(itc.eq.1) then
  265.             youtc=xaa
  266.           else
  267.             xnutc=xaa
  268.           endif
  269.          enddo
  270.        endif
  271.  
  272. C
  273. C  ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB
  274. C
  275.          CALL ZERO(WORK,NCARR,1)
  276.          DO 4029 IGAU=1,NBNN
  277.          MPTVAL=IVACAR
  278.          DO 6029 IC=1,NCARR
  279.             IF(IVAL(IC).NE.0) THEN
  280.                MELVAL=IVAL(IC)
  281.                IBMN=MIN(IB,VELCHE(/2))
  282.                IGMN=MIN(IGAU,VELCHE(/1))
  283.                IF(IGMN.GT.0.AND.IBMN.GT.0) THEN
  284.                   WORK(IC)=WORK(IC)+VELCHE(IGMN,IBMN)
  285.                ELSE
  286.                   WORK(IC)=0.
  287.                ENDIF
  288.             ELSE
  289.                WORK(IC)=0.
  290.             ENDIF
  291.           IF (IGAU.EQ.NBNN) WORK(IC)=WORK(IC)/NBNN
  292.  6029    CONTINUE
  293.  4029    CONTINUE
  294. C
  295. C CAS OU ON A LU LE MOT VECTEUR
  296. C
  297.          IF (IFOUR.EQ.2) THEN
  298. C
  299. C
  300.          ENDIF
  301. C
  302. C  CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE
  303. C                   EQUIVALENTE
  304.          IF(MELE.EQ.42) THEN
  305.            CISA=WORK(4)
  306.            VX=WORK(5)
  307.            VY=WORK(6)
  308.            VZ=WORK(7)
  309.            CALL TUYCAR(WORK,CISA,VX,VY,VZ,KERRE,2)
  310.          ENDIF
  311. C
  312. C  ON CALCULE LES DEFORMATIONS
  313. C
  314.          IF(MELE.EQ.84) THEN
  315. C
  316.           IF(CMATE.EQ.'SECTION') THEN
  317.             IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  318.               CALL TIMEP2(XE,XDDL,WORK(12),WORK(25),IREPS2)
  319.             ELSE
  320.               CALL TIMEPS(XE,XDDL,WORK(1),WORK(12),WORK(25),IREPS2)
  321.             ENDIF
  322.           ELSE
  323. C
  324.             IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  325.               CALL TIMEP2(XE,XDDL,WORK(12),WORK(25),IREPS2)
  326. C
  327.             ELSE
  328.               CALL TIMEPS(XE,XDDL,WORK(7),WORK(12),WORK(25),IREPS2)
  329.             ENDIF
  330.           ENDIF
  331.          ELSE
  332. C
  333.             IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  334.               CALL POUEP2(XE,XDDL,WORK,WORK(12),WORK(25),IREPS2
  335.      $         ,youtc,xnutc)
  336.             ELSE
  337. C
  338.               CALL POUEPS(XE,XDDL,WORK,WORK(12),WORK(25),IREPS2
  339.      $        , youtc,xnutc)
  340.             ENDIF
  341.          ENDIF
  342. C
  343. C  REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  344. C
  345.            ID=12
  346. C
  347.          MPTVAL=IVAEPS
  348.          DO      IGAU=1,NBPTEL
  349.          DO      ICOMP=1,NSTRS
  350.            MELVAL=IVAL(ICOMP)
  351.             IBMN=MIN(IB  ,VELCHE(/2))
  352.             VELCHE(IGAU,IBMN)=WORK(ID)
  353.             ID=ID+1
  354.          enddo    
  355.          enddo    
  356. C
  357.  3027 CONTINUE
  358.       SEGSUP WRK1,WRK3
  359.       GOTO 510
  360. C_______________________________________________________________________
  361. C
  362. C     ELEMENT DKT
  363. C_______________________________________________________________________
  364. C
  365.   28  CONTINUE
  366.       NBNO=NBNN
  367.       SEGINI WRK1,WRK2,WRK4
  368.       IF(NPINT.NE.0)THEN
  369.         NSTRS1=6
  370.         SEGINI WRK5
  371.       ENDIF
  372.       DO 3028  IB=1,NBELEM
  373. C
  374. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  375. C
  376.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  377. C
  378. C     ON CHERCHE LES DEPLACEMENTS
  379. C
  380.          IE=1
  381.          DO      IGAU=1,NBNN
  382.             MPTVAL=IVADEP
  383.             DO      ICOMP=1,NDEP
  384.                MELVAL=IVAL(ICOMP)
  385.                IGMN=MIN(IGAU,VELCHE(/1))
  386.                IBMN=MIN(IB  ,VELCHE(/2))
  387.                XDDL(IE)=VELCHE(IGMN,IBMN)
  388.                IE=IE+1
  389.             enddo     
  390.          enddo     
  391. C
  392. C     ON CHERCHE L EPAISSEUR ET L EXCENTREMENT
  393. C
  394.             MPTVAL=IVACAR
  395.             IF (IVAL(1).NE.0) THEN
  396.             MELVAL=IVAL(1)
  397.                IBMN=MIN(IB,VELCHE(/2))
  398.                EPAIST=VELCHE(1,IBMN)
  399.             ELSE
  400.                EPAIST=0.D0
  401.             ENDIF
  402. C
  403.             IF (IVAL(2).NE.0) THEN
  404.             MELVAL=IVAL(2)
  405.                IBMN=MIN(IB,VELCHE(/2))
  406.                EXCEN=VELCHE(1,IBMN)
  407.             ELSE
  408.                EXCEN=0.D0
  409.             ENDIF
  410. C
  411.          CALL VPAST(XE,BPSS)
  412. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  413.          CALL VCORLC (XE,XEL,BPSS)
  414.          CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  415. C
  416.       IF(NPINT.EQ.0)THEN
  417. C
  418. C     COQUE GLOBAL
  419. C
  420. C     BOUCLE SUR LES POINTS DE GAUSS
  421. C
  422.          DO 5028  IGAU=1,NBPTEL
  423.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  424.      &           MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  425.      &          SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  426. C
  427. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  428. C
  429.           IF (EXCEN.NE.0.) THEN
  430.             DO      IJL=1,3
  431.                DO      IJC=1,LRE
  432.                   BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  433.                enddo    
  434.             enddo    
  435.           ENDIF
  436. C
  437.             CALL BST(BGENE,XDDLOC,LRE,NSTRS,XSTRS)
  438. C
  439. C     CALCUL DES EPS 2
  440. C
  441.             IF(IREPS2.EQ.1)
  442.      1       CALL BDKT2(XEL,XDDLOC,IGAU,BGENE,XSTRS)
  443. C
  444. C     RMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  445. C
  446.             MPTVAL=IVAEPS
  447.             DO 9028 ICOMP=1,NSTRS
  448.                MELVAL=IVAL(ICOMP)
  449.                IGMN=MIN(IGAU,VELCHE(/1))
  450.                IBMN=MIN(IB  ,VELCHE(/2))
  451.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  452.  9028       CONTINUE
  453.  5028    CONTINUE
  454. C
  455.       ELSE
  456. C
  457. C    COQUE INTEGREE
  458. C
  459.       NBPGA1=NBPGAU/NPINT
  460. C
  461. C     BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE
  462. C
  463.       DO 5001  IGAU=1,NBPGA1
  464.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  465.      &          MELE,MFR,NBNO,LRE,IFOUR,NSTRS1,0,1.D0,XEL,
  466.      &          SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  467. C
  468. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  469. C
  470.           IF (EXCEN.NE.0.) THEN
  471.       DO      IJL=1,3
  472.       DO      IJC=1,LRE
  473.         BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  474.       enddo    
  475.       enddo    
  476.           ENDIF
  477. C
  478. C   BOUCLE SUR LES NAPPES
  479. C
  480.       DO 5002 INAP=1,NPINT
  481.       IGAU1=(INAP-1)*NBPGA1+IGAU
  482. C
  483.       CALL BST(BGENE,XDDLOC,LRE,NSTRS1,XSTRS1)
  484. C
  485. C     CALCUL DES EPS 2
  486. C
  487.       IF(IREPS2.EQ.1)
  488.      1  CALL BDKT2(XEL,XDDLOC,IGAU,BGENE,XSTRS1)
  489. C
  490.       ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  491.       XSTRS(1)=XSTRS1(1)+ZZZ*XSTRS1(4)
  492.       XSTRS(2)=XSTRS1(2)+ZZZ*XSTRS1(5)
  493.       XSTRS(3)=0.D0
  494.       XSTRS(4)=XSTRS1(3)+ZZZ*XSTRS1(6)
  495. C
  496. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  497. C
  498.       MPTVAL=IVAEPS
  499.       DO 9001 ICOMP=1,NSTRS
  500.         MELVAL=IVAL(ICOMP)
  501.         IBMN=MIN(IB  ,VELCHE(/2))
  502.         VELCHE(IGAU1,IBMN)=XSTRS(ICOMP)
  503.  9001 CONTINUE
  504. C
  505. C FIN DE BOUCLE SUR LES NAPPES DE POINTS
  506.  5002 CONTINUE
  507. C FIN DE BOUCLE SUR  LES POINTS DANS CHAQUE NAPPE
  508.  5001 CONTINUE
  509. C FIN DE BOUCLE SUR LES POINTS D'INTEGRATION
  510.       ENDIF
  511. C FIN DE BOUCLE SUR LES ELEMENTS
  512.  3028 CONTINUE
  513.       SEGSUP WRK1,WRK2,WRK4
  514.       IF(NPINT.NE.0) SEGSUP WRK5
  515. C
  516.       GOTO 510
  517. C_______________________________________________________________________
  518. C
  519. C     ELEMENTS COQ8  ET COQ6
  520. C_______________________________________________________________________
  521. C
  522.   41  CONTINUE
  523.       SEGINI WRK1,WRK3
  524.       MINTE1=IPMIN1
  525.       SEGACT MINTE1
  526.       NBPGA1=MINTE1.SHPTOT(/3)
  527. C      NBN1  =MINTE1.SHPTOT(/2)
  528. C
  529. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  530. C
  531.       DO  3041 IB=1,NBELEM
  532. C
  533. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  534. C
  535.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  536. C
  537. C     ON CHERCHE LES DEPLACEMENTS
  538. C
  539.          IE=1
  540.          DO      IGAU=1,NBNN
  541.             MPTVAL=IVADEP
  542.             DO      ICOMP=1,NDEP
  543.                MELVAL=IVAL(ICOMP)
  544.                IGMN=MIN(IGAU,VELCHE(/1))
  545.                IBMN=MIN(IB  ,VELCHE(/2))
  546.                XDDL(IE)=VELCHE(IGMN,IBMN)
  547.                IE=IE+1
  548.             enddo    
  549.          enddo    
  550. C
  551. C     ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS,
  552. C     ON LES MOYENNE SUR L'ELEMENT.
  553. C
  554.          MPTVAL=IVACAR
  555.          MELVAL=IVAL(1)
  556.          EPAIST=0.D0
  557.          IF (MELVAL.NE.0) THEN
  558.          DO  IGAU=1,NBPGAU
  559.                IGMN=MIN(IGAU,VELCHE(/1))
  560.                IBMN=MIN(IB  ,VELCHE(/2))
  561.                EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  562.          ENDDO
  563.          EPAIST=EPAIST/NBPGAU
  564.          ENDIF
  565. C
  566.          MELVAL=IVAL(2)
  567.          EXCEN=0.D0
  568.          IF (MELVAL.NE.0) THEN
  569.          DO  IGAU=1,NBPGAU
  570.                IGMN=MIN(IGAU,VELCHE(/1))
  571.                IBMN=MIN(IB  ,VELCHE(/2))
  572.                EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  573.          ENDDO
  574.          EXCEN=EXCEN/NBPGAU
  575.          ENDIF
  576. C
  577. C     ON CALCULE LES DEFORMATIONS
  578. C
  579.          CALL COQ8EP(XE,NBNN,NBPGAU,LRE,NSTRS,EPAIST,EXCEN,
  580.      1      DZEGAU,SHPTOT,MINTE1.SHPTOT,XDDL,WORK,IRR)
  581. C
  582. C     ON REMPLIT LES DEFORMATIONS
  583. C
  584.          MPTVAL=IVAEPS
  585.          IE=1
  586.          DO      IGAU=1,NBPGAU
  587.             DO      ICOMP=1,NSTRS
  588.                MELVAL=IVAL(ICOMP)
  589.                IBMN=MIN(IB  ,VELCHE(/2))
  590.                VELCHE(IGAU,IBMN)=WORK(IE)
  591.                IE=IE+1
  592.             enddo     
  593.          enddo     
  594. C
  595.  3041 CONTINUE
  596.       SEGSUP WRK1,WRK3
  597.       GOTO 510
  598. C_______________________________________________________________________
  599. C
  600. C     ELEMENT COQ2
  601. C_______________________________________________________________________
  602. C
  603.    44 CONTINUE
  604.       NBNO=NBNN
  605.       SEGINI WRK1,WRK2
  606. C
  607.       NDDD=NDEP
  608.       IF (IFOUR.EQ.-3) NDDD=NDEP-3
  609.       DO 3044 IB=1,NBELEM
  610. C
  611. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  612. C
  613.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  614. C
  615. C     ON CHERCHE LES DEPLACEMENTS
  616. C
  617.          MPTVAL=IVADEP
  618.          IE=1
  619.          DO      IGAU=1,NBNN
  620.             DO      ICOMP=1,NDDD
  621.                MELVAL=IVAL(ICOMP)
  622.                IGMN=MIN(IGAU,VELCHE(/1))
  623.                IBMN=MIN(IB  ,VELCHE(/2))
  624.                XDDL(IE)=VELCHE(IGMN,IBMN)
  625.                IE=IE+1
  626.             enddo     
  627.          enddo     
  628.          IF (IFOUR.EQ.-3) THEN
  629.                XDDL(IE)=UZDPG
  630.                XDDL(IE+1)=RYDPG
  631.                XDDL(IE+2)=RXDPG
  632.          ENDIF
  633. C
  634. C     BOUCLE SUR LES POINTS DE GAUSS
  635. C
  636.             DO 4044 IGAU=1,NBPGAU
  637.                MPTVAL=IVACAR
  638.                IF (IVAL(2).NE.0) THEN
  639.                   MELVAL=IVAL(2)
  640.                   IBMN=MIN(IB,VELCHE(/2))
  641.                   EXCEN=VELCHE(1,IBMN)
  642.                 ELSE
  643.                   EXCEN=0.D0
  644.                 ENDIF
  645. C     APPEL A BCOQ2
  646. C
  647.       CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  648.      .           EXCEN,1.D0,IRR,XDPGE,YDPGE)
  649. C
  650. C     GESTION D'ERREUR
  651. C
  652.             IF (IRR.EQ.1) THEN
  653.               INTERR(1)=IB
  654.               CALL ERREUR(255)
  655.               GOTO 9944
  656.             ELSE IF(IRR.EQ.2) THEN
  657.               INTERR(1)=IB
  658.               CALL ERREUR(256)
  659.               GOTO 9944
  660.             ENDIF
  661. C
  662.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  663.  
  664.             IF(IREPS2.EQ.1)
  665.      +call b2coq2(xstrs,nstrs,xddl,nbnn*ndep,xe,nbnn,QSIGAU,POIGAU,igau)
  666. C
  667. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  668. C
  669.             MPTVAL=IVAEPS
  670.             DO 9044 ICOMP=1,NSTRS
  671.                MELVAL=IVAL(ICOMP)
  672.                IGMN=MIN(IGAU,VELCHE(/1))
  673.                IBMN=MIN(IB  ,VELCHE(/2))
  674.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  675.  9044       CONTINUE
  676.  4044    CONTINUE
  677.  3044 CONTINUE
  678. C
  679.  9944 CONTINUE
  680.       SEGSUP WRK1,WRK2
  681.       GOTO 510
  682. C_______________________________________________________________________
  683. C
  684. C     ELEMENT COQ4
  685. C_______________________________________________________________________
  686. C
  687.    49 CONTINUE
  688.       NBNO=NBNN
  689.       SEGINI WRK1,WRK2,WRK4
  690. C
  691.       DO 3049 IB=1,NBELEM
  692. C
  693. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  694. C
  695.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  696. C
  697.          CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  698. C        IERT=1 NODI  TROPPO VICINI
  699.          IF (IERT.EQ.1) THEN
  700.            INTERR(1)=IB
  701.            CALL ERREUR(323)
  702.            GOTO 9949
  703.          ELSE IF(IERT.EQ.3) THEN
  704.             IERT = 0
  705.             NOPLAN = 1
  706.          ELSE
  707.             NOPLAN = 0
  708.          END IF
  709. C
  710. C     ON CHERCHE LES DEPLACEMENTS
  711. C
  712.          IE=1
  713.          DO      IGAU=1,NBNN
  714.             MPTVAL=IVADEP
  715.             DO      ICOMP=1,NDEP
  716.                MELVAL=IVAL(ICOMP)
  717.                IGMN=MIN(IGAU,VELCHE(/1))
  718.                IBMN=MIN(IB  ,VELCHE(/2))
  719.                XDDL(IE)=VELCHE(IGMN,IBMN)
  720.                IE=IE+1
  721.             enddo     
  722.          enddo     
  723.          CALL MATVEC(XDDL,XDDLOC,BPSS,8)
  724. C
  725. C     BOUCLE SUR LES POINTS DE GAUSS
  726. C
  727.          MPTVAL=IVACAR
  728.          MELVAL=IVAL(1)
  729.          IF (MELVAL.NE.0) THEN
  730.             IBMN=MIN(IB,VELCHE(/2))
  731.             EPAIST=VELCHE(1,IBMN)
  732.          ELSE
  733.             EPAIST=0.D0
  734.          ENDIF
  735. C
  736.          MELVAL=IVAL(2)
  737.          IF (MELVAL.NE.0) THEN
  738.             IBMN=MIN(IB,VELCHE(/2))
  739.             EXCEN=VELCHE(1,IBMN)
  740.          ELSE
  741.             EXCEN=0.D0
  742.          ENDIF
  743. C
  744.          DO 4049 IGAU=1,NBPGAU
  745. C
  746.             if(cmate.eq.'ISOTROPE') then
  747.             CALL BCOQ4
  748.      &      (IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  749.             else
  750.             CALL BCOQ4O
  751.      &      (IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  752.             endif
  753. C           IERT=1 JACOBIANO <= 0
  754.             IF(IERT.EQ.1) THEN
  755.               INTERR(1)=IB
  756.               CALL ERREUR(321)
  757.               GOTO 9949
  758.             ENDIF
  759. C
  760.             CALL BST(BGENE,XDDLOC,LRE,NSTRS,XSTRS)
  761. C
  762. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  763. C
  764.             MPTVAL=IVAEPS
  765.             DO 9049 ICOMP=1,NSTRS
  766.                MELVAL=IVAL(ICOMP)
  767.                IGMN=MIN(IGAU,VELCHE(/1))
  768.                IBMN=MIN(IB  ,VELCHE(/2))
  769.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  770.  9049       CONTINUE
  771.  4049    CONTINUE
  772.  3049 CONTINUE
  773. C
  774.  9949 CONTINUE
  775.       SEGSUP WRK1,WRK2,WRK4
  776.       GOTO 510
  777. C_______________________________________________________________________
  778. C
  779. C     ELEMENT JOINT (JOI2)
  780. C_______________________________________________________________________
  781. C
  782.    85 CONTINUE
  783.       NBNO=NBNN
  784.       SEGINI WRK1,WRK2,WRK4
  785. C
  786.       DO 3085 IB=1,NBELEM
  787. C
  788. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  789. C
  790.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  791. C
  792.          CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  793. C
  794. C     ON CHERCHE LES DEPLACEMENTS
  795. C
  796.          MPTVAL=IVADEP
  797.          IE=1
  798.          DO      IGAU=1,NBNN
  799.             DO      ICOMP=1,NDEP
  800.                MELVAL=IVAL(ICOMP)
  801.                IGMN=MIN(IGAU,VELCHE(/1))
  802.                IBMN=MIN(IB  ,VELCHE(/2))
  803.                XDDL(IE)=VELCHE(IGMN,IBMN)
  804.                IE=IE+1
  805.             enddo    
  806.          enddo    
  807. C
  808. C     BOUCLE SUR LES POINTS DE GAUSS
  809. C
  810.          DO 4085 IGAU=1,NBPGAU
  811. C
  812.             CALL BJO2(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  813.      .                                       BGENE,DJAC,IRRT)
  814. C           IRRT.NE.0 JACOBIEN <= 0
  815.             IF(IRRT.NE.0) THEN
  816.               INTERR(1)=IB
  817.               CALL ERREUR(612)
  818.               GOTO 9985
  819.             ENDIF
  820. C
  821.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  822. C
  823. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  824. C
  825.             MPTVAL=IVAEPS
  826.             DO 9085 ICOMP=1,NSTRS
  827.                MELVAL=IVAL(ICOMP)
  828.                IGMN=MIN(IGAU,VELCHE(/1))
  829.                IBMN=MIN(IB  ,VELCHE(/2))
  830.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  831.  9085       CONTINUE
  832.  4085    CONTINUE
  833.  3085 CONTINUE
  834. C
  835.  9985 CONTINUE
  836.       SEGSUP WRK1,WRK2,WRK4
  837.       GOTO 510
  838. C_______________________________________________________________________
  839. C
  840. C     ELEMENT JOINT (JGI2)
  841. C_______________________________________________________________________
  842. C
  843.   170 CONTINUE
  844.       NBNO=NBNN
  845.       SEGINI WRK1,WRK2,WRK4
  846. C
  847.       NDDD=NDEP
  848.       IF (IFOUR.EQ.-3) NDDD=NDEP-3
  849. C
  850.       DO IB=1,NBELEM
  851. C
  852. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  853. C
  854.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  855. C
  856.          CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  857. C
  858. C     ON CHERCHE LES DEPLACEMENTS
  859. C
  860.          MPTVAL=IVADEP
  861.          IE=1
  862.          DO IGAU=1,NBNN
  863.             DO ICOMP=1,NDDD
  864.                MELVAL=IVAL(ICOMP)
  865.                IGMN=MIN(IGAU,VELCHE(/1))
  866.                IBMN=MIN(IB  ,VELCHE(/2))
  867.                XDDL(IE)=VELCHE(IGMN,IBMN)
  868.                IE=IE+1
  869.             ENDDO
  870.          ENDDO
  871.          IF (IFOUR.EQ.-3) THEN
  872.                XDDL(IE)=UZDPG
  873.                XDDL(IE+1)=RYDPG
  874.                XDDL(IE+2)=RXDPG
  875.          ENDIF
  876. C
  877. C     BOUCLE SUR LES POINTS DE GAUSS
  878. C
  879.          DO IGAU=1,NBPGAU
  880. C
  881. C        ON CHERCHE L EPAISSEUR DU JOINT
  882. C
  883.             EPAIST=0.D0
  884.             MPTVAL=IVACAR
  885.             MELVAL=IVAL(1)
  886.             IF (MELVAL.NE.0) THEN
  887.               IGMN=MIN(IGAU,VELCHE(/1))
  888.               IBMN=MIN(IB,VELCHE(/2))
  889.               EPAIST=VELCHE(IGMN,IBMN)
  890.             ENDIF
  891. C
  892. CcPPj       CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  893. CcPPj.                 EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  894.             CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  895.      .                 EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  896. C           IRRT.NE.0 JACOBIEN <= 0
  897.             IF (IRRT.NE.0) THEN
  898.               INTERR(1)=IB
  899.               CALL ERREUR(612)
  900.               GOTO 9970
  901.             ENDIF
  902. C
  903.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  904. C
  905. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  906. C
  907.             MPTVAL=IVAEPS
  908.             DO ICOMP=1,NSTRS
  909.                MELVAL=IVAL(ICOMP)
  910.                IGMN=MIN(IGAU,VELCHE(/1))
  911.                IBMN=MIN(IB  ,VELCHE(/2))
  912.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  913.             ENDDO
  914.          ENDDO
  915.       ENDDO
  916. C
  917.  9970 CONTINUE
  918.       SEGSUP WRK1,WRK2,WRK4
  919.       GOTO 510
  920. C_______________________________________________________________________
  921. C
  922. C     ELEMENT JOINT (JCT3) en 2D cisaillement
  923. C_______________________________________________________________________
  924. C
  925.   168 CONTINUE
  926.       NBNO=NBNN
  927.       SEGINI WRK1,WRK2,WRK4
  928. C# MC 03/11/97
  929. C  MELVAL=???????
  930. C      IF (CMATE.NE.'ISOTROPE') THEN
  931. C       MPTVAL=IVECT
  932. C       MELVAL=IVAL(1)
  933. C       NBGCOS=VELCHE(/1)
  934. C      ENDIF
  935. C
  936.       DO IB=1,NBELEM
  937. C
  938. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  939. C
  940.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  941. C
  942.          CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  943. C
  944. C     ON CHERCHE LES DEPLACEMENTS
  945. C
  946.          IE=1
  947.          MPTVAL=IVADEP
  948.          DO IGAU=1,NBNN
  949.             DO ICOMP=1,NDEP
  950.                MELVAL=IVAL(ICOMP)
  951.                IGMN=MIN(IGAU,VELCHE(/1))
  952.                IBMN=MIN(IB  ,VELCHE(/2))
  953.                XDDL(IE)=VELCHE(IGMN,IBMN)
  954.                IE=IE+1
  955.             END DO
  956.          END DO
  957. C
  958. C     BOUCLE SUR LES POINTS DE GAUSS
  959. C
  960.          DO IGAU=1,NBPGAU
  961. C
  962.             CALL BJT3C(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  963.      .                                       BGENE,DJAC,IRRT)
  964. C           IRRT.NE.0 JACOBIEN <= 0
  965.             IF(IRRT.NE.0) THEN
  966.               INTERR(1)=IB
  967.               GOTO 9968
  968.             ENDIF
  969. C
  970.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  971. C
  972. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  973. C
  974.             MPTVAL=IVAEPS
  975.             DO ICOMP=1,NSTRS
  976.                MELVAL=IVAL(ICOMP)
  977.                IGMN=MIN(IGAU,VELCHE(/1))
  978.                IBMN=MIN(IB  ,VELCHE(/2))
  979.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  980.             END DO
  981.          END DO
  982.       END DO
  983. C
  984.  9968 CONTINUE
  985.       SEGSUP WRK1,WRK2,WRK4
  986.       GOTO 510
  987. C_______________________________________________________________________
  988. C
  989. C     ELEMENT JOINT (JGT3) GENERALISE
  990. C_______________________________________________________________________
  991. C
  992.   171 CONTINUE
  993.       NBNO=NBNN
  994.       SEGINI WRK1,WRK2,WRK4
  995. C# MC 03/11/97
  996. C  MELVAL=???????
  997. C      IF (CMATE.NE.'ISOTROPE') THEN
  998. C       MPTVAL=IVECT
  999. C       MELVAL=IVAL(1)
  1000. C       NBGCOS=VELCHE(/1)
  1001. C      ENDIF
  1002. C
  1003.       DO IB=1,NBELEM
  1004. C
  1005. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1006. C
  1007.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1008. C
  1009.          CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1010. C
  1011. C     ON CHERCHE LES DEPLACEMENTS
  1012. C
  1013.          MPTVAL=IVADEP
  1014.          IE=1
  1015.          DO IGAU=1,NBNN
  1016.             DO ICOMP=1,NDEP
  1017.                MELVAL=IVAL(ICOMP)
  1018.                IGMN=MIN(IGAU,VELCHE(/1))
  1019.                IBMN=MIN(IB  ,VELCHE(/2))
  1020.                XDDL(IE)=VELCHE(IGMN,IBMN)
  1021.                IE=IE+1
  1022.             END DO
  1023.          END DO
  1024. C
  1025. C     BOUCLE SUR LES POINTS DE GAUSS
  1026. C
  1027.          DO IGAU=1,NBPGAU
  1028. C
  1029. C        ON CHERCHE L'EPAISSEUR DU JOINT
  1030. C
  1031.             EPAIST=0.D0
  1032.             MPTVAL=IVACAR
  1033.             MELVAL=IVAL(1)
  1034.             IF (MELVAL.NE.0) THEN
  1035.               IGMN=MIN(IGAU,VELCHE(/1))
  1036.               IBMN=MIN(IB,VELCHE(/2))
  1037.               EPAIST=VELCHE(IGMN,IBMN)
  1038.             ENDIF
  1039. C
  1040. C     ON CALCULE B
  1041. C
  1042. CcPPj       CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1043.             CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  1044.      .                                EPAIST,BGENE,DJAC,IRRT)
  1045. C           IRRT.NE.0 JACOBIEN <= 0
  1046.             IF (IRRT.NE.0) THEN
  1047.               INTERR(1)=IB
  1048.               CALL ERREUR(611)
  1049.               GOTO 9971
  1050.             ENDIF
  1051. C
  1052.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1053. C
  1054. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1055. C
  1056.             MPTVAL=IVAEPS
  1057.             DO ICOMP=1,NSTRS
  1058.                MELVAL=IVAL(ICOMP)
  1059.                IGMN=MIN(IGAU,VELCHE(/1))
  1060.                IBMN=MIN(IB  ,VELCHE(/2))
  1061.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1062.             END DO
  1063.          END DO
  1064.       END DO
  1065. C
  1066.  9971 CONTINUE
  1067.       SEGSUP WRK1,WRK2,WRK4
  1068.       GOTO 510
  1069. C_______________________________________________________________________
  1070. C
  1071. C     ELEMENT JOINT (JCI4) en 2D cisaillement
  1072. C_______________________________________________________________________
  1073. C
  1074.   169 CONTINUE
  1075.       NBNO=NBNN
  1076.       SEGINI WRK1,WRK2,WRK4
  1077. C# MC 03/11/97
  1078. C  MELVAL=???????
  1079. C      IF (CMATE.NE.'ISOTROPE') THEN
  1080. C       MPTVAL=IVECT
  1081. C       MELVAL=IVAL(1)
  1082. C       NBGCOS=VELCHE(/1)
  1083. C      ENDIF
  1084. C
  1085.       DO IB=1,NBELEM
  1086. C
  1087. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1088. C
  1089.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1090. C
  1091.          CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1092. C
  1093. C     ON CHERCHE LES DEPLACEMENTS
  1094. C
  1095.          MPTVAL=IVADEP
  1096.          IE=1
  1097.          DO IGAU=1,NBNN
  1098.             DO ICOMP=1,NDEP
  1099.                MELVAL=IVAL(ICOMP)
  1100.                IGMN=MIN(IGAU,VELCHE(/1))
  1101.                IBMN=MIN(IB  ,VELCHE(/2))
  1102.                XDDL(IE)=VELCHE(IGMN,IBMN)
  1103.                IE=IE+1
  1104.             ENDDO
  1105.          ENDDO
  1106. C
  1107. C     BOUCLE SUR LES POINTS DE GAUSS
  1108. C
  1109.          DO IGAU=1,NBPGAU
  1110. C
  1111.             CALL BJO4C(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1112. C           IRRT.NE.0 JACOBIEN <= 0
  1113.             IF(IRRT.NE.0) THEN
  1114.               INTERR(1)=IB
  1115.               CALL ERREUR(611)
  1116.               GOTO 9969
  1117.             ENDIF
  1118. C
  1119.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1120. C
  1121. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1122. C
  1123.             MPTVAL=IVAEPS
  1124.             DO ICOMP=1,NSTRS
  1125.                MELVAL=IVAL(ICOMP)
  1126.                IGMN=MIN(IGAU,VELCHE(/1))
  1127.                IBMN=MIN(IB  ,VELCHE(/2))
  1128.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1129.             ENDDO
  1130.          ENDDO
  1131.       ENDDO
  1132. C
  1133.  9969 CONTINUE
  1134.       SEGSUP WRK1,WRK2,WRK4
  1135.       GOTO 510
  1136. C_______________________________________________________________________
  1137. C
  1138. C     ELEMENT JOINT (JGI4) GENERALISE
  1139. C_______________________________________________________________________
  1140. C
  1141.   172 CONTINUE
  1142.       NBNO=NBNN
  1143.       SEGINI WRK1,WRK2,WRK4
  1144. C# MC 03/11/97
  1145. C  MELVAL=???????
  1146. C      IF (CMATE.NE.'ISOTROPE') THEN
  1147. C       MPTVAL=IVECT
  1148. C       MELVAL=IVAL(1)
  1149. C       NBGCOS=VELCHE(/1)
  1150. C      ENDIF
  1151. C
  1152.       DO IB=1,NBELEM
  1153. C
  1154. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1155. C
  1156.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1157. C
  1158.          CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1159. C
  1160. C     ON CHERCHE LES DEPLACEMENTS
  1161. C
  1162.          MPTVAL=IVADEP
  1163.          IE=1
  1164.          DO IGAU=1,NBNN
  1165.             DO ICOMP=1,NDEP
  1166.                MELVAL=IVAL(ICOMP)
  1167.                IGMN=MIN(IGAU,VELCHE(/1))
  1168.                IBMN=MIN(IB  ,VELCHE(/2))
  1169.                XDDL(IE)=VELCHE(IGMN,IBMN)
  1170.                IE=IE+1
  1171.             ENDDO
  1172.          ENDDO
  1173. C
  1174. C     BOUCLE SUR LES POINTS DE GAUSS
  1175. C
  1176.          DO IGAU=1,NBPGAU
  1177. C
  1178. C        ON CHERCHE L'EPAISSEUR DU JOINT
  1179. C
  1180.             EPAIST=0.D0
  1181.             MPTVAL=IVACAR
  1182.             MELVAL=IVAL(1)
  1183.             IF (MELVAL.NE.0) THEN
  1184.               IGMN=MIN(IGAU,VELCHE(/1))
  1185.               IBMN=MIN(IB,VELCHE(/2))
  1186.               EPAIST=VELCHE(IGMN,IBMN)
  1187.             ENDIF
  1188. C
  1189. CcPPj       CALL BJO4G(IGAU,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,
  1190.             CALL BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,
  1191.      >                 BGENE,DJAC,IRRT)
  1192. C           IRRT.NE.0 JACOBIEN <= 0
  1193.             IF (IRRT.NE.0) THEN
  1194.               INTERR(1)=IB
  1195.               CALL ERREUR(611)
  1196.               GOTO 9972
  1197.             ENDIF
  1198. C
  1199.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1200. C
  1201. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1202. C
  1203.             MPTVAL=IVAEPS
  1204.             DO ICOMP=1,NSTRS
  1205.                MELVAL=IVAL(ICOMP)
  1206.                IGMN=MIN(IGAU,VELCHE(/1))
  1207.                IBMN=MIN(IB  ,VELCHE(/2))
  1208.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1209.             ENDDO
  1210.          ENDDO
  1211.       ENDDO
  1212. C
  1213.  9972 CONTINUE
  1214.       SEGSUP WRK1,WRK2,WRK4
  1215.       GOTO 510
  1216.  
  1217. C_______________________________________________________________________
  1218. C
  1219. C     ELEMENT JOINT (JOI3) IMPLEMENTATION SANS TEST DE PLANEITE
  1220. C                                         ET SANS REPERE LOCAL
  1221. C_______________________________________________________________________
  1222. C
  1223.    86 CONTINUE
  1224.       NBNO=NBNN
  1225.       SEGINI WRK1,WRK2,WRK4
  1226. C
  1227.       DO 3086 IB=1,NBELEM
  1228. C
  1229. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1230. C
  1231.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1232. C
  1233. C     ON CHERCHE LES DEPLACEMENTS
  1234. C
  1235.          MPTVAL=IVADEP
  1236.          IE=1
  1237.          DO      IGAU=1,NBNN
  1238.             DO      ICOMP=1,NDEP
  1239.                MELVAL=IVAL(ICOMP)
  1240.                IGMN=MIN(IGAU,VELCHE(/1))
  1241.                IBMN=MIN(IB  ,VELCHE(/2))
  1242.                XDDL(IE)=VELCHE(IGMN,IBMN)
  1243.                IE=IE+1
  1244.             enddo     
  1245.          enddo     
  1246. C
  1247. C     BOUCLE SUR LES POINTS DE GAUSS
  1248. C
  1249.          DO 4086 IGAU=1,NBPGAU
  1250. C
  1251.             CALL JO3LOC(XE,SHPTOT,IGAU,NBNN,BPSS)
  1252. C
  1253.             CALL BJO3(IGAU,MFR,IFOUR,NIFOUR,XE,BPSS,SHPTOT,SHPWRK,
  1254.      .                                     BGENE,DJAC,IRRT)
  1255. C           IRRT.NE.0 JACOBIEN <= 0
  1256.             IF (IRRT.NE.0) THEN
  1257.               INTERR(1)=IB
  1258.               CALL ERREUR(612)
  1259.               GOTO 9986
  1260.             ENDIF
  1261. C
  1262.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1263. C
  1264. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1265. C
  1266.             MPTVAL=IVAEPS
  1267.             DO 9086 ICOMP=1,NSTRS
  1268.                MELVAL=IVAL(ICOMP)
  1269.                IGMN=MIN(IGAU,VELCHE(/1))
  1270.                IBMN=MIN(IB  ,VELCHE(/2))
  1271.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1272.  9086       CONTINUE
  1273.  4086    CONTINUE
  1274.  3086 CONTINUE
  1275. C
  1276. C     IMPRESSION D'UN MESSAGE D'ERREUR
  1277. C
  1278.  9986 CONTINUE
  1279.       SEGSUP WRK1,WRK2,WRK4
  1280.       GOTO 510
  1281. C_______________________________________________________________________
  1282. C
  1283. C     ELEMENT JOINT (JOT3)
  1284. C_______________________________________________________________________
  1285. C
  1286.    87 CONTINUE
  1287.       NBNO=NBNN
  1288.       SEGINI WRK1,WRK2,WRK4
  1289. C# MC 03/11/97
  1290. C  MELVAL=???????
  1291. C      IF (CMATE.NE.'ISOTROPE') THEN
  1292. C       MPTVAL=IVECT
  1293. C       MELVAL=IVAL(1)
  1294. C       NBGCOS=VELCHE(/1)
  1295. C      ENDIF
  1296. C
  1297.       DO 3087 IB=1,NBELEM
  1298. C
  1299. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1300. C
  1301.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1302. C
  1303.          CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1304. C
  1305. C     ON CHERCHE LES DEPLACEMENTS
  1306. C
  1307.          MPTVAL=IVADEP
  1308.          IE=1
  1309.          DO      IGAU=1,NBNN
  1310.             DO      ICOMP=1,NDEP
  1311.                MELVAL=IVAL(ICOMP)
  1312.                IGMN=MIN(IGAU,VELCHE(/1))
  1313.                IBMN=MIN(IB  ,VELCHE(/2))
  1314.                XDDL(IE)=VELCHE(IGMN,IBMN)
  1315.                IE=IE+1
  1316.             enddo    
  1317.          enddo    
  1318. C
  1319. C     BOUCLE SUR LES POINTS DE GAUSS
  1320. C
  1321.          DO 4087 IGAU=1,NBPGAU
  1322. C
  1323.             CALL BJT3(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1324.      .                                       BGENE,DJAC,IRRT)
  1325. C           IRRT.NE.0 JACOBIEN <= 0
  1326.             IF (IRRT.NE.0) THEN
  1327.               INTERR(1)=IB
  1328.               CALL ERREUR(611)
  1329.               GOTO 9987
  1330.             ENDIF
  1331. C
  1332.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1333. C
  1334. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1335. C
  1336.             MPTVAL=IVAEPS
  1337.             DO 9087 ICOMP=1,NSTRS
  1338.                MELVAL=IVAL(ICOMP)
  1339.                IGMN=MIN(IGAU,VELCHE(/1))
  1340.                IBMN=MIN(IB  ,VELCHE(/2))
  1341.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1342.  9087       CONTINUE
  1343.  4087    CONTINUE
  1344.  3087 CONTINUE
  1345. C
  1346.  9987 CONTINUE
  1347.       SEGSUP WRK1,WRK2,WRK4
  1348.       GOTO 510
  1349. C_______________________________________________________________________
  1350. C
  1351. C     ELEMENT JOINT (JOI4)
  1352. C_______________________________________________________________________
  1353. C
  1354.    88 CONTINUE
  1355.       NBNO=NBNN
  1356.       SEGINI WRK1,WRK2,WRK4
  1357. C# MC 03/11/97
  1358. C  MELVAL=???????
  1359. C      IF (CMATE.NE.'ISOTROPE') THEN
  1360. C       MPTVAL=IVECT
  1361. C       MELVAL=IVAL(1)
  1362. C       NBGCOS=VELCHE(/1)
  1363. C      ENDIF
  1364. C
  1365.       DO 3088 IB=1,NBELEM
  1366. C
  1367. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IB
  1368. C
  1369.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1370. C
  1371.          CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1372. C
  1373. C     ON CHERCHE LES DEPLACEMENTS
  1374. C
  1375.          MPTVAL=IVADEP
  1376.          IE=1
  1377.          DO      IGAU=1,NBNN
  1378.             DO      ICOMP=1,NDEP
  1379.                MELVAL=IVAL(ICOMP)
  1380.                IGMN=MIN(IGAU,VELCHE(/1))
  1381.                IBMN=MIN(IB  ,VELCHE(/2))
  1382.                XDDL(IE)=VELCHE(IGMN,IBMN)
  1383.                IE=IE+1
  1384.             enddo    
  1385.          enddo    
  1386. C
  1387. C     BOUCLE SUR LES POINTS DE GAUSS
  1388. C
  1389.          DO 4088 IGAU=1,NBPGAU
  1390. C
  1391.             CALL BJO4(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1392. C           IRRT.NE.0 JACOBIEN <= 0
  1393.             IF (IRRT.NE.0) THEN
  1394.               INTERR(1)=IB
  1395.               CALL ERREUR(611)
  1396.               GOTO 9988
  1397.             ENDIF
  1398. C
  1399.             CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  1400. C
  1401. C     REMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1402. C
  1403.             MPTVAL=IVAEPS
  1404.             DO 9088 ICOMP=1,NSTRS
  1405.                MELVAL=IVAL(ICOMP)
  1406.                IGMN=MIN(IGAU,VELCHE(/1))
  1407.                IBMN=MIN(IB  ,VELCHE(/2))
  1408.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1409.  9088       CONTINUE
  1410.  4088    CONTINUE
  1411.  3088 CONTINUE
  1412. C
  1413.  9988 CONTINUE
  1414.       SEGSUP WRK1,WRK2,WRK4
  1415.       GOTO 510
  1416. C_______________________________________________________________________
  1417. C
  1418. C     ELEMENT DST
  1419. C_______________________________________________________________________
  1420. C
  1421.   93  CONTINUE
  1422.       NBNO=NBNN
  1423.       NV1=NMATT
  1424.       SEGINI WRK1,WRK2,WRK3,WRK4,MVELCH
  1425.       IF(CMATE.NE.'ISOTROPE')THEN
  1426.          MPTVAL=IVAMAT
  1427.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1428.             MELVAL=IVAL(7)
  1429.          ELSE
  1430.             MELVAL=IVAL(2)
  1431.          ENDIF
  1432.          NBGCOS=VELCHE(/1)
  1433.       ENDIF
  1434.       IRTD = 1
  1435.       DO 3093  IB=1,NBELEM
  1436. C
  1437. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  1438. C
  1439.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1440. C
  1441. C     ON CHERCHE LES DEPLACEMENTS
  1442. C
  1443.          MPTVAL=IVADEP
  1444.          IE=1
  1445.          DO      IGAU=1,NBNN
  1446.             DO      ICOMP=1,NDEP
  1447.                MELVAL=IVAL(ICOMP)
  1448.                IGMN=MIN(IGAU,VELCHE(/1))
  1449.                IBMN=MIN(IB  ,VELCHE(/2))
  1450.                XDDL(IE)=VELCHE(IGMN,IBMN)
  1451.                IE=IE+1
  1452.             enddo    
  1453.          enddo    
  1454.          CALL VPAST(XE,BPSS)
  1455. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  1456.          CALL VCORLC (XE,XEL,BPSS)
  1457.          CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  1458. C
  1459. C     ON CHERCHE LES EPAISEURS ET ON LES MOYENNE,
  1460. C                LES EXCENTREMENTS ET ON LES MOYENNE.
  1461. C
  1462.         MPTVAL=IVACAR
  1463.         EPAIST=0.D0
  1464.         MELVAL=IVAL(1)
  1465.         IF (MELVAL.NE.0) THEN
  1466.         DO IGAU=1,NBPGAU
  1467.            IGMN=MIN(IGAU,VELCHE(/1))
  1468.            IBMN=MIN(IB,VELCHE(/2))
  1469.            EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  1470.         ENDDO
  1471.         EPAIST=EPAIST/NBPGAU
  1472.         ENDIF
  1473. C
  1474.         EXCEN=0.D0
  1475.         MELVAL=IVAL(2)
  1476.         IF (MELVAL.NE.0) THEN
  1477.         DO IGAU=1,NBPGAU
  1478.            IGMN=MIN(IGAU,VELCHE(/1))
  1479.            IBMN=MIN(IB,VELCHE(/2))
  1480.            EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  1481.         ENDDO
  1482.         EXCEN=EXCEN/NBPGAU
  1483.         ENDIF
  1484. C
  1485. C     BOUCLE SUR LES POINTS DE GAUSS
  1486. C
  1487.          DO 5093  IGAU=1,NBPTEL
  1488. C
  1489. C Dans le cas des matériaux orthotropes, les déformations sont d'abord
  1490. C calculées dans le repère d'orthotropie (les formules utilisées par les
  1491. C routines RCDST et BMFDST ne sont valables que dans ce repère); elles
  1492. C sont ensuite exprimées dans le repère local de l'élément.
  1493. C
  1494. C     ON CHERCHE LA MATRICE DE HOOKE
  1495. C
  1496.       MPTVAL=IVAMAT
  1497.       IF(IMAT.EQ.2) THEN
  1498.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1499.           MELVAL=IVAL(1)
  1500.           IBMN=MIN(IB  ,IELCHE(/2))
  1501.           IGMN=MIN(IGAU,IELCHE(/1))
  1502.           MLREEL=IELCHE(IGMN,IBMN)
  1503.           SEGACT MLREEL
  1504.           CALL DOHOOO(PROG,LHOOK,DDHOMU)
  1505.           SEGDES MLREEL
  1506.         ENDIF
  1507.       ELSE IF (IMAT.EQ.1) THEN
  1508.           DO 9193 IM=1,NMATT
  1509.             IF (IVAL(IM).NE.0) THEN
  1510.               MELVAL=IVAL(IM)
  1511.               IBMN=MIN(IB  ,VELCHE(/2))
  1512.               IGMN=MIN(IGAU,VELCHE(/1))
  1513.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  1514.             ELSE
  1515.               VALMAT(IM)=0.D0
  1516.             ENDIF
  1517.  9193     CONTINUE
  1518.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  1519.      1     CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  1520.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  1521.       ENDIF
  1522.       CALL ZERO(BGENE,NSTRS,LRE)
  1523.       IF(CMATE.NE.'ISOTROPE')THEN
  1524.         IF(IGAU.LE.NBGCOS)THEN
  1525.           IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1526.             COSA=VALMAT(7)
  1527.             SINA=VALMAT(8)
  1528.           ELSE
  1529.             MPTVAL=IVAMAT
  1530.             MELVAL=IVAL(2)
  1531.             IBMN=MIN(IB  ,VELCHE(/2))
  1532.             IGMN=MIN(IGAU,VELCHE(/1))
  1533.             COSA=VELCHE(IGMN,IBMN)
  1534.             MELVAL=IVAL(3)
  1535.             IBMN=MIN(IB  ,VELCHE(/2))
  1536.             IGMN=MIN(IGAU,VELCHE(/1))
  1537.             SINA=VELCHE(IGMN,IBMN)
  1538.           ENDIF
  1539.           DO 1393 INO=1,NBNN
  1540.            XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  1541.            YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  1542.            XE(1,INO)=XX
  1543.            XE(2,INO)=YY
  1544.  1393     CONTINUE
  1545.         ENDIF
  1546. C
  1547. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  1548. C      AUX CISAILLEMENTS TRANSVERSES
  1549. C
  1550.         CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  1551.      1                WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  1552. C
  1553. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  1554. C        DE MEMBRANE ET DE FLEXION
  1555. C
  1556.          CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  1557.      1            WORK(1),WORK(10),WORK(19),BGENE,DUM)
  1558. C
  1559.          CALL ROTB(BGENE,NSTRS,COSA,SINA)
  1560.       ELSE
  1561. C
  1562. C     TERMES DE LA MATRICE B RELATIFS AUX CISAILLEMENTS TRANSVERSES
  1563. C
  1564.         CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  1565.      1          WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  1566. C
  1567. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  1568. C        DE MEMBRANE ET DE FLEXION
  1569. C
  1570.         CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  1571.      1            WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  1572.       ENDIF
  1573. C
  1574. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  1575. C
  1576.           IF (EXCEN.NE.0.) THEN
  1577.             DO      IJL=1,3
  1578.                DO      IJC=1,LRE
  1579.                   BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  1580.                enddo     
  1581.             enddo     
  1582.           ENDIF
  1583. C
  1584.             CALL BST(BGENE,XDDLOC,LRE,NSTRS,XSTRS)
  1585. C
  1586. C     CALCUL DES EPS 2
  1587. C
  1588.          IF(IREPS2.EQ.1)THEN
  1589.            IF(CMATE.EQ.'ORTHOTRO')THEN
  1590.              CALL BDST2(XE,XDDLOC,IGAU,BGENE,CMATE,COSA,SINA,XSTRS)
  1591.             ELSE
  1592.              CALL BDST2(XEL,XDDLOC,IGAU,BGENE,CMATE,COSA,SINA,XSTRS)
  1593.             ENDIF
  1594.          ENDIF
  1595. C
  1596. C    CHANGEMENT DE REPERE: ORTHO -> LOCAL
  1597. C
  1598.          IF(CMATE.EQ.'ORTHOTRO')
  1599.      1          CALL CHGREP2(COSA,SINA,XSTRS,0,0)
  1600. C
  1601. C     RMPLISSAGE DU SEGMENT CONTENANT LES DEFORMATIONS
  1602. C
  1603.             MPTVAL=IVAEPS
  1604.             DO 9093 ICOMP=1,NSTRS
  1605.                MELVAL=IVAL(ICOMP)
  1606.                IGMN=MIN(IGAU,VELCHE(/1))
  1607.                IBMN=MIN(IB  ,VELCHE(/2))
  1608.                VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1609.  9093       CONTINUE
  1610.  5093    CONTINUE
  1611.  3093 CONTINUE
  1612. C
  1613. C     ERREUR LE MATERIAU PAS ENCORE IMPLEMENTER POUR
  1614. C     LA FORMULATION MFR ET L OPTION IFOUR
  1615.       IF (IRTD.EQ.0) THEN
  1616.          MOTERR(1:8)=CMATE
  1617.          MOTERR(9:12)=NOMFR(MFR/2+1)
  1618.          INTERR(1)=IFOUR
  1619.          CALL ERREUR(81)
  1620.       ENDIF
  1621.  
  1622.       SEGSUP WRK1,WRK2,WRK3,WRK4,MVELCH
  1623.       GOTO 510
  1624. C____________________________________________________________________
  1625.    99 CONTINUE
  1626.       MOTERR(1:4)=NOMTP(MELE)
  1627.       MOTERR(9:12)='EPSI'
  1628.       CALL ERREUR(86)
  1629. C
  1630.   510 CONTINUE
  1631.       RETURN
  1632.       END
  1633.  
  1634.  
  1635.  
  1636.  
  1637.  
  1638.  
  1639.  
  1640.  
  1641.  
  1642.  
  1643.  
  1644.  
  1645.  

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