Télécharger la plaquette Cast3M


fr en

Télécharger fpfiss.eso

Retour à la liste

Numérotation des lignes : 

fpfiss

  1. C FPFISS    SOURCE    CB215821  24/04/12    21:16:02     11897          
  2.       SUBROUTINE FPFISS(P,IPCHE1,IPMODL,IPVECT,IPPOIN,IPCHE2,
  3.      1                  IPTFP,IRET)
  4. C_____________________________________________________________________
  5. C
  6. C   CALCULE LES FORCES DE PRESSIONS APPLIQUEES SUR DES LEVRES D UNE
  7. C           FISSURE (ELT LINESPRING)
  8. C
  9. C   ENTREES :
  10. C   ---------
  11. C
  12. C       P        VALEUR DE LA PRESSION SI ELLE EST CONSTANTE
  13. C       IPCHE1   CHPOINT CONTENANT LES VALEURS DES PRESSIONS AUX NOEUDS
  14. C       IPMODL   OBJET MMODEL SUR LEQUEL S APPLIQUE LA PRESSION
  15. C       IPVECT   VECTEUR INDIQUANT LA DIRECTION DANS LAQUELLE
  16. C                 S APPLIQUE LA PRESSION
  17. C       IPPOIN   POINT OU SE RAPPORTE LE VECTEUR
  18. C       IPCHE2   MCHAML CONTENANT LES CARACTERISTIQUES
  19. C
  20. C   SORTIE :
  21. C   --------
  22. C
  23. C       IPTFP    CHPOINT DES FORCES NODALES EQUIVALENTES
  24. C       IRET     1 OU 0 SUIVANT SUCCES OU NON
  25. C
  26. C     REVISION JACQUELINE BROCHARD  SEPTEMBRE 86
  27. C     PASSAGE AUX NOUVEAUX MCHAMLS PAR JM CAMPENON LE 05 09 90
  28. C
  29. C_____________________________________________________________________
  30.       IMPLICIT INTEGER(I-N)
  31.       IMPLICIT REAL*8(A-H,O-Z)
  32. C
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCHAMP
  37. C
  38. -INC SMCOORD
  39. -INC SMELEME
  40. -INC SMMODEL
  41. -INC SMCHAML
  42. -INC SMCHPOI
  43. -INC SMINTE
  44. C
  45. C     SEGMENT DONNANT LE POINTEUR DE MAILLAGE CORRECTE AU MCHAML DE
  46. C     CARACTERISTIQUE APRES CREATION D'UN MMODEL
  47. C
  48.       logical ltelq
  49.       SEGMENT JPMAIL
  50.          INTEGER MAIL1 (NSOUS1)
  51.          INTEGER MAIL2 (NSOUS1)
  52.       ENDSEGMENT
  53. *
  54.       SEGMENT NOTYPE
  55.         CHARACTER*16 TYPE(NBTYPE)
  56.       ENDSEGMENT
  57. C
  58.       SEGMENT MPTVAL
  59.         INTEGER IPOS(NS)    ,NSOF(NS)
  60.         INTEGER      IVAL(NCOSOU)
  61.         CHARACTER*16 TYVAL(NCOSOU)
  62.       ENDSEGMENT
  63. C
  64.       DIMENSION V(3),XP(3)
  65.       DIMENSION BPSS(3,3),XE(3,4),XEL(3,3),V1(3),V2(3),H1(3),H2(3)
  66.       CHARACTER*8 MOT
  67.       CHARACTER*(NCONCH) CONM
  68.       PARAMETER ( NINF=3 )
  69.       INTEGER INFOS(NINF)
  70.       LOGICAL lsupfo
  71. C
  72.       DATA X774/.774596669241483D0/
  73.       DATA UN,UNDEMI,ZERO/1.D0,.5D0,0.D0/
  74.       DATA MOT/'NOEUD   '/
  75.  
  76.           lsupfo=.false.
  77.       IRET=0
  78. C
  79. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  80. C
  81.       CALL QUESUP(IPMODL,IPCHE2,3,0,ISUP,IRETOU)
  82.       IF (ISUP.GT.1) RETURN
  83. C
  84.       IFLAG=0
  85.       NHRM=NIFOUR
  86. C
  87. C     ON RECUPERE LES COORDONNEES DU VECTEUR
  88. C
  89.       IREF=(IPVECT-1)*(IDIM+1)
  90.       V(1)=XCOOR(IREF+1)
  91.       V(2)=XCOOR(IREF+2)
  92.       IF (IDIM.EQ.2) THEN
  93.          VN=SQRT(V(1)**2+V(2)**2)
  94.          IF (VN.EQ.0.) THEN
  95.             CALL ERREUR(277)
  96.             RETURN
  97.          ENDIF
  98.          V(1)=V(1)/VN
  99.          V(2)=V(2)/VN
  100.       ELSE
  101.          V(3)=XCOOR(IREF+3)
  102.          VN=SQRT(V(1)**2+V(2)**2+V(3)**2)
  103.          IF (VN.EQ.0.) THEN
  104.             CALL ERREUR(277)
  105.             RETURN
  106.          ENDIF
  107.          V(1)=V(1)/VN
  108.          V(2)=V(2)/VN
  109.          V(3)=V(3)/VN
  110.       ENDIF
  111. C
  112. C     LE FLAG SERT A INDIQUER SI L'ON DOIT OU NON DETRUIRE LE MODELE
  113. C     EN CAS DE CREATION  ( 0 : DESTRUCTION D'UN MMODEL CREE )
  114. C
  115.       JPMAIL=0
  116.       IF (IPCHE1.NE.0) THEN
  117. C
  118. C        ON CREE LE MMODEL S'ACCROCHANT AU CHPOINT
  119. C
  120.          CALL NOMCOM(IPCHE1,'SCAL',IPCHE,IRETOU)
  121.          IF (IERR.NE.0) RETURN
  122. C
  123. C        ON CREE L OBJET MAILLAGE CONTENANT TOUS LES POINT DU CHPOINT
  124. C
  125.          MCHPOI=IPCHE
  126.          SEGACT MCHPOI
  127.          NSOUPO=IPCHP(/1)
  128.          IPGEOM = 0
  129.          DO 1140 I=1,NSOUPO
  130.             MSOUPO=IPCHP(I)
  131.             SEGACT MSOUPO
  132.             IF (IPGEOM.EQ.0) THEN
  133.                IPGEOM = IGEOC
  134.             ELSE
  135.                IPP2 = IGEOC
  136.                ltelq=.false.
  137.                CALL FUSE (IPGEOM,IPP2,IPPT,ltelq)
  138.                IPGEOM = IPPT
  139.             ENDIF
  140.             SEGDES MSOUPO
  141.  1140    CONTINUE
  142.          SEGDES MCHPOI
  143. C
  144.          N1=0
  145.          SEGINI MMODEL
  146.          IPMOD=MMODEL
  147. C
  148.          MMODE1=IPMODL
  149.          SEGACT MMODE1
  150.          NSOUS1=MMODE1.KMODEL(/1)
  151. C
  152. C        BOUCLE SUR LES SOUS ZONE GEOMETRIQUE ELEMENTAIRE
  153. C
  154.          IRRT=0
  155.          DO 50 ISOUS=1,NSOUS1
  156.             IMODE1=MMODE1.KMODEL(ISOUS)
  157.             SEGACT IMODE1
  158.             ITGEOM=IMODE1.IMAMOD
  159.             CALL ECROBJ('MAILLAGE',IPGEOM)
  160.             CALL ECRCHA('STRI')
  161.             CALL ECRCHA('APPU')
  162.             CALL ECROBJ('MAILLAGE',ITGEOM)
  163.             CALL EXTREL(IRR,0,IBNOR)
  164.             IF (IRR.EQ.0) THEN
  165. C
  166. C              ON A VERIFIER L ADHERENCE DU CHPOINT A CE MAILLAGE
  167. C
  168.                CALL LIROBJ('MAILLAGE',IPOGEO,1,IRETOU)
  169.                IF (IERR.NE.0) THEN
  170.                   SEGDES MMODE1
  171.                   SEGDES IMODE1
  172.                   SEGSUP MMODEL
  173.                   RETURN
  174.                ENDIF
  175.                N1=N1+1
  176.                SEGADJ MMODEL
  177. C
  178. C              CREATION DE L'OBJET IMODEL DE CETTE SOUS ZONE
  179. C
  180.                NFOR=IMODE1.FORMOD(/2)
  181.                NMAT=IMODE1.MATMOD(/2)
  182.                MN3 =IMODE1.INFMOD(/1)
  183.                NPARMO=0
  184.                nobmod=0
  185. C
  186.                SEGINI IMODEL
  187.                conmod(17:24)='        '
  188.                IMAMOD=IPOGEO
  189.                NEFMOD=IMODE1.NEFMOD
  190.                CONMOD=IMODE1.CONMOD
  191.                IPDPGE=IMODE1.IPDPGE
  192. C
  193. C              CREATION D'UN TABLEAU DE CORRESPONDANCE LE IMAMOD DU
  194. C              MMODEL (IPMODL) ET DU IMAMOD DU NVX MMODEL QUE L'ON CREE
  195. C
  196.                IF (JPMAIL.EQ.0) SEGINI JPMAIL
  197.                MAIL1(ISOUS)=ITGEOM
  198.                MAIL2(ISOUS)=IPOGEO
  199.                DO 47 I=1,MN3
  200.                   INFMOD(I)=IMODE1.INFMOD(I)
  201.  47            CONTINUE
  202.                CONMOD=IMODE1.CONMOD
  203.                DO 48 I=1,NFOR
  204.                   FORMOD(I)=IMODE1.FORMOD(I)
  205.  48            CONTINUE
  206.                DO 49 I=1,NMAT
  207.                   MATMOD(I)=IMODE1.MATMOD(I)
  208.  49            CONTINUE
  209.                KMODEL(N1)=IMODEL
  210.                SEGDES IMODEL
  211.             ELSE
  212. C
  213. C              LE CHPOINT N'ADHERE PAS A CETTE ZONE
  214. C
  215.                IRRT=IRRT+1
  216.             ENDIF
  217.             SEGDES IMODE1
  218.  50      CONTINUE
  219.          SEGDES MMODE1
  220.          SEGDES MMODEL
  221. C
  222.          IF (NSOUPO.GT.1) THEN
  223.             MELEME=IPGEOM
  224.             SEGSUP MELEME
  225.          ENDIF
  226. C
  227.          IF (IRRT.EQ.NSOUS1) THEN
  228. C
  229. C           L'OBJET MAILLAGE ET LE CHPOINT SONT INCOMPATIBLES
  230. C
  231.             MOTERR(1:8)='MAILLAGE'
  232.             MOTERR(9:16)='CHPOINT'
  233.             CALL ERREUR(135)
  234.             MMODEL=IPMOD
  235.             SEGSUP MMODEL
  236.             RETURN
  237.          ENDIF
  238. C
  239.          CALL CHAME1(0,IPMOD,IPCHE,' ',IPCH1,3)
  240.          IF (IERR.NE.0) THEN
  241.             CALL DTMODL(IPMOD)
  242.             SEGSUP JPMAIL
  243.             RETURN
  244.          ENDIF
  245.       ELSE
  246.         IFLAG=1
  247.         IPMOD=IPMODL
  248.         CALL ZEROP(IPMOD,MOT,IPCH1)
  249.         IF (IERR.NE.0) RETURN
  250.         MCHEL1=IPCH1
  251.         SEGACT MCHEL1
  252.         NSOUS=MCHEL1.ICHAML(/1)
  253.         DO 11 ISOUS=1,NSOUS
  254.            MCHAM1=MCHEL1.ICHAML(ISOUS)
  255.            SEGACT MCHAM1
  256.            MELVA1=MCHAM1.IELVAL(1)
  257.            SEGACT MELVA1
  258.            N1PTEL=MELVA1.VELCHE(/1)
  259.            N1EL  =MELVA1.VELCHE(/2)
  260.            DO 9 IGAU=1,N1PTEL
  261.               DO 9 IB=1,N1EL
  262.                  MELVA1.VELCHE(IGAU,IB)=P
  263.  9         CONTINUE
  264.            SEGDES MELVA1
  265.            SEGDES MCHAM1
  266.  11     CONTINUE
  267.         SEGDES MCHEL1
  268.       ENDIF
  269. C
  270. C     ACTIVATION DU MODEL
  271. C
  272.       MMODEL=IPMOD
  273.       SEGACT MMODEL
  274.       NSOUS=KMODEL(/1)
  275. C
  276. C     CREATION DU MCHELM DES FORCES NODALES
  277. C
  278.       N1=NSOUS
  279.       L1=5
  280.       N3=5
  281.       SEGINI MCHELM
  282.       IPCHEL=MCHELM
  283.       TITCHE='FORCE'
  284.       IFOCHE=IFOUR
  285. C_______________________________________________________________________
  286. C
  287. C      BOUCLE SUR LES SOUS ZONES DU MAILLAGE
  288. C_______________________________________________________________________
  289. C
  290.       DO 500 ISOUS=1,NSOUS
  291. C
  292. C        ON RECUPERE L INFORMATION GENERALE
  293. C
  294.          IMODEL=KMODEL(ISOUS)
  295.          SEGACT IMODEL
  296.          IPMAIL=IMAMOD
  297.          CONM  =CONMOD
  298.          IMACHE(ISOUS)=IPMAIL
  299. C
  300. C        TRAITEMENT DU MODEL
  301. C
  302.          MELE=NEFMOD
  303. C
  304. C        ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE
  305.          IF (MELE.NE.30) THEN
  306.             MOTERR(1:4)=NOMTP(MELE)
  307.             MOTERR(5:12)='FPFISS'
  308.             CALL ERREUR(86)
  309.             SEGDES IMODEL,MMODEL
  310.             SEGSUP MCHELM
  311.             IF (IFLAG.EQ.0) CALL DTMODL (IPMOD)
  312.             IF (JPMAIL.NE.0) SEGSUP JPMAIL
  313.             RETURN
  314.          ENDIF
  315. C
  316.          MELEME=IMAMOD
  317.          IPTGEO=MELEME
  318. C
  319. C        INFORMATION SUR L'ELEMENT FINI
  320. C
  321. *         CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  322. *         IF (IERR.NE.0) THEN
  323. *            SEGDES IMODEL,MMODEL
  324. *            SEGSUP MCHELM
  325. *            IF (IFLAG.EQ.0) CALL DTMODL (IPMOD)
  326. *            IF (JPMAIL.NE.0) SEGSUP JPMAIL
  327. *            RETURN
  328. *         ENDIF
  329. *         INFO=IPINF
  330.          MFR   =INFELE(13)
  331. *         IPTINT=INFELE(11)
  332.          IPTINT=infmod(5)
  333.          MINTE=IPTINT
  334.          SEGACT,MINTE
  335. *         SEGSUP INFO
  336. C
  337. C        CREATION DU TABLEAU INFOS
  338. C
  339.          CALL IDENT(IPMAIL,CONM,IPCH1,IPCHE2,INFOS,IRTD)
  340.          IF (IRTD.EQ.0) THEN
  341.             SEGDES,MINTE
  342.             SEGDES IMODEL,MMODEL
  343.             SEGSUP MCHELM
  344.             IF (IFLAG.EQ.0) CALL DTMODL (IPMOD)
  345.             IF (JPMAIL.NE.0) SEGSUP JPMAIL
  346.             RETURN
  347.          ENDIF
  348. C
  349.          INFCHE(ISOUS,1)=0
  350.          INFCHE(ISOUS,2)=0
  351.          INFCHE(ISOUS,3)=NHRM
  352.          INFCHE(ISOUS,4)=IPTINT
  353.          INFCHE(ISOUS,5)=0
  354. C
  355. C        RECHERCHE DU MELVAL DU CHAMELEM DE PRESSION
  356. C
  357.          NCARA=0
  358.          NCARF=0
  359.          MOCARA=0
  360.          NFOR=0
  361.          MOFORC=0
  362. C
  363.          NBROBL=1
  364.          NBRFAC=0
  365.          SEGINI NOMID
  366.          MOSCAL=NOMID
  367.          LESOBL(1)='SCAL'
  368. *
  369.          NBTYPE=1
  370.          SEGINI NOTYPE
  371.          MOTYPE=NOTYPE
  372.          TYPE(1)='REAL*8'
  373. *
  374.          CALL KOMCHA(IPCH1,IPMAIL,CONM,MOSCAL,MOTYPE,1,INFOS,3,IVASCA)
  375.          SEGSUP NOTYPE
  376.          IF (IERR.NE.0) GOTO 9990
  377.          SEGDES NOMID
  378.          MPTVAL=IVASCA
  379.          IPTVPR=IVAL(1)
  380. C
  381. C        CALCUL DES FORCES NODALES EQUIVALENTES
  382. C        BRANCHEMENT SUIVANT LE TYPE DES ELEMENTS
  383. C
  384. C           RECHERCHE DES NOM DE COMPOSANTES
  385. C
  386.         if(lnomid(2).ne.0) then
  387.           nomid=lnomid(2)
  388.           segact nomid
  389.           moforc=nomid
  390.           nfor=lesobl(/2)
  391.           nfac=0
  392.           lsupfo=.false.
  393.         else
  394.           lsupfo=.true.
  395.           CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC)
  396.         endif
  397. C
  398. C           ELEMENT LINESPRING
  399. C
  400.             SEGACT MELEME
  401.             NBNN  =NUM(/1)
  402.             NBELEM=NUM(/2)
  403.             IPPORE=0
  404.             IF(MFR.EQ.33) IPPORE=NBNN
  405.  
  406. C     CREATION DU MCHAML DE LA SOUS ZONE
  407. C
  408. C     INIT DU MELVAL DEVANT CONTENIR LES FORCES DE PRESSION
  409. C
  410.             N1PTEL=4
  411.             N1EL=NBELEM
  412.             N2PTEL=0
  413.             N2EL=0
  414. C
  415.             N2=NFOR
  416.             SEGINI MCHAML
  417.             ICHAML(ISOUS)=MCHAML
  418.             NS=1
  419.             NCOSOU=NFOR
  420.             SEGINI MPTVAL
  421.             IVAFOR=MPTVAL
  422.             NOMID=MOFORC
  423.             SEGACT NOMID
  424.             DO 1100 ICOMP=1,NFOR
  425.                NOMCHE(ICOMP)=LESOBL(ICOMP)
  426.                TYPCHE(ICOMP)='REAL*8'
  427.                SEGINI MELVAL
  428.                IELVAL(ICOMP)=MELVAL
  429.                IVAL(ICOMP)=MELVAL
  430.  1100       CONTINUE
  431.             SEGDES NOMID
  432. C
  433. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES POUR LES LINESPRING
  434. C
  435.             NBROBL=5
  436.             NBRFAC=0
  437.             SEGINI NOMID
  438.             MOCARA=NOMID
  439.             LESOBL(1)='EPAI'
  440.             LESOBL(2)='FISS'
  441.             LESOBL(3)='VX  '
  442.             LESOBL(4)='VY  '
  443.             LESOBL(5)='VZ  '
  444.             IF (JPMAIL.NE.0) THEN
  445. C
  446. C              ON RECUPERE LE IMAMOD DU MMODEL D'ORIGINE POUR QUE LE
  447. C              DONNE CORRESPONDE A CELUI DE IPCHE21
  448. C
  449.                DO 60 KISOUS=1,NSOUS1
  450.                   IF (IPMAIL.EQ.MAIL2(KISOUS)) THEN
  451.                      IPMAI1=MAIL1(KISOUS)
  452.                      GOTO 61
  453.                   ENDIF
  454.  60            CONTINUE
  455. C
  456. C              NE DOIT NORMALEMENT JAMAIS SE PRODUIRE
  457. C
  458.                CALL ERREUR (472)
  459.                GOTO 9990
  460.             ELSE
  461.               IPMAI1=IPMAIL
  462.             ENDIF
  463.  61         CONTINUE
  464. C
  465.            NBTYPE=1
  466.            SEGINI NOTYPE
  467.            MOTYPE=NOTYPE
  468.            TYPE(1)='REAL*8'
  469. *
  470.             CALL KOMCHA(IPCHE2,IPMAI1,CONM,MOCARA,MOTYPE,
  471.      1                                     1,INFOS,3,IVACAR)
  472.             SEGSUP NOTYPE
  473.             IF (IERR.NE.0) GOTO 9990
  474. C
  475.             NCARA=NBROBL
  476.             NCARF=NBRFAC
  477.             NCARR=NCARA+NCARF
  478. C
  479.             IF (ISUP.EQ.1) THEN
  480.                CALL VALCHE(IVACAR,NCARR,IPTINT,IPPORE,MOCARA,MELE)
  481.             ENDIF
  482. C
  483.             SEGDES NOMID
  484. C
  485. C           ELEMENT LINESPRING
  486. C
  487.             CALL FPLISP(IPTVPR,IPTGEO,IPTINT,IVACAR,IVAFOR)
  488. C
  489. C           DESACTIVATION DES SEGMENT PROPRE A LA GEOMETRIE ISOUS
  490. C
  491.             SEGDES,MINTE
  492.             SEGDES IMODEL
  493.             SEGDES MCHAML
  494. C
  495.             IF (ISUP.EQ.1) THEN
  496.               CALL DTMVAL(IVACAR,3)
  497.             ELSE
  498.               CALL DTMVAL(IVACAR,1)
  499.             ENDIF
  500. C
  501.             CALL DTMVAL(IVAFOR,1)
  502. C
  503.             CALL DTMVAL(IVASCA,1)
  504. C
  505.             NOMID=MOFORC
  506.             if(lsupfo)SEGSUP NOMID
  507.             NOMID=MOCARA
  508.             SEGSUP NOMID
  509.             NOMID=MOSCAL
  510.             SEGSUP NOMID
  511. C
  512.             SEGDES MELEME
  513. C
  514.  500  CONTINUE
  515.       SEGDES MMODEL
  516.       IF (IFLAG.EQ.0) CALL DTMODL(IPMOD)
  517.       IF (JPMAIL.NE.0) SEGSUP JPMAIL
  518. C
  519. C     ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN
  520. C
  521. C*    SEGDES MCHELM
  522.       CALL CHAMPO(IPCHEL,0,IPTFP,IRETOU)
  523.       CALL DTCHAM(IPCHEL)
  524.       IF (IRETOU.EQ.0) RETURN
  525. C
  526. C     ON COMPARE LE SENS DE LA FORCE AU SENS DU VECTEUR AU POINT INDIQUE
  527. C
  528.       MCHPOI=IPTFP
  529.       SEGACT MCHPOI
  530.       DO 201 I=1,IPCHP(/1)
  531.          MSOUPO=IPCHP(I)
  532.          SEGACT MSOUPO
  533.          MELEME=IGEOC
  534.          SEGACT MELEME
  535.          DO 202 K=1,NUM(/2)
  536.             IF (NUM(1,K).EQ.IPPOIN) GO TO 205
  537. 202      CONTINUE
  538.          SEGDES MSOUPO,MELEME
  539. 201   CONTINUE
  540. C
  541. C     LE POINT DONNE N APPARTIENT PAS A LA STRUCTURE
  542. C
  543.       INTERR(1)=IPPOIN
  544.       MOTERR(1:8)=' '
  545.       CALL ERREUR(64)
  546.       SEGDES MCHPOI
  547.       RETURN
  548. C
  549.  205  CONTINUE
  550.       SEGDES MELEME
  551.       MPOVAL=IPOVAL
  552.       SEGACT MPOVAL
  553.       FN2=ZERO
  555.       DO 210 J=1,IDIM
  556.          r_z = VPOCHA(K,J)
  557.          FN2=FN2 + r_z*r_z
  558.          TEST=TEST+ V(J)*r_z
  559.  210  CONTINUE
  560.       FN=SQRT(FN2)
  561.       SEGDES MPOVAL,MSOUPO,MCHPOI
  562. C
  563. C     ERREUR    IMPOSSIBLE D ORIENTER LES FORCES DE PRESSION
  564. C
  565.       IF (ABS(TEST).LE.0.025*FN) THEN
  566.          CALL ERREUR(192)
  567.          RETURN
  568.       ENDIF
  569.       IF (TEST.LE.0.) THEN
  570.         XFLOT=-UN
  571.         CALL MUCHPO(IPTFP,XFLOT,IPTFP0,1)
  572.         CALL DTCHPO(IPTFP)
  573.         IPTFP=IPTFP0
  574.       ENDIF
  575.       IRET = 1
  576.       RETURN
  577. C
  578. C     ERREUR DANS UNE SOUS ZONE / DESACTIVATION ET RETOUR
  579. C
  580.  9990 CONTINUE
  581.       IRET=0
  582.       IF (IFLAG.EQ.0) CALL DTMODL(IPMOD)
  583.       IF (JPMAIL.NE.0) SEGSUP JPMAIL
  584. C
  585.       SEGSUP MCHELM
  586. C
  587.       IF (ISUP.EQ.1) THEN
  588.         CALL DTMVAL(IVACAR,3)
  589.       ELSE
  590.         CALL DTMVAL(IVACAR,1)
  591.       ENDIF
  592. C
  593.       CALL DTMVAL(IVAFOR,3)
  594. C
  595.       CALL DTMVAL(IVASCA,1)
  596. C
  597.       NOMID=MOCARA
  598.       IF (MOCARA.NE.0) SEGSUP NOMID
  599.       NOMID=MOFORC
  600.       IF (lsupfo.and.MOFORC.NE.0) SEGSUP NOMID
  601.       NOMID=MOSCAL
  602.       SEGSUP NOMID
  603. C
  604.       SEGDES,MINTE
  605.       SEGDES IMODEL
  606.       SEGDES MMODEL
  607. C
  608. C
  609.       RETURN
  610.       END
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  

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