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

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