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

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