Télécharger la plaquette Cast3M


fr en

Télécharger fsurma.eso

Retour à la liste

Numérotation des lignes : 

fsurma

  1. C FSURMA    SOURCE    OF166741  25/02/21    21:17:08     12166          
  2.  
  3.       SUBROUTINE FSURMA(IPMODL,IPCHPS,IPVECT,JPMAIL,IPCARA, IPFTP)
  4.  
  5. C_______________________________________________________________________
  6. C
  7. C   CALCULE LES FORCES SURFACIQUES APPLIQUEES SUR DES MASSIFS
  8. C
  9. C   ENTREES :
  10. C   ---------
  11. C
  12. C    IPMODL   OBJET MODELE  SUR LEQUEL S APPLIQUE LA FORCE
  13. C    IPCHPS   CHPOINT CONTENANT LES VALEURS DES FORCES AUX NOEUDS
  14. C             DE LA FACE D UN MASSIF, SINON 0 (ET IPVECT NON NUL)
  15. C    IPVECT   VECTEUR REPRESENTANT LA FORCE (=0 SI IPCHPS NON NUL)
  16. C    JPMAIL   POINTEUR SUR LE MAILLAGE SI ON A LU UN VECTEUR IPVECT
  17. C             SINON 0 (IPCHPS NON NUL)
  18. C    IPCARA   MCHAML CONTENANT LES CARACTERISTIQUES UTILES
  19. C
  20. C  SORTIES  :
  21. C  ----------
  22. C
  23. C    IPFTP  = CHPOINT DES FORCES NODALES EQUIVALENTES
  24. C             0 EN CAS D'ERREUR (IERR peut alors etre non nulle)
  25. C
  26. C_______________________________________________________________________
  27.  
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8(A-H,O-Z)
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCHAMP
  34.  
  35. -INC SMCHAML
  36. -INC SMCHPOI
  37. -INC SMCOORD
  38. -INC SMELEME
  39. -INC SMINTE
  40. -INC SMMODEL
  41.  
  42. -INC TMPTVAL
  43.  
  44.       SEGMENT INFO
  45.         integer INFELL(JG)
  46.       ENDSEGMENT
  47.       SEGMENT NOTYPE
  48.         CHARACTER*16 TYPE(NBTYPE)
  49.       ENDSEGMENT
  50.  
  51.       DIMENSION VEC(3),IPT(3)
  52.       CHARACTER*(LOCOMP) mfors(3)
  53.       CHARACTER*4 MOSTRI,MOAPPU,MOGEOM
  54.       CHARACTER*8 MOT
  55.       CHARACTER*(NCONCH) CONM
  56.       PARAMETER (NINF=3)
  57.       DIMENSION INFOS(NINF)
  58.  
  59.       PARAMETER (INTYPC = 3)
  60.  
  61.       LOGICAL ltelq,lsupfo
  62.  
  63.       DATA MOAPPU /'APPU'/, MOSTRI /'STRI'/, MOGEOM /'GEOM'/
  64.       DATA MOT/'FORCES'/
  65.  
  66. C=  LEFMAS   Liste des numeros d'elements finis faces de MASSIFs
  67. C=  NEFMAS   Longueur de cette liste
  68.       PARAMETER ( NEFMAS = 6 )
  69.       DIMENSION LEFMAS(NEFMAS)
  70. C ============
  71. C  Elements MASSIFs  SEG2 SEG3 TRI3 QUA4 TRI6 QUA8
  72.       DATA LEFMAS /    2,   3,  31,  32,  33,  34 /
  73. *
  74. * 0) QUELQUES INITIALISATIONS
  75. *
  76.       IPFTP = 0
  77.       MFR   = 0
  78.       NHRM = NIFOUR
  79. C= Composantes du CHPOINT IPCHPS a retenir (si besoin)
  80.       IF (IFOMOD.EQ.2) THEN
  81.         nfors = 3
  82.         mfors(1) = 'FX  '
  83.         mfors(2) = 'FY  '
  84.         mfors(3) = 'FZ  '
  85.       ELSE IF (IFOMOD.EQ.-1) THEN
  86.         nfors = 2
  87.         mfors(1) = 'FX  '
  88.         mfors(2) = 'FY  '
  89.         mfors(3) = '    '
  90.       ELSE IF (IFOMOD.EQ.0) THEN
  91.         nfors = 2
  92.         mfors(1) = 'FR  '
  93.         mfors(2) = 'FZ  '
  94.         mfors(3) = '    '
  95.       ELSE IF (IFOMOD.EQ.1) THEN
  96.         nfors = 3
  97.         mfors(1) = 'FR  '
  98.         mfors(2) = 'FZ  '
  99.         mfors(3) = 'FT  '
  100.       ELSE
  101.         CALL ERREUR(21)
  102.         RETURN
  103.       ENDIF
  104. C  Cas des modes de calculs en DEFORMATIONS GENERALISEES
  105.       IF (IFOUR.EQ.-3) THEN
  106.         NDPGE = 3
  107.       ELSE IF (IFOUR.EQ.11) THEN
  108.         NDPGE = 2
  109.       ELSE IF (IFOUR.EQ. 7.OR.IFOUR.EQ. 8.OR.IFOUR.EQ. 9.OR.
  110.      &         IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN
  111.         NDPGE = 1
  112.       ELSE
  113.         NDPGE = 0
  114.       ENDIF
  115. *
  116. *  ON RECUPERE LES COORDONNEES DU VECTEUR FORCE CONSTANT SI DONNE
  117. *  TEST SI LE VECTEUR N'EST PAS NUL
  118. *
  119.       IF (IPVECT.NE.0) THEN
  120.         IREF = (IPVECT-1)*(IDIM+1)
  121.         VEC(1) = XCOOR(IREF+1)
  122.         VEC(2) = XCOOR(IREF+2)
  123.         VECN = VEC(1)**2 + VEC(2)**2
  124.         IF (IDIM.EQ.3) THEN
  125.           VEC(3) = XCOOR(IREF+3)
  126.           VECN = VECN + VEC(3)**2
  127.         ENDIF
  128. C*        VECN = SQRT(VECN)
  129.         IF (VECN.LE.0.D0) THEN
  130.           CALL ERREUR(277)
  131.           RETURN
  132.         ENDIF
  133.       ELSE
  134.         VEC(1) = 0.D0
  135.         VEC(2) = 0.D0
  136.         VEC(3) = 0.D0
  137.       ENDIF
  138. C
  139. C  ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS DU CHPOINT DE
  140. C  FORCES IPCHPS S'IL EST FOURNI SINON ON SE SERVIRA DE JPMAIL
  141. C  CE MAILLAGE SERA POINTE PAR LA VARIABLE IGEOM DANS LA SUITE
  142. C
  143.       IF (JPMAIL.EQ.0) THEN
  144.         IGEOM = 0
  145.         ltelq = .false.
  146.         MCHPOI = IPCHPS
  147.         DO i = 1,IPCHP(/1)
  148.           MSOUPO = IPCHP(i)
  149.           NC = NOCOMP(/2)
  150.           DO j = 1, NC
  151.             CALL PLACE(mfors,nfors,imo,NOCOMP(j))
  152.             IF (imo.NE.0) THEN
  153.               IF (IGEOM.EQ.0) THEN
  154.                 IGEOM = IGEOC
  155.               ELSE
  156.                 IPP2 = IGEOC
  157.                 CALL FUSE(IGEOM,IPP2,IPPT,ltelq)
  158.                 IF (IERR.NE.0) RETURN
  159.                 IGEOM = IPPT
  160.               ENDIF
  161.               GOTO 10
  162.             ENDIF
  163.           ENDDO
  164.  10       CONTINUE
  165.         ENDDO
  166.         IF (IGEOM.EQ.0) THEN
  167.           CALL ERREUR(21)
  168.           RETURN
  169.         ENDIF
  170.       ELSE
  171.         IGEOM = JPMAIL
  172.       ENDIF
  173. C
  174. C  PRE-TRAITEMENT DES DONNEES :
  175. C  - PETIT MODELE UTILE ASSOCIE A LA SURFACE ELEMENTAIRE TRAITEE
  176. C    LE IMODEL EST MODIFIE PAR AJUSTEMENT DES QUE NECESSAIRE
  177. C
  178.       N1 = 1
  179.       SEGINI,MMODE1
  180.       IPMOD1 = MMODE1
  181.       NFOR = 0
  182.       NMAT = 0
  183.       MN3  = 1
  184.       NOBMOD = 0
  185.       SEGINI,IMODE1
  186.       IMODE1.CMATEE = 'ISOTROPE'
  187.       MMODE1.KMODEL(1) = IMODE1
  188. C
  189. C  PRE-TRAITEMENT DU CHAMP DE CARACTERISTIQUES SI NECESSAIRE
  190. C  - VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  191. C  - DEFINITION DE SEGMENTS UTILES
  192. C
  193.       ISUPCA = 0
  194.       MOCARA = 0
  195.       MOTYPC = 0
  196.       NCARA  = 0
  197.       NCARF  = 0
  198.  
  199.       NBTYPE = 1
  200.       SEGINI,NOTYPE
  201.       TYPE(1) = 'REAL*8'
  202.       MOTYPC = NOTYPE
  203. C
  204.       IF (IFOUR.EQ.-2) THEN
  205.         IF (IPCARA.NE.0) THEN
  206. C
  207.           CALL QUESUP(IPMODL,IPCARA,INTYPC,1,ISUPCA,iret)
  208.           IF (IERR.NE.0 .OR. ISUPCA.GT.1) GOTO 900
  209. C
  210.           NBROBL = 0
  211.           NBRFAC = 1
  212.           SEGINI,NOMID
  213.           LESFAC(1) = 'DIM3'
  214.           MOCARA = NOMID
  215. C
  216.           NCARA = NBROBL
  217.           NCARF = NBRFAC
  218.         ENDIF
  219.       ENDIF
  220. C
  221.       NCARR = NCARA + NCARF
  222. C
  223. C------------------------------------------- BOUCLE sur les SOUS-MODELES
  224. C
  225.       MMODEL = IPMODL
  226.       NSOUS = KMODEL(/1)
  227.       IRRT = 0
  228. C
  229.       DO 100 ISOUS = 1, NSOUS
  230. C
  231. C ... ON RECUPERE L INFORMATION GENERALE
  232. C
  233.         IMODEL = KMODEL(ISOUS)
  234. C
  235. C       TRAITEMENT DU SOUS-MODELE
  236. C
  237.         IPMAIL= IMAMOD
  238.         MELM  = NEFMOD
  239.         CONM  = CONMOD
  240. C
  241.         IF (MELM.EQ.22) GOTO 101
  242. C
  243.         IVACAR = 0
  244.         IVAFOR = 0
  245.         lsupfo = .FALSE.
  246.         IPTINT = 0
  247. C
  248. C ... ON RECUPERE L'"ENVELOPPE" DU MAILLAGE MASSIF DU SOUS-MODELE
  249. C
  250.         CALL ECROBJ('MAILLAGE',IPMAIL)
  251.         IF (IDIM.EQ.3) THEN
  252.           CALL ENVELO
  253.         ELSE IF (IDIM.EQ.2) THEN
  254.           CALL PRCONT
  255. c*      ELSE IF (IDIM.EQ.1) THEN
  256.         ELSE
  257.           CALL PREX1D
  258.         ENDIF
  259.         IF (IERR.NE.0) GOTO 101
  260.         CALL LIROBJ('MAILLAGE',ienvel,1,iret)
  261.         IF (IERR.NE.0) GOTO 101
  262. C
  263. C ... SI le CHPOINT de force IPCHPS a ete donne, on cherche la partie de
  264. C     l'"enveloppe" s'appuyant strictement sur le support du CHPOINT.
  265. C ... SINON on cherche l'intersection entre l'enveloppe et JPMAIL=IGEOM.
  266. C
  267.         IF (JPMAIL.EQ.0) THEN
  268.           CALL ECROBJ('MAILLAGE',IGEOM)
  269.           CALL ECRCHA(MOSTRI)
  270.           CALL ECRCHA(MOAPPU)
  271.           CALL ECROBJ('MAILLAGE',ienvel)
  272.           CALL EXTREL(irr,0,iret)
  273.         ELSE
  274.           CALL INTERB(ienvel,IGEOM,irr,IPT3)
  275.         ENDIF
  276. C
  277. C ... ON N'A PAS TROUVE D'ELEMENTS COMMUNS A IGEOM ET A IPMAIL
  278. C     (IPMAIL = "ENVELOPPE" DU MAILLAGE DU SOUS-MODELE IMODEL)
  279. C
  280.         IF (irr.GT.0) GOTO 101
  281. C
  282. C ... On recupere les elements communs a IGEOM et IPMAIL -> IPT3 !
  283. C
  284.         IF (JPMAIL.EQ.0) THEN
  285.           CALL LIROBJ('MAILLAGE',IPT3,1,iret)
  286.           CALL ACTOBJ('MAILLAGE',IPT3,1)
  287.           IF (IERR.NE.0) GOTO 101
  288.         ENDIF
  289. C
  290. C   RECHERCHE DES NOMS DE COMPOSANTES
  291. C
  292.         IF (lnomid(2).NE.0) THEN
  293.           MOFORC = lnomid(2)
  294.         ELSE
  295.           lsupfo = .TRUE.
  296.           CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NFORF)
  297.         endif
  298.         nomid=MOFORC
  299.         NFORC = lesobl(/2)
  300.         NFORF = 0
  301.         NCOMP = NFORC - NDPGE
  302. C
  303. C   Mise a jour de IMODE1 avec les donnees necessaires de IMODEL
  304. C
  305.         NFOR = FORMOD(/2)
  306.         NMAT = MATMOD(/2)
  307.         MN3  = INFMOD(/1)
  308.         SEGADJ,IMODE1
  309.         IMODE1.CONMOD = CONM
  310.         DO i = 1, NFOR
  311.           IMODE1.FORMOD(i) = FORMOD(i)
  312.         ENDDO
  313.         DO i = 1, NMAT
  314.           IMODE1.MATMOD(i) = MATMOD(i)
  315.         ENDDO
  316.         DO i = 1, MN3
  317.           IMODE1.INFMOD(i) = INFMOD(i)
  318.         ENDDO
  319. C
  320. C     ON DETERMINE LA FORMULATION ASSOCIEE A L OBJET
  321. C     GEOMETRIQUE ELEMENTAIRE DE SURFACE
  322. C
  323.         MJB = IPT3.LISOUS(/1)
  324.         IPT2 = IPT3
  325. C
  326. C     BOUCLE SUR LES SOUS-ZONES DE LA PARTIE COMMUNE
  327. C
  328.         DO 110 IB = 1,MAX(1,MJB)
  329.           IRRT = IRRT + 1
  330.           IF (MJB.NE.0) IPT2 = IPT3.LISOUS(IB)
  331.           IPOGEO = IPT2
  332.           NBEL  = IPT2.NUM(/2)
  333.           NBNN  = IPT2.NUM(/1)
  334.           LETYP = IPT2.ITYPEL
  335. *
  336. *        PETIT TEST SUR LE TYPE
  337. *
  338.           IF (LETYP.EQ.1 .AND. IDIM.NE.1) THEN
  339.             CALL ERREUR(16)
  340.             GOTO 102
  341.           ENDIF
  342. *
  343.           CALL TYPFAC(MELM,NBNN,MELE)
  344. C
  345. C        ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR FSUR POUR
  346. C                 LES ELEMENTS DE FORMULATION MELM
  347. C
  348.           IF (MELE.EQ.0) THEN
  349.             MOTERR(1:8) = NOMTP(MELM)
  350.             CALL ERREUR(193)
  351.             GOTO 102
  352.           ENDIF
  353. *        ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE
  354.           imo = 0
  355.           CALL PLACE2(LEFMAS,NEFMAS,imo,MELE)
  356.           IF (imo.EQ.0) THEN
  357.             MOTERR(1:4) = NOMTP(MELE)
  358.             MOTERR(5:12)='FSURMA  '
  359.             CALL ERREUR(86)
  360.             GOTO 102
  361.           ENDIF
  362. C
  363. C        ON CREE L OBJET MODEL ASSOCIE A LA SURFACE ELEMENTAIRE
  364. C
  365.           IMODE1.IMAMOD=IPOGEO
  366.           IMODE1.NEFMOD=MELE
  367. C
  368. C        INFORMATION SUR L'ELEMENT FINI
  369. C
  370.           CALL ELQUOI(MELE,0,INTYPC,IPINF,IMODE1)
  371.           IF (IERR.NE.0) GOTO 102
  372.           INFO = IPINF
  373.           IPTINT=INFELL(11)
  374.           MFR   =INFELL(13)
  375.           IPPORE=0
  376.           IF (MFR.EQ.33) IPPORE=NBNN
  377.           SEGSUP,INFO
  378. C
  379.           MINTE=IPTINT
  380. *
  381. *     ON TRANSFORME LE CHPOINT DE VECTEUR EN MCHAML
  382. *
  383.           IPCHMS = 0
  384.           IPT(1) = 0
  385.           IPT(2) = 0
  386.           IPT(3) = 0
  387.           IF (IPCHPS.NE.0) THEN
  388. c*        IF (IPVECT.EQ.0) THEN <- Test equivalent
  389.             CALL CHAME1(0,IPMOD1,IPCHPS,' ',IPCHMS,1)
  390.             IF (IERR.NE.0) GOTO 102
  391.             MCHEL1 = IPCHMS
  392. *     On ne doit avoir qu'une zone !
  393.             IF (MCHEL1.ICHAML(/1).NE.1) THEN
  394.               WRITE(IOIMP,*) 'Contacter le support (FSURMA 402)'
  395.               CALL ERREUR(21)
  396.               GOTO 102
  397.             ENDIF
  398.             MCHAM1 = MCHEL1.ICHAML(1)
  399.             DO 15 i = 1, MCHAM1.NOMCHE(/2)
  400.               CALL PLACE(mfors,nfors,imo,MCHAM1.NOMCHE(i))
  401.               IF (imo.NE.0) THEN
  402.                 IPT(imo) = MCHAM1.IELVAL(i)
  403. c*                segment active et desactive dans FSMA.D (ci-dessous)
  404. c*                MELVA1 = IPT(imo)
  405. c*                SEGACT,MELVA1
  406.               ENDIF
  407.  15         CONTINUE
  408.           ENDIF
  409. C
  410. C        INITIALISATION DU CHELEM ELEMENTAIRE DES FORCES NODALES
  411. C
  412.           N1=1
  413.           L1=6
  414.           N3=6
  415.           SEGINI MCHELM
  416.           TITCHE='FORCES'
  417.           IFOCHE=IFOUR
  418.           IPCHEL=MCHELM
  419. C
  420.           IMACHE(1)=IPOGEO
  421.           INFCHE(1,1)=0
  422.           INFCHE(1,2)=0
  423.           INFCHE(1,3)=NHRM
  424.           INFCHE(1,4)=IPTINT
  425.           INFCHE(1,5)=0
  426.           INFCHE(1,6)=INTYPC
  427. C
  428. C        RECHERCHE DE LA TAILLE DES MELVALS
  429. C
  430.           N1PTEL=NBNN
  431.           N1EL  =NBEL
  432.           N2PTEL=0
  433.           N2EL  =0
  434. C
  435. C        CREATION DU MCHAML DE LA SOUS ZONE
  436. C
  437.           N2 = NCOMP
  438.           SEGINI,MCHAML
  439.           ICHAML(1)=MCHAML
  440.           NSR = 1
  441.           NCOSOR = NCOMP
  442.           SEGINI,MPTVAL
  443.           IVAFOR=MPTVAL
  444.           NOMID=MOFORC
  445.           DO ICOMP=1,NCOMP
  446.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  447.             TYPCHE(ICOMP)='REAL*8'
  448.             SEGINI,MELVAL
  449.             IELVAL(ICOMP)=MELVAL
  450.             IVAL(ICOMP)=MELVAL
  451.           ENDDO
  452. *
  453. *____________________________________________________________________
  454. *
  455. * TRAITEMENT DU CHAMP DE CARACTERISTIQUES
  456. *____________________________________________________________________
  457. *
  458.           IF (MOCARA.NE.0) THEN
  459. *
  460. *        CREATION DU TABLEAU INFOS
  461. *
  462.             CALL IDENT (IPMAIL,CONM,IPCARA,0,INFOS,IRTD)
  463.             IF (IRTD.EQ.0) THEN
  464.               SEGSUP MCHELM
  465.               RETURN
  466.             ENDIF
  467. *
  468.             CALL KOMCHA(IPCARA,IPMAIL,CONM,MOCARA,MOTYPC,0,
  469.      &                                       INFOS,3,IVACAR)
  470.             IF (IERR.NE.0) GOTO 9100
  471. *
  472.             IF (ISUPCA.EQ.1) THEN
  473.               CALL VALCHE(IVACAR,NCARR,IPTINT,IPPORE,MOCARA,MELE)
  474.             ENDIF
  475. *
  476.           ENDIF
  477. C
  478. C  CALCUL DES FORCES NODALES EQUIVALENTES
  479. C  BRANCHEMENT SUIVANT LE TYPE DES ELEMENTS
  480. C
  481. C           CAS DES ELEMENTS MASSIFS BIDIMENSIONNELS
  482. C           FACES ASSOCIEES SEG2 OU SEG3
  483. C
  484.           IF (MELE.EQ.2 .OR. MELE.EQ.3) THEN
  485. C
  486.             CALL FSMA2D(IPT,IPOGEO,IPTINT,IPVECT,VEC,IVAFOR,IVACAR)
  487. C
  488. C           CAS DES ELEMENTS MASSIFS TRIDIMENSIONNELS
  489. C           FACES ASSOCIEES FAC3,FAC4,FAC6 OU FAC8
  490. C
  491.           ELSE IF (MELE.EQ.31 .OR. MELE.EQ.32 .OR. MELE.EQ.33 .OR.
  492.      &            MELE.EQ.34) THEN
  493. C
  494.             CALL FSMA3D(IPT,IPOGEO,IPTINT,IPVECT,VEC,IVAFOR)
  495. C
  496.           ELSE
  497. C
  498. C           ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE
  499. C
  500.             GOTO 9100
  501.          ENDIF
  502. C
  503. C        ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN
  504. C        ET ON ADDITIONNE LES CHAM/POIN ELEMENTAIRES
  505. C
  506.          CALL CHAMPO(IPCHEL,0,IPCHPO,IRET)
  507. C*       CALL DTCHAM(IPCHEL)
  508.          IF (IRET.EQ.0) THEN
  509.             GOTO 9100
  510.          ENDIF
  511.          IF (IRRT.GT.1) THEN
  512.             CALL ADCHPO(IPCHPO,IPFTP,IPPT,1.D0,1.D0)
  513. ****        CALL ECRCHA(MOGEOM)
  514.             CALL DTCHPO(IPCHPO)
  515. ****        CALL ECRCHA(MOGEOM)
  516.             CALL DTCHPO(IPFTP)
  517.             IF (IPPT.EQ.0) THEN
  518.                GOTO 9100
  519.             ENDIF
  520.             IPFTP=IPPT
  521.          ELSE
  522.             IPFTP=IPCHPO
  523.          ENDIF
  524.  
  525.  9100     CONTINUE
  526. c*        CALL DTMVAL(IVAFOR,3)
  527.           IF (MOCARA.NE.0) THEN
  528.             IF (ISUPCA.EQ.1) THEN
  529.               CALL DTMVAL(IVACAR,3)
  530.             ELSE
  531.               CALL DTMVAL(IVACAR,1)
  532.             ENDIF
  533.           ENDIF
  534.  
  535.  110    CONTINUE
  536.  
  537.  102    CONTINUE
  538.         nomid = MOFORC
  539.         IF (lsupfo) SEGSUP,nomid
  540.  101    CONTINUE
  541.         IF (IERR.NE.0) GOTO 900
  542.  
  543.  100  CONTINUE
  544. *--------------------------------- FIN de la BOUCLE sur les SOUS-MODELES
  545.  
  546.       IF (IRRT.EQ.0) THEN
  547.         IPFTP = 0
  548.         CALL ERREUR(395)
  549. c        GOTO 900
  550.       ENDIF
  551. C
  552. C     GESTION FINALE DES SEGMENTS
  553. C
  554.  900  CONTINUE
  555.       NOMID = MOCARA
  556.       IF (MOCARA.NE.0) SEGSUP,NOMID
  557.       NOTYPE = MOTYPC
  558.       SEGSUP,NOTYPE
  559.  
  560.       SEGSUP,IMODE1,MMODE1
  561.  
  562. c      RETURN
  563.       END
  564.  
  565.  
  566.  

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