Télécharger la plaquette Cast3M


fr en

Télécharger gyro2.eso

Retour à la liste

Numérotation des lignes : 

gyro2

  1. C GYRO2     SOURCE    OF166741  24/10/07    21:15:22     12016          
  2.  
  3.                SUBROUTINE GYRO2 (IPMODL,IPCHE1, IPRIG)
  4. *
  5. *_______________________________________________________________________
  6. *
  7. *             appelé par GYROS
  8. *
  9. *  Creation d'une matrice de couplage gyroscopique
  10. *  dans le repère inertiel ou fixe (éléments POUTR, TIMO, TUYAU)
  11. *
  12. *  entrees :
  13. *  ========
  14. *      ipmodl pointeur sur un mmodel
  15. *      ipche1 pointeur sur un mchaml de caracteristiques
  16. *
  17. *  sorties :
  18. *  =========
  19. *      iprig pointeur sur la matrice d'amortissement construite
  20. *            =0 sinon en cas d'erreur (et IERR non nul)
  21. *
  22. *_______________________________________________________________________
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC CCHAMP
  31. -INC CCGEOME
  32. -INC CCREEL
  33.  
  34. -INC SMRIGID
  35. -INC SMCHAML
  36. -INC SMELEME
  37. -INC SMCOORD
  38. -INC SMINTE
  39. -INC SMMODEL
  40.  
  41.       INTEGER oooval
  42.  
  43.       SEGMENT NOTYPE
  44.         CHARACTER*16 TYPE(NBTYPE)
  45.       ENDSEGMENT
  46.  
  47.       SEGMENT MPTVAL
  48.         INTEGER IPOS(NS),NSOF(NS)
  49.         INTEGER IVAL(NCOSOU)
  50.         CHARACTER*16 TYVAL(NCOSOU)
  51.       ENDSEGMENT
  52.  
  53.       CHARACTER*8 CMATE
  54.       CHARACTER*(NCONCH) CONM
  55.  
  56.       PARAMETER ( INTYP = 4 )
  57.  
  58.       PARAMETER (NINF=3)
  59.       INTEGER INFOS(NINF)
  60.       LOGICAL lsupde,lsupfo
  61.  
  62.       IPRIG = 0
  63. C
  64. C     ACTIVATION DU MODELE
  65. C
  66.       MMODEL = IPMODL
  67.       SEGACT,MMODEL
  68.       NSOUS=KMODEL(/1)
  69. C
  70. C     CREATION DE L'OBJET MATRICE DE COUPLAGE GYROSCOPIQUE
  71. C
  72.       NRIGEL = 0
  73.       SEGINI,MRIGID
  74.       MTYMAT = 'AMORTISS'
  75.       IFORIG = IFOUR
  76.       ICHOLE = 0
  77.       IMGEO1 = 0
  78.       IMGEO2 = 0
  79.       ISUPEQ = 0
  80. C
  81. C_______________________________________________________________________
  82. C
  83. C     DEBUT DE LA BOUCLE SUR LES DIFFERENT MODELES ELEMENTAIRES
  84. C_______________________________________________________________________
  85. C
  86.       DO 500 ISOUS=1,NSOUS
  87. C
  88.         IMODEL = KMODEL(ISOUS)
  89.         SEGACT,IMODEL
  90.  
  91. C- Initialisations
  92.         IPMINT = 0
  93.  
  94.         MOMATR = 0
  95.         MOCARA = 0
  96.         MOTYPM = 0
  97.         MOTYPC = 0
  98.         ISUPM = 0
  99.         ISUPC = 0
  100.  
  101.         MODEPL = 0
  102.         MOFORC = 0
  103.         lsupde = .false.
  104.         lsupfo = .false.
  105.  
  106.         IDESCR = 0
  107.  
  108. C- Recuperation d'informations sur le maillage elementaire
  109.         IIPDPG = imodel.IPDPGE
  110.         IIPDPG = IPTPOI(IIPDPG)
  111.         IPT1   = imodel.IMAMOD
  112.         SEGACT,IPT1
  113.         NBNOE1 = IPT1.NUM(/1)
  114.         NBELE1 = IPT1.NUM(/2)
  115.  
  116. C- Quelques informations sur le modele
  117.         CONM  = CONMOD
  118.         CMATE = CMATEE
  119.         MATE  = IMATEE
  120. c*        INAT  = INATUU
  121. C-  Creation du tableau INFOS
  122.         iret = 1
  123.         CALL IDENT(IPT1,CONM,IPCHE1,0,INFOS,iret)
  124.         IF (iret.EQ.0) GOTO 599
  125.  
  126. C- Recuperation d'informations sur l'element fini
  127.         MELE = NEFMOD
  128. C
  129.         NPINT = MAX(INFMOD(1),1)
  130. C-- Support des champs
  131.         IPLAZ = 4
  132.         IF (NPINT.EQ.12345) IPLAZ = 1
  133.  
  134.         MFR   = INFELE(13)
  135.         LRE   = INFELE(9)
  136.         LW    = INFELE(7)
  137.         LHOOK = INFELE(10)
  138.         NDDL  = INFELE(15)
  139. c*        IELE  = INFELE(14)
  140. c*        ICARA = INFELE(5)
  141.         IPMINT = INFMOD(2+IPLAZ)
  142. c*        IPMINT = INFELE(11)
  143.         IPMIN1 = INFELE(12)
  144. c*        IPMIN1 = INFMOD(8)
  145.         IPPORE = 0
  146.         IF (MFR.EQ.33) IPPORE = NBNOE1
  147. C
  148. C- RECHERCHE DES NOMS D'INCONNUES ET DES DUAUX
  149.         if (lnomid(1).ne.0) then
  150.            MODEPL =lnomid(1)
  151.         else
  152.           lsupde = .true.
  153.           CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,ndum)
  154.         endif
  155.         nomid = MODEPL
  156.         SEGACT,nomid
  157.         NDEPL = lesobl(/2)
  158. c*        ndum = lesfac(/2)
  159.  
  160.         IF (lnomid(2).ne.0) then
  161.           MOFORC = lnomid(2)
  162.         ELSE
  163.           lsupfo = .true.
  164.           CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  165.         ENDIF
  166.         nomid = MOFORC
  167.         SEGACT,nomid
  168.         NFORC = lesobl(/2)
  169. c*        ndum=lesfac(/2)
  170. C
  171.         IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  172.           CALL ERREUR(5)
  173.           GOTO 598
  174.         ENDIF
  175. C
  176. C- REMPLISSAGE DU SEGMENT DESCRIPTEUR
  177.         NLIGRP = LRE
  178.         NLIGRD = LRE
  179.         SEGINI,DESCR
  180.  
  181.         NCOMP = NDEPL
  182.         NBNNS = NBNOE1
  183.         IF (MFR.EQ.33) NCOMP = NDEPL-1
  184.         IF (IFOUR.EQ.-3) THEN
  185.           NCOMP = NDEPL-3
  186.         ENDIF
  187. c* ?        IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS = NBNOE1/2
  188.         IDDL = 1
  189.         DO 1004 INOEUD=1,NBNNS
  190.           DO 1005 ICOMP=1,NCOMP
  191.             NOMID=MODEPL
  192.             LISINC(IDDL)=LESOBL(ICOMP)
  193.             NOMID=MOFORC
  194.             LISDUA(IDDL)=LESOBL(ICOMP)
  195.             NOELEP(IDDL)=INOEUD
  196.             NOELED(IDDL)=INOEUD
  197.             IDDL=IDDL+1
  198. 1005      CONTINUE
  199. 1004    CONTINUE
  200. *
  201.         SEGDES,DESCR
  202.         IDESCR = DESCR
  203.  
  204. C- Recuperation des noms de composantes MATERIAU
  205.         nbrobl = 0
  206.         nbrfac = 0
  207.         nomid  = 0
  208.         notype = 0
  209.         LHOTRA = 0
  210. C
  211. C   rho dans les cas poutre,tuyau
  212.         IF (MFR.EQ.7.OR.MFR.EQ.13) THEN
  213.           IF (CMATE.NE.'SECTION') THEN
  214.             nbrobl = 1
  215.             SEGINI,nomid
  216.             lesobl(1)='RHO '
  217.             nbtype = 1
  218.             SEGINI,notype
  219.             type(1) = 'REAL*8'
  220.           ELSE
  221.             LHOTRA = LHOOK
  222.             nbrobl=2
  223.             SEGINI,nomid
  224.             lesobl(1)='MODS'
  225.             lesobl(2)='MATS'
  226.             nbtype = 2
  227.             SEGINI,notype
  228.             type(1) = 'POINTEURMMODEL'
  229.             type(2) = 'POINTEURMCHAML'
  230.           ENDIF
  231.         ENDIF
  232.         MOMATR = nomid
  233.         MOTYPM = notype
  234.         NMATR = nbrobl
  235.         NMATF = nbrfac
  236.         NMATT = NMATR+NMATF
  237. C-- Verification du support des composantes recherchees
  238.         IF (MOMATR.NE.0) THEN
  239.           CALL QUESUQ(IMODEL,IPCHE1,INTYP,0,MOMATR,IPLAZ,ISUPM,iret)
  240.           IF (ISUPM.GT.1) GOTO 597
  241.         ENDIF
  242.  
  243. C- Recuperation des noms de composantes CARACTERISTIQUES
  244.         nbrobl = 0
  245.         nbrfac = 0
  246.         nomid  = 0
  247.         notype = 0
  248.         IVECT  = 0
  249. *   caracteristiques pour les poutres
  250.         IF (MFR.EQ.7 ) THEN
  251.           IF (CMATE.EQ.'SECTION') THEN
  252.             nbrfac = 4
  253.             SEGINI,nomid
  254.             lesfac(1) = 'OMEG'
  255.             lesfac(2) = 'VX  '
  256.             lesfac(3) = 'VY  '
  257.             lesfac(4) = 'VZ  '
  258.             IVECT = 1
  259. *
  260.             nbtype = 4
  261.             SEGINI,notype
  262.             type(1) = 'REAL*8'
  263.             type(2) = 'REAL*8'
  264.             type(3) = 'REAL*8'
  265.             type(4) = 'REAL*8'
  266.           ELSE
  267.             nbrobl = 4
  268.             nbrfac = 6
  269.             SEGINI,nomid
  270.             lesobl(1) = 'TORS'
  271.             lesobl(2) = 'INRY'
  272.             lesobl(3) = 'INRZ'
  273.             lesobl(4) = 'SECT'
  274.             lesfac(1) = 'SECY'
  275.             lesfac(2) = 'SECZ'
  276.             lesfac(3) = 'OMEG'
  277.             lesfac(4) = 'VX  '
  278.             lesfac(5) = 'VY  '
  279.             lesfac(6) = 'VZ  '
  280.             IVECT = 1
  281. *
  282.             nbtype = 10
  283.             SEGINI,notype
  284.             type(1) = 'REAL*8'
  285.             type(2) = 'REAL*8'
  286.             type(3) = 'REAL*8'
  287.             type(4) = 'REAL*8'
  288.             type(5) = 'REAL*8'
  289.             type(6) = 'REAL*8'
  290.             type(7) = 'REAL*8'
  291.             type(8) = 'REAL*8'
  292.             type(9) = 'REAL*8'
  293.             type(10) = 'REAL*8'
  294.           ENDIF
  295. * caracteristiques pour les tuyaux
  296.         ELSE IF (MFR.EQ.13) THEN
  297.           nbrobl = 2
  298.           nbrfac = 5
  299.           SEGINI,nomid
  300.           lesobl(1) = 'EPAI'
  301.           lesobl(2) = 'RAYO'
  302.           lesfac(1) = 'RACO'
  303.           lesfac(2) = 'OMEG'
  304.           lesfac(3) = 'VX  '
  305.           lesfac(4) = 'VY  '
  306.           lesfac(5) = 'VZ  '
  307.           IVECT = 1
  308. *
  309.           nbtype = 7
  310.           SEGINI,notype
  311.           type(1) = 'REAL*8'
  312.           type(2) = 'REAL*8'
  313.           type(3) = 'REAL*8'
  314.           type(4) = 'REAL*8'
  315.           type(5) = 'REAL*8'
  316.           type(6) = 'REAL*8'
  317.           type(7) = 'REAL*8'
  318.         ENDIF
  319.  
  320.         MOCARA = nomid
  321.         MOTYPC = notype
  322.         NCARA = nbrobl
  323.         NCARF = nbrfac
  324.         NCARR = NCARA+NCARF
  325.  
  326. C--- Verification du support des composantes recherchées
  327.         IF (MOCARA.NE.0) THEN
  328.           CALL QUESUQ(IMODEL,IPCHE1,INTYP,0,MOCARA,IPLAZ,ISUPC,iret)
  329.           IF (ISUPC.GT.1) GOTO 597
  330.         ENDIF
  331. C
  332. C- Activation du segment MINTE
  333.         MINTE = IPMINT
  334.         SEGACT,MINTE
  335.         NBPGAU = POIGAU(/1)
  336. C
  337. C- Partionnement si necessaire de la matrice d'amortissement
  338. C- determinant ainsi le nombre d'objets elementaires de MRIGID
  339.         LTRK = oooval(1,4)
  340.         IF (LTRK.EQ.0) LTRK = oooval(1,1)
  341.       LTRK=MAX(LTRK,2**24)
  342. * Ajout a la taille en mots de la matrice des infos du segment
  343.         LSEG = LRE*LRE*NBELE1 + 16
  344.         NBLPRT = (LSEG-1)/LTRK + 1
  345.         NBLMAX = (NBELE1-1)/NBLPRT + 1
  346.         nblprt = (NBELE1-1)/NBLMAX + 1
  347. c*        write(ioimp,*) ' gyro2 : nblprt nblmax = ',nblprt,nblmax,nbele1
  348.  
  349. C-- Ajout de la matrice de couplage GYROSCOPIQUE a la matrice globale
  350.         NRIGE0 = IRIGEL(/2)
  351.         NRIGEL = NRIGE0 + nblprt
  352.         SEGADJ,MRIGID
  353.  
  354.         descr  = IDESCR
  355.         meleme = IPT1
  356.         nbnn   = NBNOE1
  357.         nbelem = NBELE1
  358.         nbsous = 0
  359.         nbref  = 0
  360.  
  361. * Boucle sur les PARTITIONS elementaires de la matrice
  362. *------------------------------------------------------
  363.         DO 5000 irige = 1, nblprt
  364.  
  365.           IF (nblprt.GT.1) THEN
  366. C-- Partitionnement du maillage support de la matrice elementaire
  367. C- (IPT1 peut etre desactive suite a l'appel a KOMCHA !)
  368.             SEGACT,IPT1
  369.             ielem = (irige-1)*NBLMAX
  370.             nbelem = MIN(NBLMAX,NBELE1-ielem)
  371. *          write(ioimp,*) ' creation segment ',nbnn,nbelem
  372.             SEGINI,meleme
  373.             itypel = IPT1.itypel
  374.             DO ielt = 1, nbelem
  375.               jelt = ielt + ielem
  376.               DO inoe = 1, nbnn
  377.                 num(inoe,ielt) = IPT1.NUM(inoe,jelt)
  378.               ENDDO
  379.               icolor(ielt) = IPT1.ICOLOR(jelt)
  380.             ENDDO
  381. C-- Recopie du descripteur
  382.             des1 = IDESCR
  383.             SEGINI,descr=des1
  384.             SEGDES,descr
  385.           ENDIF
  386. C* Voir le cas IFOUR.EQ.-3
  387.           ipmail = meleme
  388.           ipdesc = descr
  389.           ipt2   = meleme
  390.  
  391. C-- Initialisation de la matrice de rigidite elementaire (xmatri)
  392.           NELRIG = nbelem
  393.           SEGINI,xmatri
  394.           ipmatr = xmatri
  395.  
  396. C-- Recuperation des valeurs des proprietes materiau et geometriques
  397.           ivamat = 0
  398.           ivacar = 0
  399.           IF (MOMATR.NE.0) THEN
  400.             CALL KOMCHA(IPCHE1,ipmail,CONM,MOMATR,MOTYPM,1,
  401.      &                  INFOS,NINF,ivamat)
  402.             IF (IERR.NE.0) GOTO 5099
  403.             IF (ISUPM.EQ.1) THEN
  404.               CALL VALCHE(ivamat,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  405.               IF (IERR.NE.0) THEN
  406.                 ISUPM = 0
  407.                 GOTO 5099
  408.               ENDIF
  409.             ENDIF
  410.           ENDIF
  411.           IF (MOCARA.NE.0) THEN
  412.             CALL KOMCHA(IPCHE1,ipmail,CONM,MOCARA,MOTYPC,1,
  413.      &                  INFOS,NINF,ivacar)
  414.             IF (IERR.NE.0) GOTO 5099
  415.             IF (ISUPC.EQ.1) THEN
  416.               CALL VALCHE(ivacar,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  417.               IF (IERR.NE.0) THEN
  418.                 ISUPC = 0
  419.                 GOTO 5099
  420.               ENDIF
  421.             ENDIF
  422.           ENDIF
  423.  
  424. C_______________________________________________________________________
  425. C
  426. C     NUMERO DES ETIQUETTES      :
  427. C     ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  428. C     LES ELEMENTS SONT GROUPES COMME SUIT :
  429. C_______________________________________________________________________
  430. *                 CABL SEG2 SEG3 TRI3 TRI4 TRI6 TRI7 QUA4 QUA5 QUA8 QUA9
  431.             GOTO (  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  432. *                 RAC2 RAC3 CUB8 CU20 PRI6 PR15 LIA3 LIA4 LIA6 LIA8 MULT
  433.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  434. *                 TET4 TE10 PYR5 PY13 COQ3  DKT POUT LISP FAC3 FAC4 FAC6
  435.      &           ,  99,  99,  99,  99,  99,  99,  21,  99,  99,  99,  99
  436. *                 FAC8 LTR3 LQU4 LCU8 LPR6 LTE4 LPY5 COQ8 TUYA TUFI COQ2
  437.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  21,  99,  99
  438. *                 POI1 BARR RACO LSU2 COQ4 LISM COF3 RES2 LSU3 LSU4 LICO
  439.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  440. *                 COQ6 CVS2 CVS3 CVT3 CVT6 CVQ4 CVQ8 THP5 TH13 THP6 TH15
  441.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  442. *                 THC8 TH20 ICT3 ICQ4 ICT6 ICQ8 ICC8 ICT4 ICP6 IC20 IC10
  443.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  444. *                 IC15 TRIP QUAP CUBP TETP PRIP TIMO JOI2 JOI3 JOT3 JOI4
  445.      &           ,  99,  99,  99,  99,  99,  99,  21,  99,  99,  99,  99
  446. *                 JOI6 JOI8 LISC TRIH  DST LIC4 CERC TUYO LSE2 LITU HYT3
  447.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  448. *                 HYQ4 HYT4 HYP6 HYC8 TRIS QUAS POIS FOR3 JOP3 JOP6 JOP8
  449.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  450. *                 POL3 POL4 POL5 POL6 POL7 POL8 POL9 PO10 PO11 PO12 PO13
  451.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  452. *                 PO14 BAR3 BAEX LIA2 QUAH CUBH ROT3 SEF2 TRF3 QUF4 CUF8
  453.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  454. *                 PRF6 TEF4 PYF5 MSE3 MTR6 MQU9 MC27 MP18 MT10 MP14 SEF3
  455.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  456. *                 TRF7 QUF9 CF27 PF21 TF15 PF19 SEG6 TR21 QU36 C216 P126
  457.      &           ,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99,  99
  458. *                 TE56 PY91 TRH6
  459.      &           ,  99,  99,  99),MELE
  460. C
  461.  99       CONTINUE
  462.           MOTERR(1:4)=NOMTP(MELE)
  463.           MOTERR(5:12)='GYROS'
  464.           CALL ERREUR(86)
  465.           GOTO 5099
  466. C_______________________________________________________________________
  467. C
  468. C     POUTRE, POUTRE DE TIMOSCHENKO
  469. C_______________________________________________________________________
  470. C
  471.  21       CONTINUE
  472.           CALL GYRO3(ipmail,LRE,LW,MELE,ivamat,NMATT,ivacar,NCARR,
  473.      &               IVECT,ISOUS,NBPGAU,IPMINT,IPMIN1,NDDL,MATE,
  474.      &               CMATE,LHOTRA,ipmatr,IIPDPG)
  475.           GOTO 5100
  476. C_______________________________________________________________________
  477. C
  478. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  479. C_______________________________________________________________________
  480.  5100     CONTINUE
  481.  5099     CONTINUE
  482. c*          xmatri = ipmatr
  483.           IF (nblprt.GT.1) THEN
  484. c*            meleme = ipmail
  485.             SEGDES,meleme
  486.           ENDIF
  487.           IF (ISUPM.EQ.1 .OR. nblprt.GT.1) THEN
  488.             CALL DTMVAL(ivamat,3)
  489.           ELSE
  490.             CALL DTMVAL(ivamat,1)
  491.           ENDIF
  492.           IF (ISUPC.EQ.1 .OR. nblprt.GT.1) THEN
  493.             CALL DTMVAL(ivacar,3)
  494.           ELSE
  495.             CALL DTMVAL(ivacar,1)
  496.           ENDIF
  497.  
  498. C- Sortie prematuree en cas d'erreur
  499.           IF (IERR.NE.0) GOTO 596
  500.  
  501. C- Stockage de la matrice
  502.           jrige = NRIGE0 + irige
  503.           COERIG(jrige)   = 1.
  504.           IRIGEL(1,jrige) = ipt2
  505.           IRIGEL(2,jrige) = 0
  506.           IRIGEL(3,jrige) = ipdesc
  507.           IRIGEL(4,jrige) = ipmatr
  508.           IRIGEL(5,jrige) = NIFOUR
  509.           IRIGEL(6,jrige) = 0
  510. C-- Matrice antisymetrique
  511.           IRIGEL(7,jrige) = 1
  512.           xmatri.symre = 1
  513.           SEGDES,xmatri
  514.           IRIGEL(8,jrige) = 0
  515.  
  516.  5000   CONTINUE
  517. C- Fin de la boucle sur les partitions
  518.  
  519.  596    CONTINUE
  520. c*      MINTE = IPMINT
  521.         SEGDES,MINTE
  522.  597    CONTINUE
  523.         IF (MOMATR.NE.0) THEN
  524.           nomid = MOMATR
  525.           SEGSUP,nomid
  526.           notype = MOTYPM
  527.           SEGSUP,notype
  528.         ENDIF
  529.         IF (MOCARA.NE.0) THEN
  530.           nomid = MOCARA
  531.           SEGSUP,nomid
  532.           notype = MOTYPC
  533.           SEGSUP,notype
  534.         ENDIF
  535.  598    CONTINUE
  536.         NOMID = MODEPL
  537.         SEGDES,NOMID
  538.         IF (lsupde) SEGSUP,NOMID
  539.         NOMID = MOFORC
  540.         SEGDES,NOMID
  541.         IF (lsupfo) SEGSUP,NOMID
  542.  599    CONTINUE
  543.         SEGDES,IPT1
  544.         SEGDES,IMODEL
  545.  
  546. C- Sortie prematuree en cas d'erreur
  547.         IF (IERR.NE.0) GOTO 999
  548.  
  549.  500  CONTINUE
  550. C- Fin de la boucle sur les modeles elementaires
  551.  
  552.  999  CONTINUE
  553.       IF (IERR.NE.0) THEN
  554.         SEGSUP,MRIGID
  555.         IPRIG = 0
  556.       ELSE
  557.         SEGDES,MRIGID
  558.         IPRIG = MRIGID
  559.       ENDIF
  560.       SEGDES,MMODEL
  561.  
  562.       RETURN
  563.       END
  564.  
  565.  
  566.  

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