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

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