Télécharger la plaquette Cast3M


fr en

Télécharger rigi3.eso

Retour à la liste

Numérotation des lignes : 

rigi3

  1. C RIGI3     SOURCE    JK148537  24/12/11    21:15:08     12096          
  2.       SUBROUTINE RIGI3(MATE,MELE,IPMAIL,IPMINT,IPMIN1,NBPGAU,LRE,
  3.      &      NSTRS,IVAMAT,IVACAR,CMATE,MFR,NBGMAT,NELMAT,IMAT,
  4.      &       LHOOK,NMATT,LW,NPINT,IPMATR,IIPDPG)
  5. *---------------------------------------------------------------------*
  6. *        __________________________                                   *
  7. *        |                        |                                   *
  8. *        |  CALCUL DE LA RIGIDITE |                                   *
  9. *        |________________________|                                   *
  10. *                                                                     *
  11. *      coq3,dkt,coq4,coq8,coq2,dst
  12. *                                                                     *
  13. *---------------------------------------------------------------------*
  14. *                                                                     *
  15. *   ENTREES :                                                         *
  16. *   ________                                                          *
  17. *                                                                     *
  18. *        MATE     Numero du materiau                                  *
  19. *        MELE     Numero de l'element fini                            *
  20. *        IPMAIL   Pointeur sur un segment  MELEME                     *
  21. *        IPMINT   Pointeur sur un segment MINTE aux points de Gauss   *
  22. *        IPMIN1   pointeur sur un segment MINTE aux noeuds            *
  23. *        NBPGAU   Nombre de point d'integration pour la rigidite      *
  24. *        LRE      Nombre de ddl dans la matrice de rigidite           *
  25. *        NSTRS    Nombre de composante de contraintes/deformations    *
  26. *        IVAMAT   Pointeur sur un segment MPTVAL pour le materiau ou  *
  27. *                 pour une matrice de hooke                           *
  28. *        IVACAR   Pointeur sur un segment MPTVAL pour les caracteri-  *
  29. *                 stiques                                             *
  30. *        CMATE    Nom du materiau                                     *
  31. *        MFR      Numero de la formulation element fini               *
  32. *        NBGMAT   Taille maxi des melval du materiau (pt de gauss)    *
  33. *        NELMAT   Taille maxi des melval du materiau (No d'element)   *
  34. *        IMAT     (2 il y a une matrice de HOOKE,1 non  )             *
  35. *        NMATT    Nombre de composante de materiau (IMAT=1)           *
  36. *        NPINT    Nombre de points d'integration dans l'epaisseur
  37. *                 dans le cas des elements de coque integres
  38. *
  39. *                                                                     *
  40. *   SORTIES :                                                         *
  41. *   ________                                                          *
  42. *                                                                     *
  43. *        IPMATR   pointeur sur la rigidite de la sous-zone            *
  44. *                                                                     *
  45. *---------------------------------------------------------------------*
  46.       IMPLICIT INTEGER(I-N)
  47.       IMPLICIT REAL*8(A-H,O-Z)
  48. *
  49.  
  50. -INC PPARAM
  51. -INC CCOPTIO
  52. -INC CCHAMP
  53. -INC CCREEL
  54. *-
  55. -INC SMCHAML
  56. -INC SMINTE
  57. -INC SMELEME
  58. -INC SMRIGID
  59. -INC SMMODEL
  60. -INC SMCOORD
  61. -INC SMLREEL
  62. *
  63.       SEGMENT WRK1
  64.        REAL*8 DDHOOK(LHOOK,LHOOK) ,DDHOMU(LHOOK,LHOOK)
  65.        REAL*8 REL(LRE,LRE) , XE(3,NBBB)
  66.       ENDSEGMENT
  67. *
  68.       SEGMENT WRK2
  69.        REAL*8 SHPWRK(6,NBNO) ,BGENE(LHOOK,LRE)
  70.       ENDSEGMENT
  71. *
  72.       SEGMENT WRK3
  73.        REAL*8 WORK(LW)
  74.       ENDSEGMENT
  75. *
  76.       SEGMENT WRK4
  77.        REAL*8 BPSS(3,3) ,XEL(3,NBBB)
  78.       ENDSEGMENT
  79. *
  80.       SEGMENT WRK5
  81.        REAL*8   BGENE1(LHOOK,LRE),POIG(NBPGA1)
  82.       ENDSEGMENT
  83. *
  84.       SEGMENT,MVELCH
  85.          REAL*8 VALMAT(NV1)
  86.       ENDSEGMENT
  87. *
  88.       SEGMENT MPTVAL
  89.         INTEGER IPOS(NS)    ,NSOF(NS)
  90.         INTEGER      IVAL(NCOSOU)
  91.         CHARACTER*16 TYVAL(NCOSOU)
  92.       ENDSEGMENT
  93. *
  94.       CHARACTER*8 CMATE
  95. *
  96. *      write(6,*) 'entree dans rigi3 lhook',lhook
  97. *
  98. C   INITIALISATION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  99. C   DE LA SECTION EN DEFO PLANE GENERALISEE
  100.       IF (IIPDPG.GT.0) THEN
  101. C <- test equivalent ici a IFOUR.EQ.-3
  102. C        SEGACT MCOORD
  103.         IREF=(IIPDPG-1)*(IDIM+1)
  104.         XDPGE=XCOOR(IREF+1)
  105.         YDPGE=XCOOR(IREF+2)
  106.       ELSE
  107.         XDPGE=XZERO
  108.         YDPGE=XZERO
  109.       ENDIF
  110. *
  111.       MELEME=IPMAIL
  112.       NBNN=NUM(/1)
  113.       NBELEM=NUM(/2)
  114. *
  115.       NV1=NMATT
  116.       SEGINI,MVELCH
  117. *
  118.       XMATRI=IPMATR
  119. C*    NLIGRP=LRE
  120. C*    NLIGRD=LRE
  121. *
  122.       NHRM=NIFOUR
  123. *
  124.       MINTE=IPMINT
  125.       IRTD=1
  126. C
  127. C_______________________________________________________________________
  128. C
  129. C     NUMERO DES ETIQUETTES      :
  130. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  131. C     DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  132. C     5  CONTINUE
  133. C     ELEMENT 5   ETIQUETTES 1005 2005 3005 4005   ...
  134. C     44 CONTINUE
  135. C     ELEMENT 44  ETIQUETTES 1044 2044 3044 4044   ...
  136. C_______________________________________________________________________
  137. C
  138.       GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  139.      1      99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  140.      2      41,99,99,44,28,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  141.      3      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  142.      4      99,99,99,99,99,99,99,99,99,99,99,99,93,99,99,99,99),MELE
  143.       GOTO 99
  144. C_______________________________________________________________________
  145. C
  146. C     ELEMENT COQ3
  147. C_______________________________________________________________________
  148. C
  149.   27  CONTINUE
  150.       NBBB=NBNN
  151.       SEGINI WRK1,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 COORDONNEES DES NOEUDS DE L ELEMENT IB
  158. C
  159.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  160. C
  161. C     ON CHERCHE LES COEFF DES MAT DE HOOKE
  162. C
  163.       MPTVAL=IVAMAT
  164.       IF(IMAT.EQ.2) THEN
  165.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1) THEN
  166.           MELVAL=IVAL(1)
  167.           IBMN=MIN(IB  ,IELCHE(/2))
  168.           MLREEL=IELCHE(1,IBMN)
  169.           SEGACT MLREEL
  170.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  171.           SEGDES MLREEL
  172.         ENDIF
  173.       ELSE IF (IMAT.EQ.1) THEN
  174.         DO 9027 IM=1,NMATT
  175.           IF (IVAL(IM).NE.0) THEN
  176.             MELVAL=IVAL(IM)
  177.             IBMN=MIN(IB  ,VELCHE(/2))
  178.             VALMAT(IM)=VELCHE(1,IBMN)
  179.           ELSE
  180.             VALMAT(IM)=0.D0
  181.           ENDIF
  182.  9027   CONTINUE
  183.         IF (IB.LE.NELMAT.OR.NBGMAT.GT.1)
  184.      1  CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  185.       ENDIF
  186. C
  187. C     CHERCHER LES EPAISSEUR ET EXCENTREMENT
  188. C
  189.       MPTVAL=IVACAR
  190.       MELVAL=IVAL(1)
  191.       IBMN=MIN(IB,VELCHE(/2))
  192.       EPAIST=VELCHE(1,IBMN)
  193.       IF (IVAL(2).NE.0) THEN
  194.         MELVAL=IVAL(2)
  195.         IBMN=MIN(IB,VELCHE(/2))
  196.         EXCEN =VELCHE(1,IBMN)
  197.         IF (EXCEN.NE.0.D0) THEN
  198.           CALL ERREUR(474)
  199.           GO TO 9927
  200.         ENDIF
  201.       ELSE
  202.         EXCEN=0.D0
  203.       ENDIF
  204. C
  205. C     ON CALCULE SA RAIDEUR
  206. C
  207.       CALL COQ3RI(REL,XE,EPAIST,DDHOOK,WORK)
  208. C
  209.  4027 CONTINUE
  210. C
  211. C     REMPLISSAGE DE XMATRI
  212. C
  213.       CALL REMPMT(REL,LRE,RE(1,1,ib))
  214.  3027 CONTINUE
  215.  
  216.       IF(IRTD.EQ.0) THEN
  217.         MOTERR(1:8)=CMATE
  218.         MOTERR(9:16)=NOMFR(MFR/2+1)
  219.         INTERR(1)=IFOUR
  220.         CALL ERREUR(81)
  221.       ENDIF
  222.  9927 CONTINUE
  223.       SEGSUP WRK1,WRK3
  224.       GOTO 510
  225. C_______________________________________________________________________
  226. C
  227. C     ELEMENT DKT
  228. C_______________________________________________________________________
  229. C
  230.   28  CONTINUE
  231.       NBNO=NBNN
  232.       NBBB=NBNN
  233.       SEGINI WRK1,WRK2,WRK4
  234.       IF(NPINT.NE.0)THEN
  235.         NBPGA1=NBPGAU/NPINT
  236.         IF(NBGMAT.NE.1)THEN
  237.          NBPGEP=NPINT
  238.         ELSE
  239.          NBPGEP=1
  240.         ENDIF
  241.         SEGINI WRK5
  242.         DO 1028 IG=1,NBPGA1
  243.          POIG(IG)=POIGAU(IG)
  244.  1028   CONTINUE
  245. Ccccc   CALL POIDNW(NPINT,NBPGA1,2,POIG)
  246.        CALL SIMPSN(NPINT,NBPGA1,2,POIG)
  247.       ENDIF
  248. C
  249.       DO 3028  IB=1,NBELEM
  250. C
  251. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  252. C
  253.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  254. C
  255.       CALL VPAST(XE,BPSS)
  256. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  257.       CALL VCORLC (XE,XEL,BPSS)
  258.       CALL ZERO (REL,LRE,LRE)
  259. C
  260. C     ON CHERCHE LES EPAISEURS ET ON LES MOYENNE,
  261. C                LES EXCENTREMENTS ET ON LES MOYENNE.
  262. C
  263.       MPTVAL=IVACAR
  264.       MELVAL=IVAL(1)
  265.       EPAIST=0.D0
  266.       IF (MELVAL.NE.0) THEN
  267.         DO IGAU=1,NBPGAU
  268.           IGMN=MIN(IGAU,VELCHE(/1))
  269.           IBMN=MIN(IB,VELCHE(/2))
  270.           EPAIST=EPAIST+VELCHE(IGMN,IBMN)
  271.         ENDDO
  272.         EPAIST=EPAIST/NBPGAU
  273.       ENDIF
  274. *
  275.       MELVAL=IVAL(2)
  276.       EXCEN=0.D0
  277.       IF (MELVAL.NE.0) THEN
  278.         DO IGAU=1,NBPGAU
  279.           IGMN=MIN(IGAU,VELCHE(/1))
  280.           IBMN=MIN(IB,VELCHE(/2))
  281.           EXCEN=EXCEN+VELCHE(IGMN,IBMN)
  282.         ENDDO
  283.         EXCEN=EXCEN/NBPGAU
  284.       ENDIF
  285. C
  286.       IF(NPINT.EQ.0)THEN
  287. C
  288. C     COQUE GLOBAL
  289. C
  290. C     BOUCLE SUR LES POINTS DE GAUSS
  291. C
  292.       DO 1128  IGAU=1,NBPGAU
  293. *
  294.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  295.      &            MELE,MFR,NBNO,LRE,IFOUR,NSTRS,0,1.D0,XEL,
  296.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  297.       DJAC=DJAC*POIGAU(IGAU)
  298. C
  299. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  300. C
  301.        IF (EXCEN.NE.0.) THEN
  302.       DO 1528 IJL=1,3
  303.       DO 1528 IJC=1,LRE
  304.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  305.  1528 CONTINUE
  306.        ENDIF
  307. C
  308. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  309. C
  310.       MPTVAL=IVAMAT
  311.       IF(IMAT.EQ.2) THEN
  312.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  313.           MELVAL=IVAL(1)
  314.           IBMN=MIN(IB  ,IELCHE(/2))
  315.           IGMN=MIN(IGAU,IELCHE(/1))
  316.           MLREEL=IELCHE(IGMN,IBMN)
  317.           SEGACT MLREEL
  318.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  319.           SEGDES MLREEL
  320.         ENDIF
  321.       CALL BDBS1(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  322.      1     IGAU,IMAT,EXCEN)
  323.       ELSE IF (IMAT.EQ.1) THEN
  324. *
  325.           DO 9028 IM=1,NMATT
  326.             IF (IVAL(IM).NE.0) THEN
  327.               MELVAL=IVAL(IM)
  328.               IBMN=MIN(IB  ,VELCHE(/2))
  329.               IGMN=MIN(IGAU,VELCHE(/1))
  330.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  331.             ELSE
  332.               VALMAT(IM)=0.D0
  333.             ENDIF
  334.  9028     CONTINUE
  335.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  336.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  337.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  338.         CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  339.      1     IGAU,IMAT,EXCEN)
  340.       ENDIF
  341.  1128 CONTINUE
  342. C
  343.       ELSE
  344. C
  345. C    COQUE INTEGREE
  346. C
  347. C     BOUCLE SUR LES POINTS DE GAUSS DE LA SURFACE
  348. C
  349.       DO 1101  IGAU=1,NBPGA1
  350. *
  351.       CALL BMAT28(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  352.      &            MELE,MFR,NBNO,LRE,IFOUR,LHOOK,0,1.D0,XEL,
  353.      &            SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  354. C
  355. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  356. C
  357.         IF (EXCEN.NE.0.) THEN
  358.       DO 1501 IJL=1,3
  359.       DO 1501 IJC=1,LRE
  360.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  361.  1501 CONTINUE
  362.         ENDIF
  363. C
  364. C   BOUCLE SUR LES NAPPES DANS L'EPAISSEUR
  365. C
  366.       DO 1102 INAP=1,NBPGEP
  367. C
  368.       IGAU1=(INAP-1)*NBPGA1+IGAU
  369. C
  370. C      CALCUL DE LA MATRICE B CORRESPONDANT AUX DEFORMATIONS 3D
  371. C
  372.       IF(NBGMAT.EQ.1.AND.NPINT.NE.1)THEN
  373.        ZZZ2 = SQRT( (EPAIST**3.D0)/12.D0 )
  374.        ZZZ1 = SQRT( EPAIST )
  375.        DO 1503 IJL=1,3
  376.        DO 1503 IJC=1,LRE
  377.          BGENE1(IJL,IJC)  =ZZZ1*BGENE(IJL,IJC)
  378.          BGENE1(IJL+3,IJC)=ZZZ2*BGENE(IJL+3,IJC)
  379.  1503  CONTINUE
  380.        DJAC1=DJAC*POIG(IGAU1)
  381.       ELSE
  382.        ZZZ=DZEGAU(IGAU1)*(EPAIST/2.D0)
  383.        DO 1502 IJL=1,3
  384.        DO 1502 IJC=1,LRE
  385.          BGENE1(IJL,IJC)=BGENE(IJL,IJC)
  386.          BGENE1(IJL+3,IJC)=ZZZ*BGENE(IJL+3,IJC)
  387.  1502  CONTINUE
  388.        DJAC1=DJAC*POIGAU(IGAU1)*(EPAIST/2.D0)
  389.       ENDIF
  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 DHDKTI(PROG,LHOOK,DDHOOK)
  402.           SEGDES MLREEL
  403. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  404.         ENDIF
  405.       ELSE IF (IMAT.EQ.1) THEN
  406.           DO 9001 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.  9001     CONTINUE
  416.         IF (IGAU1.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  417.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  418. *        write(6,*)((ddhook(IU,io),iu=1,6),io=1,6)
  419.       ENDIF
  420.       CALL BDBS1(BGENE1,DJAC1,DDHOOK,LRE,LHOOK,REL,MFR,IFOUR,MATE,
  421.      1     IGAU,IMAT,EXCEN)
  422.  1102 CONTINUE
  423.  1101 CONTINUE
  424.       ENDIF
  425.       REL(6,6)=REL(5,5)*1.D-7
  426.       REL(12,12)=REL(6,6)
  427.       REL(18,18)=REL(6,6)
  428.       ICOM=0
  429.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  430.      1  .OR. IMAT.EQ.2) ICOM=1
  431.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  432. C
  433. C     REMPLISSAGE DE XMATRI
  434. C
  435.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  436.  3028 CONTINUE
  437.       IF(IRTD.EQ.0) THEN
  438.         MOTERR(1:8)=CMATE
  439.         MOTERR(9:16)=NOMFR(MFR/2+1)
  440.        INTERR(1)=IFOUR
  441.        CALL ERREUR(81)
  442.       ENDIF
  443.       SEGSUP WRK1,WRK2,WRK4
  444.       IF(NPINT.NE.0)SEGSUP WRK5
  445.       GOTO 510
  446. C_______________________________________________________________________
  447. C
  448. C     ELEMENT COQ8
  449. C_______________________________________________________________________
  450. C
  451.   41  CONTINUE
  452.       NBBB=NBNN
  453.       NBNO=NBNN
  454.       SEGINI WRK1,WRK2,WRK3
  455.       MINTE1=IPMIN1
  456.       SEGACT MINTE1
  457.       NBPGA1=MINTE1.SHPTOT(/3)
  458.       NBN1  =MINTE1.SHPTOT(/2)
  459. C
  460. C     BOUCLE DE CALCUL POUR LES DIFFERENTS ELEMENTS
  461. C
  462.       DO  3041 IB=1,NBELEM
  463. C
  464. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  465. C
  466.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  467. C
  468.       CALL ZERO (REL,LRE,LRE)
  469. C
  470. C     ON CHERCHE LES EPAISSEURS ET LES EXCENTREMENTS.
  471. C
  472.       MPTVAL=IVACAR
  473.       DO 4041 IGAU=1,NBPGAU
  474.         MELVAL=IVAL(1)
  475.         IGMN=MIN(IGAU,VELCHE(/1))
  476.         IBMN=MIN(IB,VELCHE(/2))
  477.         WORK(IGAU)   =VELCHE(IGMN,IBMN)
  478.         IF (IVAL(2).NE.0) THEN
  479.           MELVAL=IVAL(2)
  480.           IGMN=MIN(IGAU,VELCHE(/1))
  481.           IBMN=MIN(IB,VELCHE(/2))
  482.           WORK(10+IGAU)=VELCHE(IGMN,IBMN)
  483.         ELSE
  484.           WORK(10+IGAU)=0.D0
  485.         ENDIF
  486.  4041 CONTINUE
  487. C
  488. C      DETERMINATION DES AXES LOCAUX AUX NOEUDS
  489. C
  490.        CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,WORK(21),IRR)
  491. C
  492. C       BOUCLE SUR LES POINTS DE GAUSS
  493. C
  494.        DO 3042  IGAU=1,NBPGAU
  495.         E3=DZEGAU(IGAU)
  496.         CALL BCOQ8E(IGAU,XE,NBNN,WORK(1),WORK(11),BGENE,DJAC,
  497.      1             E3,SHPTOT,WORK(21),IRR)
  498. C
  499. C     GESTION D'ERREUR: IRR=0 CORRESPOND A UN VECTEUR NUL (CF. CROSS2)
  500. C                       IRR=-1 CORRESPOND A UN JACOBIEN NUL(CF. SHLJAC)
  501. C
  502.        IF(IRR.EQ.0) THEN
  503.          CALL ERREUR(241)
  504.          GOTO 9941
  505.        ELSE IF(IRR.EQ.-1)THEN
  506.          CALL ERREUR(240)
  507.          GOTO 9941
  508.        ENDIF
  509. C
  510.        DJAC=ABS(DJAC)*POIGAU(IGAU)
  511. C
  512. C     ON CHERCHE LES COEFF DES MAT DE HOOKE
  513. C
  514.        MPTVAL=IVAMAT
  515.        IF(IMAT.EQ.2) THEN
  516.          IF ((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  517.            MELVAL=IVAL(1)
  518.            IBMN=MIN(IB  ,IELCHE(/2))
  519.            IGMN=MIN(IGAU,IELCHE(/1))
  520.            MLREEL=IELCHE(IGMN,IBMN)
  521.            SEGACT MLREEL
  522.            CALL DOHOOO(PROG,LHOOK,DDHOOK)
  523.            SEGDES MLREEL
  524.          ENDIF
  525.        ELSE IF (IMAT.EQ.1) THEN
  526.          DO 9041 IM=1,NMATT
  527.            IF (IVAL(IM).NE.0) THEN
  528.              MELVAL=IVAL(IM)
  529.              IBMN=MIN(IB  ,VELCHE(/2))
  530.              IGMN=MIN(IGAU,VELCHE(/1))
  531.              VALMAT(IM)=VELCHE(IGMN,IBMN)
  532.            ELSE
  533.              VALMAT(IM)=0.D0
  534.            ENDIF
  535.  9041    CONTINUE
  536.          IF((IGAU.LE.NBGMAT).AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  537.      1     CALL DOHCOE (VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  538.        ENDIF
  539. C
  540. C     ON CALCULE SA RAIDEUR
  541. C
  542.        CALL COQ8RI(BGENE,DJAC,DDHOOK,LRE,NBPGAU,IGAU,NBNN,REL)
  543. C
  544.  3042 CONTINUE
  545. C
  546. C     REMPLISSAGE DE XMATRI
  547. C
  548.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  549.  3041 CONTINUE
  550. c
  551.       IF(IRTD.EQ.0) THEN
  552.         MOTERR(1:8)=CMATE
  553.         MOTERR(9:16)=NOMFR(MFR/2+1)
  554.        INTERR(1)=IFOUR
  555.        CALL ERREUR(81)
  556.       ENDIF
  557.  9941 CONTINUE
  558.       SEGSUP WRK1,WRK2,WRK3
  559.       SEGDES MINTE1
  560.       GOTO 510
  561. C_______________________________________________________________________
  562. C
  563. C     SECTEUR DE CALCUL POUR LE COQ2
  564. C_______________________________________________________________________
  565. C
  566.   44  CONTINUE
  567.       DIM3=1.D0
  568.       NBNO=NBNN
  569.       NBBB=NBNN
  570.       SEGINI WRK1,WRK2,WRK4
  571.       DO 3044  IB=1,NBELEM
  572. C
  573. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  574. C
  575.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  576.       if (idim.eq.3.and.ifour.gt.0) then
  577.         do ii = 1,NBNN
  578.           jj=idimp1*(NUM(ii,IB)-1)
  579.           xel(1,ii) = xe(1,ii)
  580.           xel(2,ii) = xe(2,ii)
  581.           xel(3,ii) = xe(3,ii)
  582.           xe(2,ii) = xel(3,ii)
  583.           xe(3,ii) = XZero
  584.         enddo
  585.       endif
  586. C
  587.       CALL ZERO (REL,LRE,LRE)
  588. C
  589. C     BOUCLE SUR LES POINTS DE GAUSS
  590. C
  591.       DO 4044  IGAU=1,NBPGAU
  592.       MPTVAL=IVACAR
  593.       MELVAL=IVAL(1)
  594.       IBMN=MIN(IB,VELCHE(/2))
  595.       EPAIST=VELCHE(1,IBMN)
  596.       IF (IVAL(2).NE.0) THEN
  597.         MELVAL=IVAL(2)
  598.         IBMN=MIN(IB,VELCHE(/2))
  599.         EXCEN =VELCHE(1,IBMN)
  600.       ELSE
  601.         EXCEN=0.D0
  602.       ENDIF
  603.       IF (IFOUR.EQ.-2) THEN
  604.        IF (IVAL(3).NE.0) THEN
  605.         MELVAL=IVAL(3)
  606.         IBMN=MIN(IB,VELCHE(/2))
  607.         DIM3 =VELCHE(1,IBMN)
  608.        ELSE
  609.         DIM3=1.D0
  610.        ENDIF
  611.       ENDIF
  612. C
  613. C     APPEL A BCOQ2    ...
  614. C
  615.       CALL BCOQ2(BGENE,NSTRS,DJAC,IGAU,IFOUR,XE,NHRM,QSIGAU,POIGAU,
  616.      .           EXCEN,DIM3,IRRT,XDPGE,YDPGE)
  617. C
  618. C     GESTION D'ERREUR
  619. C        LES ERREURS PREVUES SONT LONGEUR DE L'ELEMENT =0 OU RAYON
  620. C        AU POINT D'INTEGRATION =0 OU RAPPORT R/L TROP PETIT (INFERIEUR
  621. C        A 1.E-3).
  622. C
  623.       IF(IRRT.EQ.1) THEN
  624.         INTERR(1)=IB
  625.         CALL ERREUR(255)
  626.         GOTO 9944
  627.       ELSE IF (IRRT.EQ.2) THEN
  628.         INTERR(1)=IB
  629.         CALL ERREUR(256)
  630.         GOTO 9944
  631.       ENDIF
  632. C
  633.       MPTVAL=IVAMAT
  634.       IF(IMAT.EQ.2) THEN
  635.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  636.           MELVAL=IVAL(1)
  637.           IBMN=MIN(IB  ,IELCHE(/2))
  638.           IGMN=MIN(IGAU,IELCHE(/1))
  639.           MLREEL=IELCHE(IGMN,IBMN)
  640.           SEGACT MLREEL
  641.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  642.           SEGDES MLREEL
  643.         ENDIF
  644.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  645.       ELSE IF (IMAT.EQ.1) THEN
  646. *
  647.           DO 9044 IM=1,NMATT
  648.             IF (IVAL(IM).NE.0) THEN
  649.               MELVAL=IVAL(IM)
  650.               IBMN=MIN(IB  ,VELCHE(/2))
  651.               IGMN=MIN(IGAU,VELCHE(/1))
  652.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  653.             ELSE
  654.               VALMAT(IM)=0.D0
  655.             ENDIF
  656.  9044     CONTINUE
  657.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  658.      1    CALL DOHCOM(VALMAT,NMATT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  659.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  660.         CALL BDBST(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL)
  661.       ENDIF
  662.  4044 CONTINUE
  663. C
  664. C     REMPLISSAGE DE XMATRI
  665. C
  666.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  667.  3044 CONTINUE
  668. C
  669. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  670.       IF(IRTD.EQ.0) THEN
  671.         MOTERR(1:8)=CMATE
  672.         MOTERR(9:16)=NOMFR(MFR/2+1)
  673.        INTERR(1)=IFOUR
  674.        CALL ERREUR(81)
  675.       ENDIF
  676.  9944 CONTINUE
  677.       SEGSUP WRK1,WRK2,WRK4
  678.       GOTO 510
  679. C_______________________________________________________________________
  680. C
  681. C     SECTEUR DE CALCUL POUR LE COQ4
  682. C_______________________________________________________________________
  683. C
  684.   49  CONTINUE
  685.       NBNO=NBNN
  686.       NBBB=NBNN
  687.       SEGINI WRK1,WRK2,WRK4
  688. c
  689. c ... Si le mat\E9riau n'est pas isotrope, dans le cas g\E9n\E9ral les
  690. c     tensions et le cisaillement NE sont PAS d\E9coupl\E9es. Ce qui veut
  691. c     dire qu'on n'a pas le droit de les int\E9grer diff\E9remment ...
  692. c
  693.       DO 3049  IB=1,NBELEM
  694. C
  695. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  696. C
  697.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  698. C
  699.       CALL ZERO (REL,LRE,LRE)
  700.       CALL CQ4LOC(XE,XEL,BPSS,IRRT,1)
  701. C     IRRT=1 NODI TROPPO VICINI
  702.       IF(IRRT.EQ.1) THEN
  703.          INTERR(1)=IB
  704.          CALL ERREUR(323)
  705.          GOTO 9949
  706.       ELSE IF(IRRT.EQ.3) THEN
  707.          IRRT = 0
  708.          NOPLAN = 1
  709.       ELSE
  710.          NOPLAN = 0
  711.       ENDIF
  712. C
  713. C     BOUCLE SUR LES POINTS DE GAUSS
  714. C
  715.       MPTVAL=IVACAR
  716.       MELVAL=IVAL(1)
  717.       IBMN=MIN(IB,VELCHE(/2))
  718.       EPAIST=VELCHE(1,IBMN)
  719.       IF (IVAL(2).NE.0) THEN
  720.         MELVAL=IVAL(2)
  721.         IBMN=MIN(IB,VELCHE(/2))
  722.         EXCEN =VELCHE(1,IBMN)
  723.       ELSE
  724.         EXCEN=0.D0
  725.       ENDIF
  726.       DO 4049  IGAU=1,NBPGAU
  727. C
  728. C     APPEL A BCOQ4
  729. C
  730.       if(cmate.eq.'ISOTROPE') then
  731.       CALL BCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  732.      +                                                         0)
  733.       else
  734.       CALL BCOQ4O(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,EXCEN,NOPLAN,IRRT,
  735.      +                                                         0)
  736.       endif
  737.       DJAC=DJAC*POIGAU(IGAU)
  738. C     IRRT=1 JACOBIANO <= 0
  739.       IF(IRRT.EQ.1) THEN
  740.          INTERR(1)=IB
  741.          CALL ERREUR(321)
  742.          GOTO 9949
  743.       ENDIF
  744. C
  745.       MPTVAL=IVAMAT
  746.       IF(IMAT.EQ.2) THEN
  747.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
  748.           MELVAL=IVAL(1)
  749.           IBMN=MIN(IB  ,IELCHE(/2))
  750.           IGMN=MIN(IGAU,IELCHE(/1))
  751.           MLREEL=IELCHE(IGMN,IBMN)
  752.           SEGACT MLREEL
  753.           CALL DOHOOO(PROG,LHOOK,DDHOOK)
  754.           SEGDES MLREEL
  755.         ENDIF
  756.         CALL BDBST(BGENE,DJAC,DDHOOK,LRE,NSTRS,REL)
  757.       ELSE IF (IMAT.EQ.1) THEN
  758. *
  759.           DO 9049 IM=1,NMATT
  760.             IF (IVAL(IM).NE.0) THEN
  761.               MELVAL=IVAL(IM)
  762.               IBMN=MIN(IB  ,VELCHE(/2))
  763.               IGMN=MIN(IGAU,VELCHE(/1))
  764.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  765.             ELSE
  766.               VALMAT(IM)=0.D0
  767.             ENDIF
  768.  9049     CONTINUE
  769.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  770.      1    CALL DOHCIS(VALMAT,CMATE,IFOUR,LHOOK,DDHOOK,IRTD)
  771.         CALL HOOKMU(EPAIST,0.D0,LHOOK,DDHOOK,DDHOMU)
  772.         if(cmate.eq.'ISOTROPE') then
  773.            CALL COQ4RI (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  774.         else
  775.            CALL COQ4RJ (IGAU,BGENE,DJAC,EXCEN,NOPLAN,DDHOMU,REL)
  776.         endif
  777.       ENDIF
  778.  4049 CONTINUE
  779. C
  780.       REL(6,6)=REL(5,5)*1.D-7
  781.       REL(12,12)=REL(6,6)
  782.       REL(18,18)=REL(6,6)
  783.       REL(24,24)=REL(6,6)
  784.       ICOM=0
  785.       IF(ABS(EXCEN).GT.XPETIT .OR.CMATE.EQ.'COMPOSIT'
  786.      1   .OR. IMAT.EQ.2) ICOM=1
  787.       CALL TRANSK(REL,BPSS,LRE,4,ICOM)
  788. C
  789. C     REMPLISSAGE DE XMATRI
  790. C
  791.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  792.  3049 CONTINUE
  793. C
  794. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  795.       IF(IRTD.EQ.0) THEN
  796.         MOTERR(1:8)=CMATE
  797.         MOTERR(9:16)=NOMFR(MFR/2+1)
  798.        INTERR(1)=IFOUR
  799.        CALL ERREUR(81)
  800.       ENDIF
  801.  9949 CONTINUE
  802.       SEGSUP WRK1,WRK2,WRK4
  803.       GOTO 510
  804. C_______________________________________________________________________
  805. C
  806. C     ELEMENT DST
  807. C_______________________________________________________________________
  808. C
  809.   93  CONTINUE
  810.       NBNO=NBNN
  811.       NBBB=NBNN
  812.       SEGINI WRK1,WRK2,WRK3,WRK4
  813.       IF(CMATE.NE.'ISOTROPE')THEN
  814.          MPTVAL=IVAMAT
  815.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  816.             MELVAL=IVAL(7)
  817.          ELSE
  818.             MELVAL=IVAL(2)
  819.          ENDIF
  820.          NBGCOS=VELCHE(/1)
  821.       ENDIF
  822.       DO 3093  IB=1,NBELEM
  823. C
  824. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  825. C
  826.       CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  827. C
  828.       CALL VPAST(XE,BPSS)
  829. C     BPSS    STOCKE LA MATRICE DE PASSAGE
  830.       CALL VCORLC (XE,XEL,BPSS)
  831.       CALL ZERO (REL,LRE,LRE)
  832. C
  833. C     BOUCLE SUR LES POINTS DE GAUSS
  834. C
  835.       DO 1193  IGAU=1,NBPGAU
  836.       MPTVAL=IVACAR
  837.       MELVAL=IVAL(1)
  838.       IBMN =MIN(IB,VELCHE(/2))
  839.       EPAIST=VELCHE(1,IBMN)
  840.       IF (IVAL(2).NE.0) THEN
  841.         MELVAL=IVAL(2)
  842.         IBMN =MIN(IB,VELCHE(/2))
  843.         EXCEN =VELCHE(1,IBMN)
  844.       ELSE
  845.         EXCEN=0.D0
  846.       ENDIF
  847. *
  848. * Dans le cas des mat\E9riaux orthotropes, les d\E9formations sont d'abord
  849. * calcul\E9es dans le rep\E8re d'orthotropie (les formules utilis\E9es par les
  850. * routines RCDST et BMFDST ne sont valables que dans ce rep\E8re); elles
  851. * sont ensuite exprim\E9es dans le rep\E8re local de l'\E9l\E9ment.
  852. *
  853.       IF(CMATE.NE.'ISOTROPE')THEN
  854.         IF(IGAU.LE.NBGCOS)THEN
  855.           IF(IMAT.EQ.2)THEN
  856.             MPTVAL=IVAMAT
  857.             MELVAL=IVAL(2)
  858.             IBMN=MIN(IB  ,VELCHE(/2))
  859.             IGMN=MIN(IGAU,VELCHE(/1))
  860.             COSA=VELCHE(IGMN,IBMN)
  861.             MELVAL=IVAL(3)
  862.             IBMN=MIN(IB  ,VELCHE(/2))
  863.             IGMN=MIN(IGAU,VELCHE(/1))
  864.             SINA=VELCHE(IGMN,IBMN)
  865.           ENDIF
  866.         ENDIF
  867.       ENDIF
  868. C
  869. C     ON CHERCHE LES COEFFICIENTS DE LA MATRICE DE HOOKE
  870. C
  871.       MPTVAL=IVAMAT
  872.       IF(IMAT.EQ.2) THEN
  873.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.
  874.      +                   OR.NBGMAT.GT.1)) THEN
  875.           MELVAL=IVAL(1)
  876.           IBMN=MIN(IB  ,IELCHE(/2))
  877.           IGMN=MIN(IGAU,IELCHE(/1))
  878.           MLREEL=IELCHE(IGMN,IBMN)
  879.           SEGACT MLREEL
  880.             CALL DOHOOO(PROG,LHOOK,DDHOMU)
  881.           SEGDES MLREEL
  882.             IF(CMATE.EQ.'ORTHOTRO')
  883.      +           CALL CHGREP1(COSA,SINA,DDHOMU,LHOOK)
  884.         ENDIF
  885.       ELSE IF (IMAT.EQ.1) THEN
  886. *
  887.           DO 9093 IM=1,NMATT
  888.             IF (IVAL(IM).NE.0) THEN
  889.               MELVAL=IVAL(IM)
  890.               IBMN=MIN(IB  ,VELCHE(/2))
  891.               IGMN=MIN(IGAU,VELCHE(/1))
  892.               VALMAT(IM)=VELCHE(IGMN,IBMN)
  893.             ELSE
  894.               VALMAT(IM)=0.D0
  895.             ENDIF
  896.  9093     CONTINUE
  897.         IF (IGAU.LE.NBGMAT.AND.(IB.LE.NELMAT.OR.NBGMAT.GT.1))
  898.      1    CALL DOHDST(VALMAT,CMATE,IFOUR,NSTRS,DDHOOK,IRTD)
  899.         CALL HOOKMU(EPAIST,0.D0,NSTRS,DDHOOK,DDHOMU)
  900.       ENDIF
  901. *
  902.       CALL ZERO(BGENE,NSTRS,LRE)
  903.       IF(CMATE.NE.'ISOTROPE')THEN
  904.         IF(IGAU.LE.NBGCOS)THEN
  905.          IF(IMAT.EQ.1.AND.CMATE.EQ.'ORTHOTRO')THEN
  906.             COSA=VALMAT(7)
  907.             SINA=VALMAT(8)
  908.           ENDIF
  909.           DO 1393 INO=1,NBNN
  910.            XX=COSA*XEL(1,INO)+SINA*XEL(2,INO)
  911.            YY=(-SINA)*XEL(1,INO)+COSA*XEL(2,INO)
  912.            XE(1,INO)=XX
  913.            XE(2,INO)=YY
  914.  1393     CONTINUE
  915.          ENDIF
  916. CC
  917. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  918. C      AUX CISAILLEMENTS TRANSVERSES
  919. C
  920.         CALL RCDST(XE,NSTRS,LRE,DDHOMU,
  921.      1                WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  922.  
  923. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  924. C        DE MEMBRANE ET DE FLEXION
  925. C
  926.          CALL BMFDST(IGAU,XE,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  927.      1            WORK(1),WORK(10),WORK(19),BGENE,DUM)
  928. *
  929.          DO 10 NPOI=1,3
  930.          SHPWRK(1,NPOI)=SHPTOT(1,NPOI,IGAU)
  931.          SHPWRK(2,NPOI)=SHPTOT(2,NPOI,IGAU)
  932.          SHPWRK(3,NPOI)=SHPTOT(3,NPOI,IGAU)
  933.   10     CONTINUE
  934.          CALL JACOBI(XEL,SHPWRK,2,3,DJAC)
  935.          CALL ROTB(BGENE,NSTRS,COSA,SINA)
  936.       ELSE
  937. C
  938. C     TERMES DE LA MATRICE DE RIGIDITE RELATIFS
  939. C      AUX CISAILLEMENTS TRANSVERSES
  940. C
  941.         CALL RCDST(XEL,NSTRS,LRE,DDHOMU,
  942.      1              WORK(1),WORK(10),WORK(19),REL,BGENE,1)
  943. C
  944. C     TERMES DE LA MATRICE B RELATIFS AUX EFFETS
  945. C        DE MEMBRANE ET DE FLEXION
  946. C
  947.         CALL BMFDST(IGAU,XEL,NSTRS,QSIGAU,ETAGAU,SHPTOT,SHPWRK,
  948.      1            WORK(1),WORK(10),WORK(19),BGENE,DJAC)
  949.       ENDIF
  950.       DJAC=DJAC*POIGAU(IGAU)
  951. C
  952. C  ON MODIFIE LA MATRICE B EN CAS D'EXCENTREMENT
  953. C
  954.         IF (EXCEN.NE.0.) THEN
  955.       DO 1593 IJL=1,3
  956.       DO 1593 IJC=1,LRE
  957.       BGENE(IJL,IJC)=BGENE(IJL,IJC)+EXCEN*BGENE(IJL+3,IJC)
  958.  1593 CONTINUE
  959.         ENDIF
  960. C
  961.       CALL BDBS1(BGENE,DJAC,DDHOMU,LRE,NSTRS,REL,MFR,IFOUR,MATE,
  962.      1     IGAU,IMAT,EXCEN)
  963.  1193 CONTINUE
  964.       REL(6,6)=REL(5,5)*1.D-7
  965.       REL(12,12)=REL(6,6)
  966.       REL(18,18)=REL(6,6)
  967.       ICOM=0
  968.       IF(ABS(EXCEN).GT.XPETIT .OR. CMATE.EQ.'COMPOSIT'
  969.      1  .OR. IMAT.EQ.2) ICOM=1
  970.       CALL TRANSK(REL,BPSS,LRE,3,ICOM)
  971. C
  972. C     REMPLISSAGE DE XMATRI
  973. C
  974.       CALL REMPMT(REL,LRE,RE(1,1,IB))
  975.  3093  CONTINUE
  976. C
  977.  9993 CONTINUE
  978.       SEGSUP WRK1,WRK2,WRK3,WRK4
  979.       GOTO 510
  980. *
  981. C=======================================================================
  982. C========= ERREUR : CAS NON PREVUS =====================================
  983. C=======================================================================
  984.    99 CONTINUE
  985.       MOTERR(1:4)=NOMTP(MELE)
  986.       MOTERR(9:12)='RIGI3'
  987.       CALL ERREUR(86)
  988. *
  989.   510 CONTINUE
  990.       SEGSUP,MVELCH
  991. *      SEGDES XMATRI
  992.  
  993.       RETURN
  994.       END
  995.  
  996.  
  997.  
  998.  
  999.  

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