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

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