Télécharger la plaquette Cast3M


fr en

Télécharger sigma2.eso

Retour à la liste

Numérotation des lignes : 

sigma2

  1. C SIGMA2    SOURCE    JK148537  26/06/23    21:15:07     12579          
  2.       SUBROUTINE SIGMA2(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,
  3.      &      IVAMAT,LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,
  4.      &      IPMIN1,NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,NPINT,IVASTR
  5.      &      ,UZDPG,RYDPG,RXDPG,IIPDPG,inoer)
  6. *---------------------------------------------------------------------*
  7. *        __________________________                                   *
  8. *        |                        |                                   *
  9. *        |  calcul des contraintes|                                   *
  10. *        |________________________|                                   *
  11. *                                                                     *
  12. *      coq3,dkt,coq4,coq8,coq2 ,dst,joint 3d,joints 2d                *
  13. *                                                                     *
  14. *---------------------------------------------------------------------*
  15. *                                                                     *
  16. *   entrees :                                                         *
  17. *   ________                                                          *
  18. *                                                                     *
  19. *        ipmail   pointeur sur un segment  meleme                     *
  20. *        ivadep   pointeur sur le chamelem de deplacements            *
  21. *        ivacar   pointeur sur les chamelems de caracteristiques      *
  22. *        nelmat   taille maxi des melval du materiau (no d'element)   *
  23. *        nbgmat   taille maxi des melval du materiau (pt de gauss)    *
  24. *        ivamat   pointeur sur un segment mptval pour le materiau ou  *
  25. *        lhook    dimension de la matrice de hooke                    *
  26. *        imat     (2 il y a une matrice de hooke,1 non  )             *
  27. *        mate     numero du materiau                                  *
  28. *        cmate    nom du materiau                                     *
  29. *        nmatt    nombre de composante de materiau (imat=1)           *
  30. *        nstrs    nombre de composante de contraintes/deformations    *
  31. *                 pour une matrice de hooke                           *
  32. *        mfr      numero de formulation de l'element fini             *
  33. *        ipmint   pointeur sur un segment minte                       *
  34. *        ipmin1   pointeur sur un segment minte (aux noeuds)          *
  35. *        ndep     nombre de composantes de deplacements               *
  36. *        nbpgau   nombre de point d'integration pour la rigidite      *
  37. *        nbptel   nombre de points par element                        *
  38. *        mele     numero de l'element fini                            *
  39. *        lre      nombre de ddl dans la matrice de rigidite           *
  40. *        lw       dimension du tableau de travail de l'element        *
  41. *        iresp2   flag pour indiquer si on veut les contraintes       *
  42. *                  de piola-kirchhoff                                 *
  43. *        npint    nombre de points d'integration dans l'epaisseur
  44. *                 dans le cas des elements de coque integres
  45. *                                                                     *
  46. *   sorties :                                                         *
  47. *   ________                                                          *
  48. *                                                                     *
  49. *        ivastr   pointeur sur un segment mptval contenant les        *
  50. *                 les melvals de contraints
  51. *                                                                     *
  52. *---------------------------------------------------------------------*
  53.       IMPLICIT INTEGER(I-N)
  54.       IMPLICIT REAL*8(A-H,O-Z)
  55.  
  56. -INC PPARAM
  57. -INC CCOPTIO
  58. -INC CCHAMP
  59. -INC CCREEL
  60.  
  61. -INC SMCHAML
  62. -INC SMINTE
  63. -INC SMELEME
  64. -INC SMCOORD
  65. -INC SMLREEL
  66.  
  67. -INC TMPTVAL
  68.  
  69.       SEGMENT WRK1
  70.        REAL*8 DDHOOK(LHOOK,LHOOK) ,XDDL(LRE) ,XSTRS(NSTRS)
  71.        REAL*8 XE(3,NBBB) ,DDHOMU(LHOOK,LHOOK)
  72.       ENDSEGMENT
  73. *
  74.       SEGMENT WRK2
  75.        REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  76.       ENDSEGMENT
  77. *
  78.       SEGMENT WRK3
  79.        REAL*8 WORK(LW)
  80.       ENDSEGMENT
  81. *
  82.       SEGMENT WRK4
  83.        REAL*8 BPSS(3,3) ,XEL(3,NBBB) ,XDDLOC(LRE)
  84.       ENDSEGMENT
  85. *
  86.       SEGMENT WRK5
  87.        REAL*8   XSTRS1(NSTRS1)
  88.       ENDSEGMENT
  89. *
  90.       SEGMENT,MVELCH
  91.          REAL*8 VALMAT(NV1)
  92.       ENDSEGMENT
  93.  
  94.       CHARACTER*8 CMATE
  95.       dimension rel(lre,lre)
  96. *
  97. *    initialisation du point autour duquel se fait le mouvement
  98. *    en deformation plane generalisee
  99. *
  100.       IF (IFOUR.EQ.-3) THEN
  101.         IP=IIPDPG
  102.         SEGACT MCOORD
  103.         IREF=(IP-1)*(IDIM+1)
  104.         XDPGE=XCOOR(IREF+1)
  105.         YDPGE=XCOOR(IREF+2)
  106.       ELSE
  107.         XDPGE=0.D0
  108.         YDPGE=0.D0
  109.       ENDIF
  110. *
  111.       MELEME=IPMAIL
  112.       NBNN=NUM(/1)
  113.       NBELEM=NUM(/2)
  114. *
  115.       NV1=NMATT
  116.       SEGINI,MVELCH
  117. *
  118.       NHRM=NIFOUR
  119. *
  120.       MINTE=IPMINT
  121.       IRTD=1
  122. *
  123.       NBBB=NBNN
  124.       SEGINI WRK1
  125. c_______________________________________________________________________
  126. c
  127. c     numero des etiquettes      :
  128. c     etiquettes de 1 a 98 pour traitement specifique a l element
  129. c     dans la zone specifique a chaque element commencant par :
  130. c     5  continue
  131. c     element 5   etiquettes 1005 2005 3005 4005   ...
  132. c     44 continue
  133. c     element 44  etiquettes 1044 2044 3044 4044   ...
  134. c_______________________________________________________________________
  135. c
  136.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  137.      1      99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  138.      2      41,99,99,44,28,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  139.      3      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  140.      4      99,99,99,99,85,86,87,88,99,99,99,99,93,99,99,99,99),MELE
  141. *
  142.       GOTO(168,169,170,171,172),MELE-167
  143. *
  144.       GOTO 99
  145. c_______________________________________________________________________
  146. c
  147. c     element  coq3
  148. c_______________________________________________________________________
  149. c
  150.   27  CONTINUE
  151.       SEGINI WRK3
  152. c
  153. c     boucle de calcul pour les differents elements
  154. c
  155.       DO  3027 IB=1,NBELEM
  156. c
  157. c     on cherche les deplacements
  158. c
  159.       MPTVAL=IVADEP
  160.       IE=1
  161.       DO 4027 IGAU=1,NBNN
  162.       DO 4026 ICOMP=1,NDEP
  163.         MELVAL=IVAL(ICOMP)
  164.         IGMN=MIN(IGAU,VELCHE(/1))
  165.         IBMN=MIN(IB  ,VELCHE(/2))
  166.         XDDL(IE)=VELCHE(IGMN,IBMN)
  167.         IE=IE+1
  168.  4026 CONTINUE
  169.  4027 CONTINUE
  170. c
  171. c     on cherche les coordonnees des noeuds de l element ib
  172. c
  173.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  174. c
  175. c     on cherche les coeff des mat de hooke et l epaisseur
  176. c
  177.       MPTVAL=IVACAR
  178.       MELVAL=IVAL(1)
  179.       IF (MELVAL.NE.0) THEN
  180.         IBMN=MIN(IB,VELCHE(/2))
  181.         EPAIST=VELCHE(1,IBMN)
  182.       ELSE
  183.         EPAIST=0.D0
  184.       ENDIF
  185. c
  186.       MPTVAL=IVAMAT
  187.       IF(IMAT.EQ.2) THEN
  188.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  189.           MELVAL=IVAL(1)
  190.           IBMN=MIN(IB  ,IELCHE(/2))
  191.           MLREEL=IELCHE(1,IBMN)
  192.           SEGACT MLREEL
  193.           CALL DOHOOO(PROG,LHOOK,DDHOMU)
  194.           SEGDES MLREEL
  195.         ENDIF
  196.       ELSE IF (IMAT.EQ.1) THEN
  197.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  198.           DO 9027 IM=1,NMATT
  199.             IF (IVAL(IM).NE.0) THEN
  200.               MELVAL=IVAL(IM)
  201.               IBMN=MIN(IB  ,VELCHE(/2))
  202.               VALMAT(IM)=VELCHE(1,IBMN)
  203.             ELSE
  204.               VALMAT(IM)=0.D0
  205.             ENDIF
  206.  9027     CONTINUE
  207.           CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  208.         ENDIF
  209.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  210.       ENDIF
  211.       CALL COQ3ST(XE,XDDL,XSTRS,DDHOMU)
  212. c
  213.       IF(IREPS2.EQ.1)
  214.      1  CALL DBCO32(XE,DDHOMU,XDDL,WORK,XSTRS)
  215. c
  216.       MPTVAL=IVASTR
  217.       DO 6027 ICOMP=1,NSTRS
  218.         MELVAL=IVAL(ICOMP)
  219.         IBMN=MIN(IB,VELCHE(/2))
  220.         VELCHE(1,IBMN)=XSTRS(ICOMP)
  221.  6027 CONTINUE
  222. c
  223.  3027 CONTINUE
  224. c
  225.       IF(IRTD.EQ.0) THEN
  226.        MOTERR(1:8)=CMATE
  227.        MOTERR(9:12)=NOMFR(MFR/2+1)
  228.        INTERR(1)=IFOUR
  229.        CALL ERREUR(81)
  230.       ENDIF
  231.  9927 CONTINUE
  232.       SEGSUP WRK3
  233.       GOTO 510
  234. c____________________________________________________________________
  235. c
  236. c     element dkt
  237. c____________________________________________________________________
  238. c
  239.   28  CONTINUE
  240.       NBNO=NBNN
  241.       SEGINI WRK2,WRK4
  242.       IF(NPINT.NE.0)THEN
  243.         NSTRS1=6
  244.         SEGINI WRK5
  245.       ENDIF
  246.       DO 3028  IB=1,NBELEM
  247. c
  248. c     on cherche les deplacements
  249. c
  250.       MPTVAL=IVADEP
  251.       IE=1
  252.       DO 4029 IGAU=1,NBNN
  253.       DO 4028 ICOMP=1,NDEP
  254.         MELVAL=IVAL(ICOMP)
  255.         IGMN=MIN(IGAU,VELCHE(/1))
  256.         IBMN=MIN(IB  ,VELCHE(/2))
  257.         XDDL(IE)=VELCHE(IGMN,IBMN)
  258.         IE=IE+1
  259.  4028 CONTINUE
  260.  4029 CONTINUE
  261. c
  262. c     on cherche les coordonnees des noeuds de l'element ib
  263. c
  264.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  265.       CALL VPAST(XE,BPSS)
  266. c     bpss    stocke la matrice de passage
  267.       CALL VCORLC (XE,XEL,BPSS)
  268.       CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  269. c
  270. c     on cherche les epaiseurs et on les moyenne,
  271. c                les excentrements et on les moyenne.
  272. c
  273.       EPAIST=0.D0
  274.       MPTVAL=IVACAR
  275.       MELVAL=IVAL(1)
  276.       IF (MELVAL.NE.0) THEN
  277.       DO  IGAU=1,NBPGAU
  278.           IGMN=MIN(IGAU,VELCHE(/1))
  279.           IBMN=MIN(IB,VELCHE(/2))
  280.           EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  281.       ENDDO
  282.       EPAIST=EPAIST/NBPGAU
  283.       ENDIF
  284. *
  285.       EXCEN=0.D0
  286.       MELVAL=IVAL(2)
  287.       IF (MELVAL.NE.0) THEN
  288.       DO  IGAU=1,NBPGAU
  289.           IGMN=MIN(IGAU,VELCHE(/1))
  290.           IBMN=MIN(IB,VELCHE(/2))
  291.           EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  292.       ENDDO
  293.       EXCEN=EXCEN/NBPGAU
  294.       ENDIF
  295. c
  296.       IF(NPINT.EQ.0)THEN
  297. c
  298. c     coque global
  299. c
  300. c     boucle sur les points de gauss
  301. c
  302.       DO 5028  IGAU=1,NBPTEL
  303.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  304.      &            MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  305.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  306. *
  307. *  on modifie la matrice b en cas d'excentrement non nul
  308. *
  309.         IF (EXCEN.NE.0.D0) THEN
  310.       DO 1529 IJL=1,3
  311.       DO 1528 IJC=1,LRE
  312.         BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  313.  1528 CONTINUE
  314.  1529 CONTINUE
  315.         ENDIF
  316. c
  317. c     on cherche la matrice de hooke
  318. c
  319.       MPTVAL=IVAMAT
  320.       IF(IMAT.EQ.2) THEN
  321.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  322.           MELVAL=IVAL(1)
  323.           IBMN=MIN(IB  ,IELCHE(/2))
  324.           IGMN=MIN(IGAU,IELCHE(/1))
  325.           MLREEL=IELCHE(IGMN,IBMN)
  326.           SEGACT MLREEL
  327.           CALL DOHOOO(PROG,LHOOK,DDHOMU)
  328.           SEGDES MLREEL
  329.         ENDIF
  330.       ELSE IF (IMAT.EQ.1) THEN
  331.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  332.           DO 9128 IM=1,NMATT
  333.             IF (IVAL(IM).NE.0) THEN
  334.               MELVAL=IVAL(IM)
  335.               IBMN=MIN(IB  ,VELCHE(/2))
  336.               IGMN=MIN(IGAU,VELCHE(/1))
  337.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  338.             ELSE
  339.               VALMAT(IM)=0.D0
  340.             ENDIF
  341.  9128     CONTINUE
  342.           CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  343.         ENDIF
  344.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  345.       ENDIF
  346.       CALL DBST(BGENE,DDHOMU,XDDLOC,LRE,NSTRS,XSTRS)
  347. c
  348. c     calcul des eps 2
  349. c
  350.       IF(IREPS2.EQ.1)
  351.      1  CALL DBDKT2(XEL,DDHOMU,XDDLOC,IGAU,XSTRS,SHPWRK,SHPTOT,
  352.      1 BGENE,NBNO,LRE,NSTRS)
  353. c
  354. c     remplissage du segment contenant les contraintes
  355. c
  356.       MPTVAL=IVASTR
  357.       DO 9028 ICOMP=1,NSTRS
  358.         MELVAL=IVAL(ICOMP)
  359.         IBMN=MIN(IB  ,VELCHE(/2))
  360.         VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  361.  9028 CONTINUE
  362.  5028 CONTINUE
  363. c
  364.       ELSE
  365. c
  366. c    coque integree
  367. c
  368.       NBPGA1=NBPGAU/NPINT
  369. c
  370. c     boucle sur les points de gauss de la surface
  371. c
  372.       DO 5001  IGAU=1,NBPGA1
  373.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  374.      &          MELE,MFR,NBNO,LRE,IFOUR,NSTRS1,0,1.D0,XEL,
  375.      &          SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  376. *
  377. *  on modifie la matrice b en cas d'excentrement non nul
  378. *
  379.         IF (EXCEN.NE.0.D0) THEN
  380.       DO 1501 IJL=1,3
  381.       DO 1502 IJC=1,LRE
  382.         BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  383.  1502 CONTINUE
  384.  1501 CONTINUE
  385.         ENDIF
  386. c
  387. c   boucle sur les nappes
  388. c
  389.       DO 5002 INAP=1,NPINT
  390.       IGAU1=(INAP-1)*NBPGA1+IGAU
  391. c
  392. c     on cherche la matrice de hooke
  393. c
  394.       MPTVAL=IVAMAT
  395.       IF(IMAT.EQ.2) THEN
  396.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  397.           MELVAL=IVAL(1)
  398.           IBMN=MIN(IB  ,IELCHE(/2))
  399.           IGMN=MIN(IGAU1,IELCHE(/1))
  400.           MLREEL=IELCHE(IGMN,IBMN)
  401.           SEGACT MLREEL
  402.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  403.           SEGDES MLREEL
  404.         ENDIF
  405.       ELSE IF (IMAT.EQ.1) THEN
  406.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  407.           DO 9101 IM=1,NMATT
  408.             IF (IVAL(IM).NE.0) THEN
  409.               MELVAL=IVAL(IM)
  410.               IBMN=MIN(IB  ,VELCHE(/2))
  411.               IGMN=MIN(IGAU1,VELCHE(/1))
  412.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  413.             ELSE
  414.               VALMAT(IM)=0.D0
  415.             ENDIF
  416.  9101     CONTINUE
  417.           CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  418.         ENDIF
  419.       ENDIF
  420.       CALL DBST(BGENE,DDHOOK,XDDLOC,LRE,NSTRS1,XSTRS1)
  421. c
  422. c     calcul des eps 2
  423. c
  424.       IF(IREPS2.EQ.1)
  425.      1  CALL DBDKT2(XEL,DDHOOK,XDDLOC,IGAU,XSTRS1,SHPWRK,SHPTOT,
  426.      1 BGENE,NBNO,LRE,NSTRS1)
  427. c
  428.       ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  429.       XSTRS(1)=XSTRS1(1)+ZZZ*XSTRS1(4)
  430.       XSTRS(2)=XSTRS1(2)+ZZZ*XSTRS1(5)
  431.       XSTRS(3)=0.D0
  432.       XSTRS(4)=XSTRS1(3)+ZZZ*XSTRS1(6)
  433. c
  434. c     remplissage du segment contenant les contraintes
  435. c
  436.       MPTVAL=IVASTR
  437.       DO 9001 ICOMP=1,NSTRS
  438.         MELVAL=IVAL(ICOMP)
  439.         IBMN=MIN(IB  ,VELCHE(/2))
  440.         VELCHE(IGAU1,IBMN)=XSTRS(ICOMP)
  441.  9001 CONTINUE
  442. c fin de boucle sur les nappes de points
  443.  5002 CONTINUE
  444. c fin de boucle sur  les points dans chaque nappe
  445.  5001 CONTINUE
  446. c fin de boucle sur les points d'integration
  447.       ENDIF
  448. c fin de boucle sur les elements
  449.  3028 CONTINUE
  450. *
  451.       IF(IRTD.EQ.0) THEN
  452.        MOTERR(1:8)=CMATE
  453.        MOTERR(9:12)=NOMFR(MFR/2+1)
  454.        INTERR(1)=IFOUR
  455.        CALL ERREUR(81)
  456.       ENDIF
  457.  9928 CONTINUE
  458.       SEGSUP,WRK2,WRK4
  459.       IF(NPINT.NE.0)SEGSUP WRK5
  460. *
  461.       GOTO 510
  462. c____________________________________________________________________
  463. c
  464. c     elements coq6 et coq8
  465. c____________________________________________________________________
  466. c
  467.   41  CONTINUE
  468.       NBNO=NBNN
  469.       SEGINI WRK2,WRK3
  470.       MINTE1=IPMIN1
  471.       SEGACT MINTE1
  472.       NBPGA1=MINTE1.SHPTOT(/3)
  473.       NBN1  =MINTE1.SHPTOT(/2)
  474. c
  475. c     boucle de calcul pour les differents elements
  476. c
  477.       DO  3041 IB=1,NBELEM
  478. c
  479. c     on cherche les deplacements
  480. c
  481.       MPTVAL=IVADEP
  482.       IE=1
  483.       DO 4041 IGAU=1,NBNN
  484.       DO 4042 ICOMP=1,NDEP
  485.         MELVAL=IVAL(ICOMP)
  486.         IGMN=MIN(IGAU,VELCHE(/1))
  487.         IBMN=MIN(IB  ,VELCHE(/2))
  488.         XDDL(IE)=VELCHE(IGMN,IBMN)
  489.         IE=IE+1
  490.  4042 CONTINUE
  491.  4041 CONTINUE
  492. c
  493. c     on cherche les coordonnees des noeuds de l'element ib
  494. c
  495.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  496. c
  497. c     on cherche les epaisseurs et les excentrements,
  498. c
  499.       MPTVAL=IVACAR
  500.       MELVAL=IVAL(1)
  501.       IF (MELVAL.NE.0) THEN
  502.       DO  IGAU=1,NBPGAU
  503.           IGMN=MIN(IGAU,VELCHE(/1))
  504.           IBMN=MIN(IB,VELCHE(/2))
  505.           WORK(IGAU)=VELCHE(IGMN,IBMN)
  506.       ENDDO
  507.       ENDIF
  508. *
  509.         MELVAL=IVAL(2)
  510.         IF (MELVAL.NE.0) THEN
  511.       DO  IGAU=1,NBPGAU
  512.           IGMN=MIN(IGAU,VELCHE(/1))
  513.           IBMN=MIN(IB,VELCHE(/2))
  514.           WORK(IGAU+10)=VELCHE(IGMN,IBMN)
  515.       ENDDO
  516.       ENDIF
  517. c
  518. c      determination des axes locaux aux noeuds
  519. c
  520.        CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR)
  521. c
  522. c       boucle sur les points de gauss
  523. c
  524.        DO 3042  IGAU=1,NBPTEL
  525. c
  526. c      calcul de la matrice b
  527. c
  528.         E3=DZEGAU(IGAU)
  529.         CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC,
  530.      1             E3,SHPTOT,WORK(21),IRR)
  531. c
  532.         IF (IRR.EQ.0) THEN
  533.           INTERR(1)=IB
  534.           CALL ERREUR(241)
  535.           GOTO 9941
  536.         ELSE IF (IRR.EQ.-1) THEN
  537.           INTERR(1)=IB
  538.           CALL ERREUR(240)
  539.           GOTO 9941
  540.         ENDIF
  541. c
  542. c     on cherche les coeff des mat de hooke
  543. c
  544.         MPTVAL=IVAMAT
  545.         IF(IMAT.EQ.2) THEN
  546.           IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  547.             MELVAL=IVAL(1)
  548.             IBMN=MIN(IB  ,IELCHE(/2))
  549.             IGMN=MIN(IGAU,IELCHE(/1))
  550.             MLREEL=IELCHE(IGMN,IBMN)
  551.             SEGACT MLREEL
  552.             CALL DOHOOO(PROG,LHOOK,DDHOOK)
  553.             SEGDES MLREEL
  554.           ENDIF
  555.         ELSE IF (IMAT.EQ.1) THEN
  556.           DO 9041 IM=1,NMATT
  557.             IF (IVAL(IM).NE.0) THEN
  558.               MELVAL=IVAL(IM)
  559.               IBMN=MIN(IB  ,VELCHE(/2))
  560.               IGMN=MIN(IGAU,VELCHE(/1))
  561.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  562.             ELSE
  563.               VALMAT(IM)=0.D0
  564.             ENDIF
  565.  9041     CONTINUE
  566.          IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  567.      1    CALL DOHCOE(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  568.         ENDIF
  569. c
  570. c     on calcule les contraintes pour le point de gauss
  571. c
  572.       CALL DBST (BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS )
  573. c
  574. c     on remplit les contraintes
  575. c
  576.       MPTVAL=IVASTR
  577.       DO 6041 ICOMP=1,NSTRS
  578.         MELVAL=IVAL(ICOMP)
  579.         IBMN=MIN(IB  ,VELCHE(/2))
  580.         VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  581.  6041 CONTINUE
  582. c
  583.  3042 CONTINUE
  584. c
  585.  3041 CONTINUE
  586.  
  587.       IF (IRTD.EQ.0) THEN
  588.        MOTERR(1:8)=CMATE
  589.        MOTERR(9:12)=NOMFR(MFR/2+1)
  590.        INTERR(1)=IFOUR
  591.        CALL ERREUR(81)
  592.       ENDIF
  593.  9941 CONTINUE
  594.       SEGSUP,WRK2,WRK3
  595.       SEGDES MINTE1
  596.       GOTO 510
  597. c____________________________________________________________________
  598. c
  599. c     element coq2
  600. c____________________________________________________________________
  601. c
  602.    44 CONTINUE
  603.       NBNO=NBNN
  604.       SEGINI WRK2
  605.  
  606.       NDDD=NDEP
  607.       IF (IFOUR.EQ.-3) NDDD=NDEP-3
  608.  
  609.       DO 3044 IB=1,NBELEM
  610. c
  611. c     on cherche les deplacements
  612. c
  613.       MPTVAL=IVADEP
  614.       IE=1
  615.       DO 5043 IGAU=1,NBNN
  616.       DO 5044 ICOMP=1,NDDD
  617.         MELVAL=IVAL(ICOMP)
  618.         IGMN=MIN(IGAU,VELCHE(/1))
  619.         IBMN=MIN(IB  ,VELCHE(/2))
  620.         XDDL(IE)=VELCHE(IGMN,IBMN)
  621.         IE=IE+1
  622.  5044 CONTINUE
  623.  5043 CONTINUE
  624.          IF (IFOUR.EQ.-3) THEN
  625.                XDDL(IE)=UZDPG
  626.                XDDL(IE+1)=RYDPG
  627.                XDDL(IE+2)=RXDPG
  628.          ENDIF
  629. c
  630. c     on cherche les coordonnees des noeuds de l'element ib
  631. c
  632.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  633.  
  634.        IF (IFOUR.EQ.1.AND.IDIM.EQ.3) THEN
  635. c jk148537 assume 1->r 3->z 
  636.          do in=1,nbnn
  637.            xe(2,in) = xe(3,in)
  638.          enddo
  639.        ENDIF
  640. c
  641. c     on cherche les epaisseurs et les excentrements,
  642. c     on les moyenne sur l'element.
  643. c
  644.       EPAIST=0.D0
  645.       MPTVAL=IVACAR
  646.       MELVAL=IVAL(1)
  647.       IF (MELVAL.NE.0) THEN
  648.       DO IGAU=1,NBPGAU
  649.           IGMN=MIN(IGAU,VELCHE(/1))
  650.           IBMN=MIN(IB,VELCHE(/2))
  651.           EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  652.       ENDDO
  653.       EPAIST=EPAIST/NBPGAU
  654.       ENDIF
  655. *
  656.       EXCEN=0.D0
  657.       MELVAL=IVAL(2)
  658.       IF (MELVAL.NE.0) THEN
  659.       DO IGAU=1,NBPGAU
  660.           IGMN=MIN(IGAU,VELCHE(/1))
  661.           IBMN=MIN(IB,VELCHE(/2))
  662.           EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  663.       ENDDO
  664.       EXCEN=EXCEN/NBPGAU
  665.       ENDIF
  666. c
  667. c     boucle sur les points de gauss
  668. c
  669.       DO 4044 IGAU=1,NBPGAU
  670. c
  671. c     appel a bcoq2
  672. c
  673.       CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  674.      .           EXCEN,1.D0,IRR,XDPGE,YDPGE)
  675. c
  676. c     gestion d'erreur
  677. c
  678.       IF (IRR.EQ.1) THEN
  679.         INTERR(1)=IB
  680.         CALL ERREUR(255)
  681.         GOTO 9944
  682.       ELSE IF (IRR.EQ.2) THEN
  683.         INTERR(1)=IB
  684.         CALL ERREUR(256)
  685.         GOTO 9944
  686.       ENDIF
  687. c
  688. c     matrice de hooke
  689. c
  690.       MPTVAL=IVAMAT
  691.       IF(IMAT.EQ.2) THEN
  692.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  693.           MELVAL=IVAL(1)
  694.           IBMN=MIN(IB  ,IELCHE(/2))
  695.           MLREEL=IELCHE(1,IBMN)
  696.           SEGACT MLREEL
  697.           CALL DOHOOO(PROG,LHOOK,DDHOMU)
  698.           SEGDES MLREEL
  699.         ENDIF
  700.       ELSE IF (IMAT.EQ.1) THEN
  701.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  702.           DO 1044 IM=1,NMATT
  703.             IF (IVAL(IM).NE.0) THEN
  704.               MELVAL=IVAL(IM)
  705.               IBMN=MIN(IB  ,VELCHE(/2))
  706.               VALMAT(IM)=VELCHE(1,IBMN)
  707.             ELSE
  708.               VALMAT(IM)=0.D0
  709.             ENDIF
  710.  1044     CONTINUE
  711.           CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  712.         ENDIF
  713.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  714.       ENDIF
  715. c
  716. c  on va s\E9parer l'appel \E0 DBST en 3 parties :
  717. c    - multiplication de B * DDL
  718. c    - rajout \E9ventuel de termes quadratiques
  719. c    - multiplication des deformations par la matrice de Hooke
  720. c
  721. c     CALL DBST(BGENE,DDHOMU,XDDL,LRE,NSTRS,XSTRS)
  722. c
  723.       CALL BST(BGENE,XDDL,LRE,NSTRS,XSTRS)
  724.  
  725.       IF(IREPS2.EQ.1)
  726.      +call b2coq2(xstrs,nstrs,xddl,nbnn*ndep,xe,nbnn,QSIGAU,POIGAU,igau)
  727.  
  728.       call dxdefo(ddhomu,nstrs,xstrs)
  729. c
  730. c     remplissage du segment contenant les contraintes
  731. c
  732.       MPTVAL=IVASTR
  733.       DO 9044 ICOMP=1,NSTRS
  734.           MELVAL=IVAL(ICOMP)
  735.           IGMN=MIN(IGAU,VELCHE(/1))
  736.           IBMN=MIN(IB  ,VELCHE(/2))
  737.           VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  738.  9044 CONTINUE
  739.  4044 CONTINUE
  740.  3044 CONTINUE
  741. c
  742.       IF (IRTD.EQ.0) THEN
  743.        MOTERR(1:8)=CMATE
  744.        MOTERR(9:12)=NOMFR(MFR/2+1)
  745.        INTERR(1)=IFOUR
  746.        CALL ERREUR(81)
  747.       ENDIF
  748.  9944 CONTINUE
  749.       SEGSUP,WRK2
  750.       GOTO 510
  751. c____________________________________________________________________
  752. c
  753. c     element coq4
  754. c____________________________________________________________________
  755. c
  756.    49 CONTINUE
  757.       NBNO=NBNN
  758.       SEGINI WRK2,WRK4
  759.       DO 3049 IB=1,NBELEM
  760. c
  761. c     on cherche les deplacements
  762. c
  763.       MPTVAL=IVADEP
  764.       IE=1
  765.       DO 5049 IGAU=1,NBNN
  766.       DO 5048 ICOMP=1,NDEP
  767.         MELVAL=IVAL(ICOMP)
  768.         IGMN=MIN(IGAU,VELCHE(/1))
  769.         IBMN=MIN(IB  ,VELCHE(/2))
  770.         XDDL(IE)=VELCHE(IGMN,IBMN)
  771.         IE=IE+1
  772.  5048 CONTINUE
  773.  5049 CONTINUE
  774. c
  775. c     on cherche les coordonnees des noeuds de l'element ib
  776. c
  777.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  778. c
  779.       CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  780. c     iert=1 nodi  troppo vicini
  781.       IF (IERT.EQ.1) THEN
  782.          INTERR(1)=IB
  783.          CALL ERREUR(323)
  784.          GOTO 9949
  785.       ELSE IF (IERT.EQ.3) THEN
  786.          IERT = 0
  787.          NOPLAN = 1
  788.       ELSE
  789.          NOPLAN = 0
  790.       ENDIF
  791.       CALL MATVEC(XDDL,XDDLOC,BPSS,8)
  792. c
  793. c     on cherche les epaisseurs et les excentrements,
  794. c     on les moyenne sur l'element.
  795. c
  796.       MPTVAL=IVACAR
  797.       EPAIST=0.D0
  798.       MELVAL=IVAL(1)
  799.       IF (MELVAL.NE.0) THEN
  800.       DO IGAU=1,NBPGAU
  801.           IGMN=MIN(IGAU,VELCHE(/1))
  802.           IBMN=MIN(IB,VELCHE(/2))
  803.           EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  804.       ENDDO
  805.       EPAIST=EPAIST/NBPGAU
  806.       ENDIF
  807. *
  808.       EXCEN=0.D0
  809.       MELVAL=IVAL(2)
  810.       IF (MELVAL.NE.0) THEN
  811.       DO IGAU=1,NBPGAU
  812.           IGMN=MIN(IGAU,VELCHE(/1))
  813.           IBMN=MIN(IB,VELCHE(/2))
  814.           EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  815.       ENDDO
  816.       EXCEN=EXCEN/NBPGAU
  817.       ENDIF
  818. c
  819. c     boucle sur les points de gauss
  820. c
  821.       DO 4049 IGAU=1,NBPGAU
  822. c
  823. c     appel a bcoq4
  824. c
  825.       if(cmate.eq.'ISOTROPE') then
  826.       CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  827.       else
  828.       CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IERT,1)
  829.       endif
  830. c     iert=1 jacobiano <= 0
  831.       IF (IERT.EQ.1) THEN
  832.          INTERR(1)=IB
  833.          CALL ERREUR(321)
  834.          GOTO 9949
  835.       ENDIF
  836. c
  837. c     matrice de hooke
  838. c
  839.       MPTVAL=IVAMAT
  840.       IF(IMAT.EQ.2) THEN
  841.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  842.           MELVAL=IVAL(1)
  843.           IBMN=MIN(IB  ,IELCHE(/2))
  844.           MLREEL=IELCHE(1,IBMN)
  845.           SEGACT MLREEL
  846.           CALL DOHOOO(PROG,LHOOK,DDHOMU)
  847.           SEGDES MLREEL
  848.         ENDIF
  849.       ELSE IF (IMAT.EQ.1) THEN
  850.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  851.           DO 1049 IM=1,NMATT
  852.             IF (IVAL(IM).NE.0) THEN
  853.               MELVAL=IVAL(IM)
  854.               IBMN=MIN(IB  ,VELCHE(/2))
  855.               VALMAT(IM)=VELCHE(1,IBMN)
  856.             ELSE
  857.               VALMAT(IM)=0.D0
  858.             ENDIF
  859.  1049     CONTINUE
  860.           CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  861.         ENDIF
  862.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  863.       ENDIF
  864. c
  865.       CALL DBST(BGENE,DDHOMU,XDDLOC,LRE,NSTRS,XSTRS)
  866. c
  867. c     remplissage du segment contenant les contraintes
  868. c
  869.       MPTVAL=IVASTR
  870.       DO 9049 ICOMP=1,NSTRS
  871.         MELVAL=IVAL(ICOMP)
  872.         IGMN=MIN(IGAU,VELCHE(/1))
  873.         IBMN=MIN(IB  ,VELCHE(/2))
  874.         VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  875.  9049 CONTINUE
  876.  4049 CONTINUE
  877.  3049 CONTINUE
  878. c
  879.       IF(IRTD.EQ.0) THEN
  880.        MOTERR(1:8)=CMATE
  881.        MOTERR(9:12)=NOMFR(MFR/2+1)
  882.        INTERR(1)=IFOUR
  883.        CALL ERREUR(81)
  884.       ENDIF
  885.  9949 CONTINUE
  886.       SEGSUP,WRK2,WRK4
  887.       GOTO 510
  888. c____________________________________________________________________
  889. c
  890. c     element joint joi2
  891. c____________________________________________________________________
  892. c
  893.    85 CONTINUE
  894.       NBNO=NBNN
  895.       SEGINI WRK2,WRK4
  896. c
  897.       DO 3085 IB=1,NBELEM
  898. c
  899. c     on cherche les deplacements
  900. c
  901.       MPTVAL=IVADEP
  902.       IE=1
  903.       DO 5085 IGAU=1,NBNN
  904.       DO 5086 ICOMP=1,NDEP
  905.         MELVAL=IVAL(ICOMP)
  906.         IGMN=MIN(IGAU,VELCHE(/1))
  907.         IBMN=MIN(IB  ,VELCHE(/2))
  908.         XDDL(IE)=VELCHE(IGMN,IBMN)
  909.         IE=IE+1
  910.  5086 CONTINUE
  911.  5085 CONTINUE
  912. c
  913. c     on cherche les coordonnees des noeuds de l'element ib
  914. c
  915.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  916. c
  917.       CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  918. c
  919. c-----------------------------------------------------------------
  920. c      je n'ai pas besoin de transformer les deplacements
  921. c      dans le repere local car la matrice b est un operateur qui
  922. c      s'applique sur une quantite globale, u, pour donner une
  923. c      quantite locale, epsilon ; ceci, du fait de la presence
  924. c      de la matrice teta dans l'expression de b. si cela est vrai,
  925. c      alors il n'est pas necessaire d'appeler matvec.
  926. c      il faudra simplement appeler dbst avec xddl et non pas avec
  927. c      xddloc.
  928. c-----------------------------------------------------------------
  929. ccccccccc      call matvec(xddl,xddloc,bpss,8)
  930. c
  931. c     boucle sur les points de gauss
  932. c
  933.       DO 4085 IGAU=1,NBPGAU
  934. c
  935. c     appel a bjo2 pour le calcul de b
  936. c
  937.       CALL BJO2(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  938.      .                                 BGENE,DJAC,IRRT)
  939. c     irrt=1 jacobien <= 0
  940.       IF (IRRT.NE.0) THEN
  941.         INTERR(1)=IB
  942.         CALL ERREUR(612)
  943.         GOTO 9985
  944.       ENDIF
  945. c
  946. c     matrice de hooke
  947. c
  948.       MPTVAL=IVAMAT
  949.       IF(IMAT.EQ.2) THEN
  950.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  951.           MELVAL=IVAL(1)
  952.           IBMN=MIN(IB  ,IELCHE(/2))
  953.           MLREEL=IELCHE(1,IBMN)
  954.           SEGACT MLREEL
  955.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  956.           SEGDES MLREEL
  957.         ENDIF
  958.       ELSE IF (IMAT.EQ.1) THEN
  959.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  960.           DO 1085 IM=1,NMATT
  961.             IF (IVAL(IM).NE.0) THEN
  962.               MELVAL=IVAL(IM)
  963.               IBMN=MIN(IB  ,VELCHE(/2))
  964.               VALMAT(IM)=VELCHE(1,IBMN)
  965.             ELSE
  966.               VALMAT(IM)=0.D0
  967.             ENDIF
  968.  1085     CONTINUE
  969.           CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  970.         ENDIF
  971.       ENDIF
  972. c
  973.       CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  974. c
  975. c     remplissage du segment contenant les contraintes
  976. c
  977.       MPTVAL=IVASTR
  978.       DO 9085 ICOMP=1,NSTRS
  979.         MELVAL=IVAL(ICOMP)
  980.         IGMN=MIN(IGAU,VELCHE(/1))
  981.         IBMN=MIN(IB  ,VELCHE(/2))
  982.         VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  983.  9085 CONTINUE
  984.  4085 CONTINUE
  985.  3085 CONTINUE
  986. c
  987.       IF(IRTD.EQ.0) THEN
  988.        MOTERR(1:8)=CMATE
  989.        MOTERR(9:12)=NOMFR(MFR/2+1)
  990.        INTERR(1)=IFOUR
  991.        CALL ERREUR(81)
  992.       ENDIF
  993.  9985 CONTINUE
  994.       SEGSUP,WRK2,WRK4
  995.       GOTO 510
  996. c____________________________________________________________________
  997. c
  998. c     element joint jgi2
  999. c____________________________________________________________________
  1000. c
  1001.   170 CONTINUE
  1002.       NBNO=NBNN
  1003.       SEGINI WRK2,WRK4
  1004.  
  1005.       NDDD=NDEP
  1006.       IF (IFOUR.EQ.-3) NDDD=NDEP-3
  1007.  
  1008.       EPAIST=0.D0
  1009.  
  1010.       DO IB=1,NBELEM
  1011. c
  1012. c     on cherche les deplacements
  1013. c
  1014.         MPTVAL=IVADEP
  1015.         IE=1
  1016.         DO IGAU=1,NBNN
  1017.           DO ICOMP=1,NDDD
  1018.             MELVAL=IVAL(ICOMP)
  1019.             IGMN=MIN(IGAU,VELCHE(/1))
  1020.             IBMN=MIN(IB  ,VELCHE(/2))
  1021.             XDDL(IE)=VELCHE(IGMN,IBMN)
  1022.             IE=IE+1
  1023.           ENDDO
  1024.         ENDDO
  1025.         IF (IFOUR.EQ.-3) THEN
  1026.             XDDL(IE)=UZDPG
  1027.             XDDL(IE+1)=RYDPG
  1028.             XDDL(IE+2)=RXDPG
  1029.         ENDIF
  1030. c
  1031. c     on cherche les coordonnees des noeuds de l'element ib
  1032. c
  1033.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1034. c
  1035.         CALL JO2LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1036. c
  1037. c     boucle sur les points de gauss
  1038. c
  1039.         DO IGAU=1,NBPGAU
  1040. c
  1041. c     on cherche l'epaisseur du joint
  1042. c
  1043.           MPTVAL=IVACAR
  1044.           MELVAL=IVAL(1)
  1045.           IF (MELVAL.NE.0) THEN
  1046.             IGMN=MIN(IGAU,VELCHE(/1))
  1047.             IBMN=MIN(IB,VELCHE(/2))
  1048.             EPAIST=VELCHE(IGMN,IBMN)
  1049.           ENDIF
  1050. c
  1051. c     appel a bjo2 pour le calcul de b
  1052. c
  1053. CcPPj     CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1054. CcPPj.                EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  1055.           CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  1056.      .                EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
  1057. c     irrt=1 jacobien <= 0
  1058.           IF(IRRT.NE.0) THEN
  1059.             INTERR(1)=IB
  1060.             CALL ERREUR(612)
  1061.             GOTO 9970
  1062.           ENDIF
  1063. c
  1064. c     matrice de hooke
  1065. c
  1066.           MPTVAL=IVAMAT
  1067.           IF(IMAT.EQ.2) THEN
  1068.             IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1069.              MELVAL=IVAL(1)
  1070.              IBMN=MIN(IB  ,IELCHE(/2))
  1071.              MLREEL=IELCHE(1,IBMN)
  1072.              SEGACT MLREEL
  1073.              CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1074.              SEGDES MLREEL
  1075.             ENDIF
  1076.           ELSE IF (IMAT.EQ.1) THEN
  1077.            IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1078.             DO IM=1,NMATT
  1079.               IF (IVAL(IM).NE.0) THEN
  1080.                 MELVAL=IVAL(IM)
  1081.                 IBMN=MIN(IB  ,VELCHE(/2))
  1082.                 VALMAT(IM)=VELCHE(1,IBMN)
  1083.               ELSE
  1084.                 VALMAT(IM)=0.D0
  1085.               ENDIF
  1086.             ENDDO
  1087.             CALL DOGO88(VALMAT,CMATE,EPAIST,IFOUR,LHOOK,DDHOOK,IRTD)
  1088.            ENDIF
  1089.           ENDIF
  1090. c
  1091.           CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1092. c
  1093. c     remplissage du segment contenant les contraintes
  1094. c
  1095.           MPTVAL=IVASTR
  1096.           DO ICOMP=1,NSTRS
  1097.             MELVAL=IVAL(ICOMP)
  1098.             IGMN=MIN(IGAU,VELCHE(/1))
  1099.             IBMN=MIN(IB  ,VELCHE(/2))
  1100.             VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1101.           ENDDO
  1102.         ENDDO
  1103.       ENDDO
  1104. c
  1105.       IF(IRTD.EQ.0) THEN
  1106.        MOTERR(1:8)=CMATE
  1107.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1108.        INTERR(1)=IFOUR
  1109.        CALL ERREUR(81)
  1110.       ENDIF
  1111.  9970 CONTINUE
  1112.       SEGSUP,WRK2,WRK4
  1113.       GOTO 510
  1114. c____________________________________________________________________
  1115. c
  1116. c     element joint jct3 Pour le moment en 2D cisaillement
  1117. c____________________________________________________________________
  1118. c
  1119.   168 CONTINUE
  1120.       NBNO=NBNN
  1121.       SEGINI WRK2,WRK4
  1122.       IF(CMATE.NE.'ISOTROPE')THEN
  1123.          MPTVAL=IVAMAT
  1124.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1125.             MELVAL=IVAL(4)
  1126.          ELSE
  1127.             MELVAL=IVAL(2)
  1128.          ENDIF
  1129.          NBGCOS=VELCHE(/1)
  1130.       ENDIF
  1131.  
  1132.       DO IB=1,NBELEM
  1133. c
  1134. c     on cherche les deplacements
  1135. c
  1136.         MPTVAL=IVADEP
  1137.         IE=1
  1138.         DO IGAU=1,NBNN
  1139.           DO ICOMP=1,NDEP
  1140.             MELVAL=IVAL(ICOMP)
  1141.             IGMN=MIN(IGAU,VELCHE(/1))
  1142.             IBMN=MIN(IB  ,VELCHE(/2))
  1143.             XDDL(IE)=VELCHE(IGMN,IBMN)
  1144.             IE=IE+1
  1145.           ENDDO
  1146.         ENDDO
  1147. c
  1148. c     on cherche les coordonnees des noeuds de l'element ib
  1149. c
  1150.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1151. c
  1152.         CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1153. c
  1154. c     boucle sur les points de gauss
  1155. c
  1156.         DO IGAU=1,NBPGAU
  1157. c
  1158. c     appel a bjt3 pour le calcul de b
  1159. c
  1160.           CALL BJT3C(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1161.      .                                 BGENE,DJAC,IRRT)
  1162. c     irrt=1 jacobien <= 0
  1163.           IF(IRRT.NE.0) THEN
  1164.             INTERR(1)=IB
  1165.             CALL ERREUR(611)
  1166.             GOTO 9968
  1167.           ENDIF
  1168. c
  1169. c     matrice de hooke
  1170. c
  1171.           MPTVAL=IVAMAT
  1172.           IF(IMAT.EQ.2) THEN
  1173.             IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1174.              MELVAL=IVAL(1)
  1175.              IBMN=MIN(IB  ,IELCHE(/2))
  1176.              MLREEL=IELCHE(1,IBMN)
  1177.              SEGACT MLREEL
  1178.              CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1179.              SEGDES MLREEL
  1180.             ENDIF
  1181.           ELSE IF (IMAT.EQ.1) THEN
  1182.            IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1183.             DO IM=1,NMATT
  1184.               IF (IVAL(IM).NE.0) THEN
  1185.                 MELVAL=IVAL(IM)
  1186.                 IBMN=MIN(IB  ,VELCHE(/2))
  1187.                 VALMAT(IM)=VELCHE(1,IBMN)
  1188.               ELSE
  1189.                 VALMAT(IM)=0.D0
  1190.               ENDIF
  1191.             ENDDO
  1192.             CALL DOCO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1193.            ENDIF
  1194.           ENDIF
  1195. c
  1196.           CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1197. c
  1198. c     remplissage du segment contenant les contraintes
  1199. c
  1200.           MPTVAL=IVASTR
  1201.           DO ICOMP=1,NSTRS
  1202.             MELVAL=IVAL(ICOMP)
  1203.             IGMN=MIN(IGAU,VELCHE(/1))
  1204.             IBMN=MIN(IB  ,VELCHE(/2))
  1205.             VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1206.           ENDDO
  1207.         ENDDO
  1208.       ENDDO
  1209. c
  1210.       IF(IRTD.EQ.0) THEN
  1211.        MOTERR(1:8)=CMATE
  1212.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1213.        INTERR(1)=IFOUR
  1214.        CALL ERREUR(81)
  1215.       ENDIF
  1216.  9968 CONTINUE
  1217.       SEGSUP,WRK2,WRK4
  1218.       GOTO 510
  1219. c____________________________________________________________________
  1220. c
  1221. c     element de joint generalise jgt3
  1222. c____________________________________________________________________
  1223. c
  1224.   171 CONTINUE
  1225.       NBNO=NBNN
  1226.       SEGINI WRK2,WRK4
  1227.       IF(CMATE.NE.'ISOTROPE')THEN
  1228.          MPTVAL=IVAMAT
  1229.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1230.             MELVAL=IVAL(4)
  1231.          ELSE
  1232.             MELVAL=IVAL(2)
  1233.          ENDIF
  1234.          NBGCOS=VELCHE(/1)
  1235.       ENDIF
  1236.  
  1237.       DO IB=1,NBELEM
  1238. c
  1239. c     on cherche les deplacements
  1240. c
  1241.         MPTVAL=IVADEP
  1242.         IE=1
  1243.         DO IGAU=1,NBNN
  1244.           DO ICOMP=1,NDEP
  1245.             MELVAL=IVAL(ICOMP)
  1246.             IGMN=MIN(IGAU,VELCHE(/1))
  1247.             IBMN=MIN(IB  ,VELCHE(/2))
  1248.             XDDL(IE)=VELCHE(IGMN,IBMN)
  1249.             IE=IE+1
  1250.           ENDDO
  1251.         ENDDO
  1252. c
  1253. c     on cherche les coordonnees des noeuds de l'element ib
  1254. c
  1255.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1256. c
  1257.         CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1258. c
  1259. c     boucle sur les points de gauss
  1260. c
  1261.         DO IGAU=1,NBPGAU
  1262. c
  1263. c     on cherche l'epaissuer du joint
  1264. c
  1265.           EPAIST=0.D0
  1266.           MPTVAL=IVACAR
  1267.           MELVAL=IVAL(1)
  1268.           IF (MELVAL.NE.0) THEN
  1269.             IGMN=MIN(IGAU,VELCHE(/1))
  1270.             IBMN=MIN(IB,VELCHE(/2))
  1271.             EPAIST=VELCHE(IGMN,IBMN)
  1272.           ENDIF
  1273. c
  1274. c     appel a bjt3 pour le calcul de b
  1275. c
  1276. CcPPj     CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1277.           CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,SHPTOT,SHPWRK,
  1278.      .                                EPAIST,BGENE,DJAC,IRRT)
  1279. c     irrt=1 jacobien <= 0
  1280.           IF (IRRT.NE.0) THEN
  1281.             INTERR(1)=IB
  1282.             CALL ERREUR(611)
  1283.             GOTO 9971
  1284.           ENDIF
  1285. c
  1286. c     matrice de hooke
  1287. c
  1288.           MPTVAL=IVAMAT
  1289.           IF(IMAT.EQ.2) THEN
  1290.             IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1291.               MELVAL=IVAL(1)
  1292.               IBMN=MIN(IB  ,IELCHE(/2))
  1293.               MLREEL=IELCHE(1,IBMN)
  1294.               SEGACT MLREEL
  1295.               CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1296.               SEGDES MLREEL
  1297.             ENDIF
  1298.           ELSE IF (IMAT.EQ.1) THEN
  1299.            IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1300.             DO IM=1,NMATT
  1301.               IF (IVAL(IM).NE.0) THEN
  1302.                 MELVAL=IVAL(IM)
  1303.                 IBMN=MIN(IB  ,VELCHE(/2))
  1304.                 VALMAT(IM)=VELCHE(1,IBMN)
  1305.               ELSE
  1306.                 VALMAT(IM)=0.D0
  1307.               ENDIF
  1308.             ENDDO
  1309.             CALL DOGO88(VALMAT,CMATE,EPAIST,IFOUR,LHOOK,DDHOOK,IRTD)
  1310.            ENDIF
  1311.           ENDIF
  1312. c
  1313.           CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1314. c
  1315. c     remplissage du segment contenant les contraintes
  1316. c
  1317.           MPTVAL=IVASTR
  1318.           DO ICOMP=1,NSTRS
  1319.             MELVAL=IVAL(ICOMP)
  1320.             IGMN=MIN(IGAU,VELCHE(/1))
  1321.             IBMN=MIN(IB  ,VELCHE(/2))
  1322.             VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1323.           ENDDO
  1324.         ENDDO
  1325.       ENDDO
  1326. c
  1327.       IF(IRTD.EQ.0) THEN
  1328.        MOTERR(1:8)=CMATE
  1329.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1330.        INTERR(1)=IFOUR
  1331.        CALL ERREUR(81)
  1332.       ENDIF
  1333.  9971 CONTINUE
  1334.       SEGSUP,WRK2,WRK4
  1335.       GOTO 510
  1336. c____________________________________________________________________
  1337. c
  1338. c     element joint jgi4 Pour le moment en 2D cisaillement
  1339. c____________________________________________________________________
  1340. c
  1341.   169 CONTINUE
  1342.       NBNO=NBNN
  1343.       SEGINI WRK2,WRK4
  1344.       IF(CMATE.NE.'ISOTROPE')THEN
  1345.          MPTVAL=IVAMAT
  1346.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1347.             MELVAL=IVAL(4)
  1348.          ELSE
  1349.             MELVAL=IVAL(2)
  1350.          ENDIF
  1351.          NBGCOS=VELCHE(/1)
  1352.       ENDIF
  1353. c
  1354.       DO IB=1,NBELEM
  1355. c
  1356. c     on cherche les deplacements
  1357. c
  1358.         MPTVAL=IVADEP
  1359.         IE=1
  1360.         DO IGAU=1,NBNN
  1361.           DO ICOMP=1,NDEP
  1362.             MELVAL=IVAL(ICOMP)
  1363.             IGMN=MIN(IGAU,VELCHE(/1))
  1364.             IBMN=MIN(IB  ,VELCHE(/2))
  1365.             XDDL(IE)=VELCHE(IGMN,IBMN)
  1366.             IE=IE+1
  1367.           ENDDO
  1368.         ENDDO
  1369. c
  1370. c     on cherche les coordonnees des noeuds de l'element ib
  1371. c
  1372.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1373. c
  1374.         CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1375. c
  1376. c     boucle sur les points de gauss
  1377. c
  1378.         DO IGAU=1,NBPGAU
  1379. c
  1380. c     appel a bjo4 pour le calcul de b
  1381. c
  1382.           CALL BJO4C(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1383. c     irrt=1 jacobien <= 0
  1384.           IF (IRRT.NE.0) THEN
  1385.             INTERR(1)=IB
  1386.             CALL ERREUR(611)
  1387.             GOTO 9969
  1388.           ENDIF
  1389. c
  1390. c     matrice de hooke
  1391. c
  1392.           MPTVAL=IVAMAT
  1393.           IF(IMAT.EQ.2) THEN
  1394.            IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1395.             MELVAL=IVAL(1)
  1396.             IBMN=MIN(IB  ,IELCHE(/2))
  1397.             MLREEL=IELCHE(1,IBMN)
  1398.             SEGACT MLREEL
  1399.             CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1400.             SEGDES MLREEL
  1401.            ENDIF
  1402.           ELSE IF (IMAT.EQ.1) THEN
  1403.            IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1404.             DO IM=1,NMATT
  1405.               IF (IVAL(IM).NE.0) THEN
  1406.                 MELVAL=IVAL(IM)
  1407.                 IBMN=MIN(IB  ,VELCHE(/2))
  1408.                 VALMAT(IM)=VELCHE(1,IBMN)
  1409.               ELSE
  1410.                 VALMAT(IM)=0.D0
  1411.               ENDIF
  1412.             ENDDO
  1413.             CALL DOCO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1414.            ENDIF
  1415.           ENDIF
  1416. c
  1417.           CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1418. c
  1419. c     remplissage du segment contenant les contraintes
  1420. c
  1421.           MPTVAL=IVASTR
  1422.           DO ICOMP=1,NSTRS
  1423.             MELVAL=IVAL(ICOMP)
  1424.             IGMN=MIN(IGAU,VELCHE(/1))
  1425.             IBMN=MIN(IB  ,VELCHE(/2))
  1426.             VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1427.           ENDDO
  1428.         ENDDO
  1429.       ENDDO
  1430. c
  1431.       IF(IRTD.EQ.0) THEN
  1432.        MOTERR(1:8)=CMATE
  1433.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1434.        INTERR(1)=IFOUR
  1435.        CALL ERREUR(81)
  1436.       ENDIF
  1437.  9969 CONTINUE
  1438.       SEGSUP,WRK2,WRK4
  1439.       GOTO 510
  1440. c____________________________________________________________________
  1441. c
  1442. c     element joint jgi4 Pour le moment en 2D cisaillement
  1443. c____________________________________________________________________
  1444. c
  1445.   172 CONTINUE
  1446.       NBNO=NBNN
  1447.       SEGINI WRK2,WRK4
  1448.       IF(CMATE.NE.'ISOTROPE')THEN
  1449.          MPTVAL=IVAMAT
  1450.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1451.             MELVAL=IVAL(4)
  1452.          ELSE
  1453.             MELVAL=IVAL(2)
  1454.          ENDIF
  1455.          NBGCOS=VELCHE(/1)
  1456.       ENDIF
  1457. c
  1458.       DO IB=1,NBELEM
  1459. c
  1460. c     on cherche les deplacements
  1461. c
  1462.         MPTVAL=IVADEP
  1463.         IE=1
  1464.         DO IGAU=1,NBNN
  1465.           DO ICOMP=1,NDEP
  1466.             MELVAL=IVAL(ICOMP)
  1467.             IGMN=MIN(IGAU,VELCHE(/1))
  1468.             IBMN=MIN(IB  ,VELCHE(/2))
  1469.             XDDL(IE)=VELCHE(IGMN,IBMN)
  1470.             IE=IE+1
  1471.           ENDDO
  1472.         ENDDO
  1473. c
  1474. c     on cherche les coordonnees des noeuds de l'element ib
  1475. c
  1476.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1477. c
  1478.         CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1479. c
  1480. c     boucle sur les points de gauss
  1481. c
  1482.         DO IGAU=1,NBPGAU
  1483. c
  1484. c     on cherche l'epaissuer du joint
  1485. c
  1486.           EPAIST=0.D0
  1487.           MPTVAL=IVACAR
  1488.           MELVAL=IVAL(1)
  1489.           IF (MELVAL.NE.0) THEN
  1490.             IGMN=MIN(IGAU,VELCHE(/1))
  1491.             IBMN=MIN(IB,VELCHE(/2))
  1492.             EPAIST=VELCHE(IGMN,IBMN)
  1493.           ENDIF
  1494. c
  1495. c     appel a bjo4 pour le calcul de b
  1496. c
  1497. CcPPj     CALL BJO4G(IGAU,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,IRRT)
  1498.           CALL BJO4G(IGAU,XE,XEL,BPSS,SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,
  1499.      .                                                          IRRT)
  1500. c     irrt=1 jacobien <= 0
  1501.           IF (IRRT.NE.0) THEN
  1502.             INTERR(1)=IB
  1503.             CALL ERREUR(611)
  1504.             GOTO 9972
  1505.           ENDIF
  1506. c
  1507. c     matrice de hooke
  1508. c
  1509.           MPTVAL=IVAMAT
  1510.           IF(IMAT.EQ.2) THEN
  1511.            IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1512.             MELVAL=IVAL(1)
  1513.             IBMN=MIN(IB  ,IELCHE(/2))
  1514.             MLREEL=IELCHE(1,IBMN)
  1515.             SEGACT MLREEL
  1516.             CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1517.             SEGDES MLREEL
  1518.            ENDIF
  1519.           ELSE IF (IMAT.EQ.1) THEN
  1520.            IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1521.             DO IM=1,NMATT
  1522.               IF (IVAL(IM).NE.0) THEN
  1523.                 MELVAL=IVAL(IM)
  1524.                 IBMN=MIN(IB  ,VELCHE(/2))
  1525.                 VALMAT(IM)=VELCHE(1,IBMN)
  1526.               ELSE
  1527.                 VALMAT(IM)=0.D0
  1528.               ENDIF
  1529.             ENDDO
  1530.             CALL DOGO88(VALMAT,CMATE,EPAIST,IFOUR,LHOOK,DDHOOK,IRTD)
  1531.            ENDIF
  1532.           ENDIF
  1533. c
  1534.           CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1535. c
  1536. c     remplissage du segment contenant les contraintes
  1537. c
  1538.           MPTVAL=IVASTR
  1539.           DO ICOMP=1,NSTRS
  1540.             MELVAL=IVAL(ICOMP)
  1541.             IGMN=MIN(IGAU,VELCHE(/1))
  1542.             IBMN=MIN(IB  ,VELCHE(/2))
  1543.             VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1544.           ENDDO
  1545.         ENDDO
  1546.       ENDDO
  1547. c
  1548.       IF(IRTD.EQ.0) THEN
  1549.        MOTERR(1:8)=CMATE
  1550.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1551.        INTERR(1)=IFOUR
  1552.        CALL ERREUR(81)
  1553.       ENDIF
  1554.  9972 CONTINUE
  1555.       SEGSUP,WRK2,WRK4
  1556.       GOTO 510
  1557. c____________________________________________________________________
  1558. c
  1559. c     element joint joi3 implementation sans test de planeite
  1560. c                                         et sans repere local
  1561. c____________________________________________________________________
  1562. c
  1563.    86 CONTINUE
  1564.       NBNO=NBNN
  1565.       SEGINI WRK2,WRK4
  1566. c
  1567.       DO 3086 IB=1,NBELEM
  1568. c
  1569. c     on cherche les deplacements
  1570. c
  1571.       MPTVAL=IVADEP
  1572.       IE=1
  1573.       DO 5087 IGAU=1,NBNN
  1574.       DO 5088 ICOMP=1,NDEP
  1575.         MELVAL=IVAL(ICOMP)
  1576.         IGMN=MIN(IGAU,VELCHE(/1))
  1577.         IBMN=MIN(IB  ,VELCHE(/2))
  1578.         XDDL(IE)=VELCHE(IGMN,IBMN)
  1579.         IE=IE+1
  1580.  5088 CONTINUE
  1581.  5087 CONTINUE
  1582. c
  1583. c     on cherche les coordonnees des noeuds de l'element ib
  1584. c
  1585.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1586. c
  1587. c     boucle sur les points de gauss
  1588. c
  1589.       DO 4086 IGAU=1,NBPGAU
  1590. c
  1591.       CALL JO3LOC(XE,SHPTOT,IGAU,NBNN,BPSS)
  1592. c
  1593. c     appel a bjo3 pour le calcul de b
  1594. c
  1595.       CALL BJO3(IGAU,MFR,IFOUR,NIFOUR,XE,BPSS,SHPTOT,SHPWRK,
  1596.      .                                BGENE,DJAC,IRRT)
  1597. c     irrt=1 jacobien <= 0
  1598.       IF (IRRT.NE.0) THEN
  1599.         INTERR(1)=IB
  1600.         CALL ERREUR(612)
  1601.         GOTO 9986
  1602.       ENDIF
  1603. c
  1604. c     matrice de hooke
  1605. c
  1606.       MPTVAL=IVAMAT
  1607.       IF(IMAT.EQ.2) THEN
  1608.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1609.           MELVAL=IVAL(1)
  1610.           IBMN=MIN(IB  ,IELCHE(/2))
  1611.           MLREEL=IELCHE(1,IBMN)
  1612.           SEGACT MLREEL
  1613.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1614.           SEGDES MLREEL
  1615.         ENDIF
  1616.       ELSE IF (IMAT.EQ.1) THEN
  1617.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1618.           DO 1086 IM=1,NMATT
  1619.             IF (IVAL(IM).NE.0) THEN
  1620.               MELVAL=IVAL(IM)
  1621.               IBMN=MIN(IB  ,VELCHE(/2))
  1622.               VALMAT(IM)=VELCHE(1,IBMN)
  1623.             ELSE
  1624.               VALMAT(IM)=0.D0
  1625.             ENDIF
  1626.  1086     CONTINUE
  1627.           CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1628.         ENDIF
  1629.       ENDIF
  1630. c
  1631.       CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1632. c
  1633. c     remplissage du segment contenant les contraintes
  1634. c
  1635.       MPTVAL=IVASTR
  1636.       DO 9086 ICOMP=1,NSTRS
  1637.         MELVAL=IVAL(ICOMP)
  1638.         IGMN=MIN(IGAU,VELCHE(/1))
  1639.         IBMN=MIN(IB  ,VELCHE(/2))
  1640.         VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1641.  9086 CONTINUE
  1642.  4086 CONTINUE
  1643.  3086 CONTINUE
  1644. c
  1645. c impression d'un eventuel message d'erreur
  1646. c
  1647.       IF(IRTD.EQ.0) THEN
  1648.        MOTERR(1:8)=CMATE
  1649.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1650.        INTERR(1)=IFOUR
  1651.        CALL ERREUR(81)
  1652.       ENDIF
  1653.  9986 CONTINUE
  1654.       SEGSUP,WRK2,WRK4
  1655.       GOTO 510
  1656. c____________________________________________________________________
  1657. c
  1658. c     element joint jot3
  1659. c____________________________________________________________________
  1660. c
  1661.    87 CONTINUE
  1662.       NBNO=NBNN
  1663.       SEGINI WRK2,WRK4
  1664.       IF(CMATE.NE.'ISOTROPE')THEN
  1665.          MPTVAL=IVAMAT
  1666.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1667.             MELVAL=IVAL(4)
  1668.          ELSE
  1669.             MELVAL=IVAL(2)
  1670.          ENDIF
  1671.          NBGCOS=VELCHE(/1)
  1672.       ENDIF
  1673. c
  1674.       DO 3087 IB=1,NBELEM
  1675. c
  1676. c     on cherche les deplacements
  1677. c
  1678.       MPTVAL=IVADEP
  1679.       IE=1
  1680.       DO 5090 IGAU=1,NBNN
  1681.       DO 5089 ICOMP=1,NDEP
  1682.         MELVAL=IVAL(ICOMP)
  1683.         IGMN=MIN(IGAU,VELCHE(/1))
  1684.         IBMN=MIN(IB  ,VELCHE(/2))
  1685.         XDDL(IE)=VELCHE(IGMN,IBMN)
  1686.         IE=IE+1
  1687.  5089 CONTINUE
  1688.  5090 CONTINUE
  1689. c
  1690. c     on cherche les coordonnees des noeuds de l'element ib
  1691. c
  1692.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1693. c
  1694.       CALL JT3LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1695. c
  1696. c-----------------------------------------------------------------
  1697. c      je ne pense pas avoir besoin de transformer les deplacements
  1698. c      dans le repere local car la matrice b est un operateur qui
  1699. c      s'applique sur une quantite globale, u, pour donner une
  1700. c      quantite locale, epsilon ; ceci, du fait de la presence
  1701. c      de la matrice teta dans l'expression de b. si cela est vrai,
  1702. c      alors il n'est pas necessaire d'appeler matvec.
  1703. c      il faudra simplement appeler dbst avec xddl et non pas avec
  1704. c      xddloc.
  1705. c-----------------------------------------------------------------
  1706. ccccccccc      call matvec(xddl,xddloc,bpss,8)
  1707. c
  1708. c     boucle sur les points de gauss
  1709. c
  1710.       DO 4087 IGAU=1,NBPGAU
  1711. c
  1712. c     appel a bjt3 pour le calcul de b
  1713. c
  1714.       CALL BJT3(IGAU,MFR,IFOUR,NIFOUR,XEL,BPSS,SHPTOT,SHPWRK,
  1715.      .                                 BGENE,DJAC,IRRT)
  1716. c     irrt=1 jacobien <= 0
  1717.       IF (IRRT.NE.0) THEN
  1718.         INTERR(1)=IB
  1719.         CALL ERREUR(611)
  1720.         GOTO 9987
  1721.       ENDIF
  1722. c
  1723. c     matrice de hooke
  1724. c
  1725.       MPTVAL=IVAMAT
  1726.       IF(IMAT.EQ.2) THEN
  1727.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1728.           MELVAL=IVAL(1)
  1729.           IBMN=MIN(IB  ,IELCHE(/2))
  1730.           MLREEL=IELCHE(1,IBMN)
  1731.           SEGACT MLREEL
  1732.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1733.           SEGDES MLREEL
  1734.         ENDIF
  1735.       ELSE IF (IMAT.EQ.1) THEN
  1736.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1737.           DO 1087 IM=1,NMATT
  1738.             IF (IVAL(IM).NE.0) THEN
  1739.               MELVAL=IVAL(IM)
  1740.               IBMN=MIN(IB  ,VELCHE(/2))
  1741.               VALMAT(IM)=VELCHE(1,IBMN)
  1742.             ELSE
  1743.               VALMAT(IM)=0.D0
  1744.             ENDIF
  1745.  1087     CONTINUE
  1746.           CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1747.         ENDIF
  1748.       ENDIF
  1749. c
  1750.       CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1751. c
  1752. c     remplissage du segment contenant les contraintes
  1753. c
  1754.       MPTVAL=IVASTR
  1755.       DO 9087 ICOMP=1,NSTRS
  1756.         MELVAL=IVAL(ICOMP)
  1757.         IGMN=MIN(IGAU,VELCHE(/1))
  1758.         IBMN=MIN(IB  ,VELCHE(/2))
  1759.         VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1760.  9087 CONTINUE
  1761.  4087 CONTINUE
  1762.  3087 CONTINUE
  1763. c
  1764.       IF(IRTD.EQ.0) THEN
  1765.        MOTERR(1:8)=CMATE
  1766.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1767.        INTERR(1)=IFOUR
  1768.        CALL ERREUR(81)
  1769.       ENDIF
  1770.  9987 CONTINUE
  1771.       SEGSUP,WRK2,WRK4
  1772.       GOTO 510
  1773. c____________________________________________________________________
  1774. c
  1775. c     element joint joi4
  1776. c____________________________________________________________________
  1777. c
  1778.    88 CONTINUE
  1779.       NBNO=NBNN
  1780.       SEGINI WRK2,WRK4
  1781.       IF(CMATE.NE.'ISOTROPE')THEN
  1782.          MPTVAL=IVAMAT
  1783.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1784.             MELVAL=IVAL(4)
  1785.          ELSE
  1786.             MELVAL=IVAL(2)
  1787.          ENDIF
  1788.          NBGCOS=VELCHE(/1)
  1789.       ENDIF
  1790.       DO 3088 IB=1,NBELEM
  1791. c
  1792. c     on cherche les deplacements
  1793. c
  1794.       MPTVAL=IVADEP
  1795.       IE=1
  1796.       DO 5091 IGAU=1,NBNN
  1797.       DO 5092 ICOMP=1,NDEP
  1798.         MELVAL=IVAL(ICOMP)
  1799.         IGMN=MIN(IGAU,VELCHE(/1))
  1800.         IBMN=MIN(IB  ,VELCHE(/2))
  1801.         XDDL(IE)=VELCHE(IGMN,IBMN)
  1802.         IE=IE+1
  1803.  5092 CONTINUE
  1804.  5091 CONTINUE
  1805. c
  1806. c     on cherche les coordonnees des noeuds de l'element ib
  1807. c
  1808.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1809. c
  1810.       CALL JO4LOC(XE,SHPTOT,NBNN,XEL,BPSS,NOQUAL)
  1811. c
  1812. c-----------------------------------------------------------------
  1813. c      je ne pense pas avoir besoin de transformer les deplacements
  1814. c      dans le repere local car la matrice b est un operateur qui
  1815. c      s'applique sur une quantite globale, u, pour donner une
  1816. c      quantite locale, epsilon ; ceci, du fait de la presence
  1817. c      de la matrice teta dans l'expression de b. si cela est vrai,
  1818. c      alors il n'est pas necessaire d'appeler matvec.
  1819. c      il faudra simplement appeler dbst avec xddl et non pas avec
  1820. c      xddloc.
  1821. c-----------------------------------------------------------------
  1822. ccccccccc      call matvec(xddl,xddloc,bpss,8)
  1823. c
  1824. c     boucle sur les points de gauss
  1825. c
  1826.       DO 4088 IGAU=1,NBPGAU
  1827. c
  1828. c     appel a bjo4 pour le calcul de b
  1829. c
  1830.       CALL BJO4(IGAU,XEL,BPSS,SHPTOT,SHPWRK,BGENE,DJAC,IRRT)
  1831. c     irrt=1 jacobien <= 0
  1832.       IF (IRRT.NE.0) THEN
  1833.          INTERR(1)=IB
  1834.          CALL ERREUR(611)
  1835.         GOTO 9988
  1836.       ENDIF
  1837. c
  1838. c     matrice de hooke
  1839. c
  1840.       MPTVAL=IVAMAT
  1841.       IF(IMAT.EQ.2) THEN
  1842.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1843.           MELVAL=IVAL(1)
  1844.           IBMN=MIN(IB  ,IELCHE(/2))
  1845.           MLREEL=IELCHE(1,IBMN)
  1846.           SEGACT MLREEL
  1847.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  1848.           SEGDES MLREEL
  1849.         ENDIF
  1850.       ELSE IF (IMAT.EQ.1) THEN
  1851.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1852.           DO 1088 IM=1,NMATT
  1853.             IF (IVAL(IM).NE.0) THEN
  1854.               MELVAL=IVAL(IM)
  1855.               IBMN=MIN(IB  ,VELCHE(/2))
  1856.               VALMAT(IM)=VELCHE(1,IBMN)
  1857.             ELSE
  1858.               VALMAT(IM)=0.D0
  1859.             ENDIF
  1860.  1088     CONTINUE
  1861.           CALL DOUO88(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  1862.         ENDIF
  1863.       ENDIF
  1864. c
  1865.       CALL DBST(BGENE,DDHOOK,XDDL,LRE,NSTRS,XSTRS)
  1866. c
  1867. c     remplissage du segment contenant les contraintes
  1868. c
  1869.       MPTVAL=IVASTR
  1870.       DO 9088 ICOMP=1,NSTRS
  1871.         MELVAL=IVAL(ICOMP)
  1872.         IGMN=MIN(IGAU,VELCHE(/1))
  1873.         IBMN=MIN(IB  ,VELCHE(/2))
  1874.         VELCHE(IGMN,IBMN)=XSTRS(ICOMP)
  1875.  9088 CONTINUE
  1876.  4088 CONTINUE
  1877.  3088 CONTINUE
  1878. c
  1879. c impression d'un eventuel message d'erreur
  1880.       IF(IRTD.EQ.0) THEN
  1881.        MOTERR(1:8)=CMATE
  1882.        MOTERR(9:12)=NOMFR(MFR/2+1)
  1883.        INTERR(1)=IFOUR
  1884.        CALL ERREUR(81)
  1885.       ENDIF
  1886.  9988 CONTINUE
  1887.       SEGSUP,WRK2,WRK4
  1888.       GOTO 510
  1889. c____________________________________________________________________
  1890. c
  1891. c     element dst
  1892. c____________________________________________________________________
  1893. c
  1894.   93  CONTINUE
  1895.       NBNO=NBNN
  1896.       SEGINI WRK2,WRK3,WRK4
  1897.       IF(CMATE.NE.'ISOTROPE')THEN
  1898.          MPTVAL=IVAMAT
  1899.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  1900.             MELVAL=IVAL(7)
  1901.          ELSE
  1902.             MELVAL=IVAL(2)
  1903.          ENDIF
  1904.          NBGCOS=VELCHE(/1)
  1905.       ENDIF
  1906. c
  1907.       DO 3093  IB=1,NBELEM
  1908. c
  1909. c     on cherche les deplacements
  1910. c
  1911.       MPTVAL=IVADEP
  1912.       IE=1
  1913.       DO 4093 IGAU=1,NBNN
  1914.       DO 4094 ICOMP=1,NDEP
  1915.         MELVAL=IVAL(ICOMP)
  1916.         IGMN=MIN(IGAU,VELCHE(/1))
  1917.         IBMN=MIN(IB  ,VELCHE(/2))
  1918.         XDDL(IE)=VELCHE(IGMN,IBMN)
  1919.         IE=IE+1
  1920.  4094 CONTINUE
  1921.  4093 CONTINUE
  1922. c
  1923. c     on cherche les coordonnees des noeuds de l'element ib
  1924. c
  1925.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  1926.       CALL VPAST(XE,BPSS)
  1927. c     bpss    stocke la matrice de passage
  1928.       CALL VCORLC (XE,XEL,BPSS)
  1929.       CALL MATVEC(XDDL,XDDLOC,BPSS,6)
  1930. c
  1931. c     on cherche les epaiseurs et on les moyenne,
  1932. c                les excentrements et on les moyenne.
  1933. c
  1934.       EPAIST=0.D0
  1935.       MPTVAL=IVACAR
  1936.       MELVAL=IVAL(1)
  1937.       IF (MELVAL.NE.0) THEN
  1938.       DO  IGAU=1,NBPGAU
  1939.           IGMN=MIN(IGAU,VELCHE(/1))
  1940.           IBMN=MIN(IB,VELCHE(/2))
  1941.           EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  1942.       ENDDO
  1943.       EPAIST=EPAIST/NBPGAU
  1944.       ENDIF
  1945. *
  1946.       EXCEN=0.D0
  1947.       MELVAL=IVAL(2)
  1948.       IF (MELVAL.NE.0) THEN
  1949.       DO  IGAU=1,NBPGAU
  1950.           IGMN=MIN(IGAU,VELCHE(/1))
  1951.           IBMN=MIN(IB,VELCHE(/2))
  1952.           EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  1953.       ENDDO
  1954.       EXCEN=EXCEN/NBPGAU
  1955.       ENDIF
  1956. c
  1957. c     boucle sur les points de gauss
  1958. c
  1959.       DO 5093  IGAU=1,NBPTEL
  1960. *
  1961. * dans le cas des mat\E9riaux orthotropes, les d\E9formations sont d'abord
  1962. * calcul\E9es dans le rep\E8re d'orthotropie (les formules utilis\E9es par les
  1963. * routines rcdst et bmfdst ne sont valables que dans ce rep\E8re); elles
  1964. * sont ensuite exprim\E9es dans le rep\E8re local de l'\E9l\E9ment.
  1965. *
  1966.       IF(IMAT.EQ.2)THEN
  1967.         IF(CMATE.NE.'ISOTROPE')THEN
  1968.           IF(IGAU.LE.NBGCOS)THEN
  1969.             MPTVAL=IVAMAT
  1970.             MELVAL=IVAL(2)
  1971.             IBMN=MIN(IB  ,VELCHE(/2))
  1972.             IGMN=MIN(IGAU,VELCHE(/1))
  1973.             COSA=VELCHE(IGMN,IBMN)
  1974.             MELVAL=IVAL(3)
  1975.             IBMN=MIN(IB  ,VELCHE(/2))
  1976.             IGMN=MIN(IGAU,VELCHE(/1))
  1977.             SINA=VELCHE(IGMN,IBMN)
  1978.           ENDIF
  1979.         ENDIF
  1980.       ENDIF
  1981. c
  1982. c     on cherche la matrice de hooke
  1983. c
  1984.       MPTVAL=IVAMAT
  1985.       IF(IMAT.EQ.2) THEN
  1986.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1987.           MELVAL=IVAL(1)
  1988.           IBMN=MIN(IB  ,IELCHE(/2))
  1989.           IGMN=MIN(IGAU,IELCHE(/1))
  1990.           MLREEL=IELCHE(IGMN,IBMN)
  1991.           SEGACT MLREEL
  1992.           CALL DOHOOO(PROG,LHOOK,DDHOMU)
  1993.           SEGDES MLREEL
  1994.           IF(CMATE.EQ.'ORTHOTRO')
  1995.      +         CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK)
  1996.         ENDIF
  1997.       ELSE IF (IMAT.EQ.1) THEN
  1998.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  1999.           DO 9193 IM=1,NMATT
  2000.             IF (IVAL(IM).NE.0) THEN
  2001.               MELVAL=IVAL(IM)
  2002.               IBMN=MIN(IB  ,VELCHE(/2))
  2003.               IGMN=MIN(IGAU,VELCHE(/1))
  2004.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  2005.             ELSE
  2006.               VALMAT(IM)=0.D0
  2007.             ENDIF
  2008.  9193     CONTINUE
  2009.           CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  2010.         ENDIF
  2011.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  2012.       ENDIF
  2013.       call zero(bgene,nstrs,lre)
  2014.       IF(CMATE.NE.'ISOTROPE')THEN
  2015.         IF(IGAU.LE.NBGCOS)THEN
  2016.           IF(IMAT.EQ.1) THEN
  2017.             COSA=VALMAT(7)
  2018.             SINA=VALMAT(8)
  2019.           ENDIF
  2020.           DO 1393 INO=1,NBNN
  2021.            XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  2022.            YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  2023.            XE(1,INO)=XX
  2024.            XE(2,INO)=YY
  2025.  1393     CONTINUE
  2026.          ENDIF
  2027. c
  2028. c     termes de la matrice de rigidite relatifs
  2029. c      aux cisaillements transverses
  2030. c
  2031.         CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  2032.      1                WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  2033. c
  2034. c     termes de la matrice b relatifs aux effets
  2035. c        de membrane et de flexion
  2036. c
  2037.          CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  2038.      1            WORK(1),WORK(10),WORK(19),BGENE,DUM)
  2039. *
  2040.          CALL ROTB(BGENE,NSTRS,COSA,SINA)
  2041.       ELSE
  2042. c
  2043. c     termes de la matrice b relatifs aux cisaillements transverses
  2044. c
  2045.          CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  2046.      1          WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  2047. c
  2048. c     termes de la matrice b relatifs aux effets
  2049. c        de membrane et de flexion
  2050. c
  2051.          CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  2052.      1            WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  2053.       ENDIF
  2054. *
  2055. *  on modifie la matrice b en cas d'excentrement
  2056. *
  2057.       IF (EXCEN.NE.0.D0) THEN
  2058.       DO 1593 IJL=1,3
  2059.       DO 1594 IJC=1,LRE
  2060.         BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  2061.  1594 CONTINUE
  2062.  1593 CONTINUE
  2063.       ENDIF
  2064. *
  2065.       CALL DBST(BGENE,DDHOMU,XDDLOC,LRE,NSTRS,XSTRS)
  2066. c
  2067. c     calcul des eps 2
  2068. c
  2069.       IF(IREPS2.EQ.1)THEN
  2070.        IF(CMATE.EQ.'ORTHOTRO')THEN
  2071.          CALL DBDST2(XE,DDHOMU,XDDLOC,IGAU,BGENE,CMATE,
  2072.      1                                 COSA,SINA,XSTRS)
  2073.        ELSE
  2074.          CALL DBDST2(XEL,DDHOMU,XDDLOC,IGAU,BGENE,CMATE,
  2075.      1                                 COSA,SINA,XSTRS)
  2076.        ENDIF
  2077.       ENDIF
  2078. *
  2079. *    changement de repere: ortho -> local
  2080. *
  2081.          IF(CMATE.EQ.'ORTHOTRO')
  2082.      1      CALL CHGREP2(COSA,SINA,XSTRS,0,1)
  2083. c
  2084. c     remplissage du segment contenant les contraintes
  2085. c
  2086.       MPTVAL=IVASTR
  2087.       DO 9093 ICOMP=1,NSTRS
  2088.         MELVAL=IVAL(ICOMP)
  2089.         IBMN=MIN(IB  ,VELCHE(/2))
  2090.         VELCHE(IGAU,IBMN)=XSTRS(ICOMP)
  2091.  9093 CONTINUE
  2092.  5093 CONTINUE
  2093.  3093 CONTINUE
  2094. c
  2095.       IF (IRTD.EQ.0) THEN
  2096.        MOTERR(1:8)=CMATE
  2097.        MOTERR(9:12)=NOMFR(MFR/2+1)
  2098.        INTERR(1)=IFOUR
  2099.        CALL ERREUR(81)
  2100.       ENDIF
  2101.  9993 CONTINUE
  2102.       SEGSUP,WRK2,WRK3,WRK4
  2103.       GOTO 510
  2104. c____________________________________________________________________
  2105. c____________________________________________________________________
  2106.    99 CONTINUE
  2107.       MOTERR(1:4)=NOMTP(MELE)
  2108.       MOTERR(9:12)='SIGM'
  2109.       CALL ERREUR(86)
  2110. *
  2111. c- Fin du sous-programme
  2112.   510 CONTINUE
  2113.       SEGSUP MVELCH,WRK1
  2114.  
  2115.       RETURN
  2116.       END
  2117.  
  2118.  
  2119.  
  2120.  

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