Télécharger la plaquette Cast3M


fr en

Télécharger com433.eso

Retour à la liste

Numérotation des lignes : 

com433

  1. C COM433    SOURCE    JC220346  16/11/29    21:15:04     9221           
  2. C---------------------------------------------------------------------|
  3. C                                                                     |
  4.        SUBROUTINE COM433(II,MF1,MF2,MF3,IGAGNE)
  5. C                                                                     |
  6. C      CETTE SUBROUTINE TENTE DE CREER 1 PYRAMIDE ET 2 TETRAEDRES     |
  7. C      A PARTIR DU QUADRANGLE IF1 ET DES TRIANGLES IF2 ET IF3 EN      |
  8. C      CREANT UN POINT CENTRAL SUPPLEMENTAIRE                         |
  9. C      - IGAGNE=1 EN CAS DE SUCCES                                    |
  10. C      - IGAGNE=0 EN CAS D'ECHEC                                      |
  11. C                                                                     |
  12. C---------------------------------------------------------------------|
  13. C
  14.       IMPLICIT INTEGER(I-N)
  15.       IMPLICIT REAL*8(A-H,O-Z)
  16. -INC TDEMAIT
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20.        LOGICAL REPONS,FACET,SOLPYR,SOLTET,IN2,diago
  21.       nfcini=nfcmax
  22.       nptini=nptmax
  23.       nvini=nvol
  24.       ICTP=0
  25.       ipin = 0
  26. C
  27. C  METTRE LES FACES DANS L'ORDRE
  28.       IF1=MF1
  29.       IP=ISUCC(IF1,II)
  30.       IF (IP.EQ.IPRED(MF2,II)) IF2=MF2
  31.       IF (IP.EQ.IPRED(MF3,II)) IF2=MF3
  32.       IP=ISUCC(IF2,II)
  33.       IF (IP.EQ.IPRED(MF2,II)) IF3=MF2
  34.       IF (IP.EQ.IPRED(MF3,II)) IF3=MF3
  35. *     WRITE(6,1000)IF1,IF2,IF3
  36.  1000   FORMAT(' COM433 IF1=',I5,'  IF2=',I5,'  IF3=',I5)
  37. C
  38.        ICTF=0
  39.        ICTV=0
  40. C
  41. C
  42. C      CREATION DU POINT CENTRAL : IP
  43. C      ------------------------------
  44.        IP1=II
  45.        IP2=ISUCC(IF1,IP1)
  46.        IP3=ISUCC(IF1,IP2)
  47.        IP4=ISUCC(IF1,IP3)
  48.        ICTP=1
  49.        NPTMAX=NPTMAX+1
  50.        IP=NPTMAX
  51. C
  52.        DO 100 I=1,4
  53. *             XYZ(I,IP)=(XYZ(I,IP1)+XYZ(I,IP2)+XYZ(I,IP3)
  54. *    #                  +XYZ(I,IP4))/4.
  55.               XYZ(I,IP)=(XYZ(I,IP2)+XYZ(I,IP4))/2.
  56. 100    CONTINUE
  57.        JP1=II
  58.        JP2=ISUCC(IF2,JP1)
  59.        JP3=ISUCC(IF2,JP2)
  60. C
  61.        DO 102 I=1,4
  62.               XYZ(I,IP)=XYZ(I,IP)+
  63.      #   (XYZ(I,JP2)+XYZ(I,JP3))/2.
  64. 102    CONTINUE
  65.        KP1=II
  66.        KP2=ISUCC(IF3,KP1)
  67.        KP3=ISUCC(IF3,KP2)
  68. C
  69.        DO 104 I=1,4
  70.               XYZ(I,IP)=(XYZ(I,IP)+
  71.      #  (XYZ(I,KP2)+XYZ(I,KP3))/2.)/3.
  72. 104    CONTINUE
  73.        DO 103 I=1,3
  74.          XYZ(I,IP)=XYZ(I,II)+expcom*(XYZ(I,IP)-XYZ(I,II))
  75. 103    CONTINUE
  76. C
  77. *       WRITE(6,1010)IP,(XYZ(I,IP),I=1,4)
  78.  1010   FORMAT(' POINT:',I3,':',4F7.2)
  79. C
  80. *   verif des volumes
  81.        if ((vol(ip,ii,ip2,ip4).gt.0).or.
  82.      >     (vol(ip,ii,jp2,jp3).gt.0).or.
  83.      >     (vol(ip,ii,kp2,kp3).gt.0)) then
  84.          IF (IVERB.EQ.1) write (6,*) ' com433 volume positif '
  85.          nptmax=nptini
  86.          return
  87.        endif
  88. C
  89.        CALL DIST(IP,JP,GL,IOK,IP1,IP2,IP3,IP4,JP2,JP3,KP2,KP3,0,0)
  90.        IF (IOK.EQ.0) THEN
  91.        NPTMAX=NPTini
  92.        RETURN
  93.        ICTP=0
  94.        NPTMAX=NPTMAX-1
  95.        IP=JP
  96.        return
  97. *      WRITE (6,*) ' COM433 POINT ASSIMILE ',JP
  98.        ENDIF
  99.        REPONS=IN2(ii,IP,nfcini)
  100.        IF (REPONS) GOTO 110
  101.        NPTMAX=NPTini
  102.        RETURN
  103. C
  104. 110    CONTINUE
  105. C
  106. C      CREATION D'UNE PYRAMIDE : IF1+IP
  107. C      --------------------------------
  108.        IP1=ISUCC(IF1,II)
  109.        IP2=ISUCC(IF1,IP1)
  110.        IP3=ISUCC(IF1,IP2)
  111. *     recherche existence de la face
  112.        jf1=IFACE3(ip,ii,ip1)
  113. *       IF (jf1.ne.0) write (6,*) ' com433 facette assimilee'
  114.        IF (jf1.eq.0) THEN
  115.         nfcmax=nfcmax+1
  116.         jf1=nfcmax
  117.         NFC(1,jf1)=ip
  118.         NFC(2,jf1)=ii
  119.         NFC(3,jf1)=ip1
  120.         NFC(4,jf1)=0
  121.        elseif (NFC(4,jf1).ne.0.or.ipred(jf1,ii).ne.ip1) then
  122.         jf1=0
  123.        endif
  124. *       write (6,*) ' com433 jf1 passe ',jf1
  125. C
  126. *     recherche existence de la face
  127.        jf2=IFACE3(ip,ip1,ip2)
  128. *       IF (jf2.ne.0) write (6,*) ' com433 facette assimilee'
  129.        IF (jf2.eq.0) THEN
  130.         nfcmax=nfcmax+1
  131.         jf2=nfcmax
  132.         NFC(1,jf2)=ip
  133.         NFC(2,jf2)=ip1
  134.         NFC(3,jf2)=ip2
  135.         NFC(4,jf2)=0
  136.        elseif (NFC(4,jf2).ne.0.or.ipred(jf2,ip).ne.ip1) then
  137.         jf2=0
  138.        endif
  139.        if (NFC(4,jf2).ne.0) jf2=0
  140. *       write (6,*) ' com433 jf2 passe ',jf2
  141. C
  142. *     recherche existence de la face
  143.        jf3=IFACE3(ip,ip2,ip3)
  144. *       IF (jf3.ne.0) write (6,*) ' com433 facette assimilee'
  145.        IF (jf3.eq.0) THEN
  146.         nfcmax=nfcmax+1
  147.         jf3=nfcmax
  148.         NFC(1,jf3)=ip
  149.         NFC(2,jf3)=ip2
  150.         NFC(3,jf3)=ip3
  151.         NFC(4,jf3)=0
  152.        elseif (NFC(4,jf3).ne.0.or.ipred(jf3,ip).ne.ip2) then
  153.         jf3=0
  154.        endif
  155. *       write (6,*) ' com433 jf3 passe ',jf3
  156. C
  157. *     recherche existence de la face
  158.        jf4=IFACE3(ip,ip3,ii)
  159. *       IF (jf4.ne.0) write (6,*) ' com433 facette assimilee'
  160.        IF (jf4.eq.0) THEN
  161.         nfcmax=nfcmax+1
  162.         jf4=nfcmax
  163.         NFC(1,jf4)=ip
  164.         NFC(2,jf4)=ip3
  165.         NFC(3,jf4)=ii
  166.         NFC(4,jf4)=0
  167.        elseif (NFC(4,jf4).ne.0.or.ipred(jf4,ip).ne.ip3) then
  168.         jf4=0
  169.        endif
  170.        if (NFC(4,jf4).ne.0) jf4=0
  171. *       write (6,*) ' com433 jf4 passe ',jf4
  172. C
  173.        if (diago(ip,ii,diacrd)) then
  174.         jf4=0
  175.         jf1=0
  176.        endif
  177.        if (diago(ip,ip1,diacrd)) then
  178. *       write (6,*) ' com433 jf4 echec diago - 1 ',ip,ip1
  179.         jf1=0
  180.         jf2=0
  181.        endif
  182.        if (diago(ip,ip2,diacrd)) then
  183. *       write (6,*) ' com433 jf4 echec diago - 2 ',ip,ip2
  184.         jf2=0
  185.         jf3=0
  186.        endif
  187.        if (diago(ip,ip3,diacrd)) then
  188. *       write (6,*) ' com433 jf4 echec diago - 3 ',ip,ip3
  189.         jf3=0
  190.         jf4=0
  191.        endif
  192.        if (jf1*jf2*jf3*jf4.eq.0) then
  193. *        write (6,*) 'com433 impossibilite '
  194.         nfcmax=nfcini
  195.         jf1=0
  196.         jf2=0
  197.         jf3=0
  198.         jf4=0
  199.         goto 131
  200.        endif
  201.        CALL REPSUB(IF1)
  202.        CALL REPSUB(JF1)
  203.        CALL REPSUB(JF2)
  204.        CALL REPSUB(JF3)
  205.        CALL REPSUB(JF4)
  206. C
  207. C      LE VOLUME CREE EST-IL VALIDE ?
  208. C      ------------------------------
  209.        IF (.not.SOLPYR(IF1,JF1,JF2,JF3,JF4)) GOTO 129
  210.        IF (.NOT.FACET(jf1)) GOTO 129
  211.        IF (.NOT.FACET(jf2)) GOTO 129
  212.        IF (.NOT.FACET(jf3)) GOTO 129
  213.        IF (.NOT.FACET(jf4)) GOTO 129
  214.        goto 130
  215. C
  216. C      LE VOLUME EST INVALIDE
  217. C      ----------------------
  218.  129   continue
  219. *      write (6,*) ' solpyr 1 invalide'
  220.        NFCMAX=NFCini
  221.        CALL REPSUB(JF4)
  222.        CALL REPSUB(JF3)
  223.        CALL REPSUB(JF2)
  224.        CALL REPSUB(JF1)
  225.        CALL REPSUB(IF1)
  226.         jf1=0
  227.         jf2=0
  228.         jf3=0
  229.         jf4=0
  230.        goto 131
  231. C
  232. 130    CONTINUE
  233. C
  234. C      MEMORISATION DU VOLUME OBTENU : IF1, JF1, JF2, JF3 ET JF4
  235. C      ---------------------------------------------------------
  236.        ICTV=ICTV+1
  237.        NVOL=NVOL+1
  238.        IF (NFV(1,IF1).EQ.0) NFV(1,IF1)=NVOL
  239.        IF (NFV(1,IF1).NE.NVOL) NFV(2,IF1)=NVOL
  240.        IF (NFV(1,JF1).EQ.0) NFV(1,JF1)=NVOL
  241.        IF (NFV(1,JF1).NE.NVOL) NFV(2,JF1)=NVOL
  242.        IF (NFV(1,JF2).EQ.0) NFV(1,JF2)=NVOL
  243.        IF (NFV(1,JF2).NE.NVOL) NFV(2,JF2)=NVOL
  244.        IF (NFV(1,JF3).EQ.0) NFV(1,JF3)=NVOL
  245.        IF (NFV(1,JF3).NE.NVOL) NFV(2,JF3)=NVOL
  246.        IF (NFV(1,JF4).EQ.0) NFV(1,JF4)=NVOL
  247.        IF (NFV(1,JF4).NE.NVOL) NFV(2,JF4)=NVOL
  248.        IVOL(9,NVOL)=35
  249. C
  250.        DO 140 I=1,4
  251.               IVOL(I,NVOL)=NFC(I,IF1)
  252. 140    CONTINUE
  253.        IVOL(5,NVOL)=IP
  254. *C
  255.        if (iimpi.eq.1) write (6,1100) nfacet,(ivol(i,nvol),i=1,5)
  256. 1100   FORMAT(' COM433-1 facettes ',i5,' PYR5 ',5i5)
  257. *C
  258. *       DO 150 J=1,NPTMAX
  259. *              WRITE(6,1110)J,(NPF(I,J),I=1,40)
  260.  1110          FORMAT(I4,4X,40I3)
  261. *150    CONTINUE
  262. C  PV INC
  263. C
  264.  131    continue
  265.         if (nvol.eq.nvini) then
  266.           nptmax=nptini
  267.           return
  268.         endif
  269.         nfcini=nfcmax
  270. C      2EME VOLUME : IF2+IP
  271. C      --------------------
  272.        IP1=ISUCC(IF2,II)
  273.        IP2=ISUCC(IF2,IP1)
  274. C
  275. *     recherche existence de la face
  276.        kf1=IFACE3(ip,ii,ip1)
  277. *       IF (kf1.ne.0) write (6,*) ' com433 facette assimilee'
  278.        IF (kf1.eq.0) THEN
  279.         nfcmax=nfcmax+1
  280.         kf1=nfcmax
  281.         NFC(1,kf1)=ip
  282.         NFC(2,kf1)=ii
  283.         NFC(3,kf1)=ip1
  284.         NFC(4,kf1)=0
  285.        elseif (NFC(4,kf1).ne.0.or.ipred(kf1,ip).ne.ii) then
  286.         kf1=0
  287.        endif
  288. *       write (6,*) ' com433 kf1 passe ',kf1
  289. C
  290. *     recherche existence de la face
  291.        kf2=IFACE3(ip,ip1,ip2)
  292. *       IF (kf2.ne.0) write (6,*) ' com433 facette assimilee'
  293.        IF (kf2.eq.0) THEN
  294.         nfcmax=nfcmax+1
  295.         kf2=nfcmax
  296.         NFC(1,kf2)=ip
  297.         NFC(2,kf2)=ip1
  298.         NFC(3,kf2)=ip2
  299.         NFC(4,kf2)=0
  300.        elseif (NFC(4,kf2).ne.0.or.ipred(kf2,ip).ne.ip1) then
  301.         kf2=0
  302.        endif
  303. *       write (6,*) ' com433 kf2 passe ',kf2
  304. C
  305. *     recherche existence de la face
  306.        kf3=IFACE3(ip,ip2,ii)
  307. *       IF (kf3.ne.0) write (6,*) ' com433 facette assimilee'
  308.        IF (kf3.eq.0) THEN
  309.         nfcmax=nfcmax+1
  310.         kf3=nfcmax
  311.         NFC(1,kf3)=ip
  312.         NFC(2,kf3)=ip2
  313.         NFC(3,kf3)=ii
  314.         NFC(4,kf3)=0
  315.        elseif (NFC(4,kf3).ne.0.or.ipred(kf3,ip).ne.ip2) then
  316.         kf3=0
  317.        endif
  318. *       write (6,*) ' com433 kf3 passe ',kf3
  319. C
  320.        if (diago(ip,ii,diacrd)) then
  321.         kf3=0
  322.         kf1=0
  323.        endif
  324.        if (diago(ip,ip1,diacrd)) then
  325.         kf1=0
  326.         kf2=0
  327.        endif
  328.        if (diago(ip,ip2,diacrd)) then
  329.         kf2=0
  330.         kf3=0
  331.        endif
  332.        if (kf1*kf2*kf3.eq.0) then
  333. *        write (6,*) 'com433 impossibilite '
  334.         nfcmax=nfcini
  335.         kf1=0
  336.         kf2=0
  337.         kf3=0
  338.         goto 161
  339.        endif
  340.        CALL REPSUB(IF2)
  341.        CALL REPSUB(KF1)
  342.        CALL REPSUB(KF2)
  343.        CALL REPSUB(KF3)
  344. C
  345. C      LE VOLUME CREE EST-IL VALIDE ?
  346. C      ------------------------------
  347.        if (.not.SOLTET(IF2,KF1,KF2,KF3,ipin)) goto 160
  348.        IF (.NOT.FACET(kF1)) GOTO 160
  349.        IF (.NOT.FACET(kF2)) GOTO 160
  350.        IF (.NOT.FACET(kF3)) GOTO 160
  351.        GOTO 170
  352. C
  353. 160    CONTINUE
  354. C
  355. *      write (6,*) ' soltet 2 invalide'
  356.        NFCMAX=NFCini
  357.        CALL REPSUB(KF3)
  358.        CALL REPSUB(KF2)
  359.        CALL REPSUB(KF1)
  360.        CALL REPSUB(IF2)
  361.         kf1=0
  362.         kf2=0
  363.         kf3=0
  364.        goto 161
  365. C
  366. 170    CONTINUE
  367. C
  368. C      MEMORISATION DU VOLUME IF2, LF1, KF2, KF3 ET LF4
  369. C      ------------------------------------------------
  370.        ICTV=ICTV+1
  371.        NVOL=NVOL+1
  372.        IF (NFV(1,IF2).EQ.0) NFV(1,IF2)=NVOL
  373.        IF (NFV(1,IF2).NE.NVOL) NFV(2,IF2)=NVOL
  374.        IF (NFV(1,kF1).EQ.0) NFV(1,kF1)=NVOL
  375.        IF (NFV(1,kF1).NE.NVOL) NFV(2,kF1)=NVOL
  376.        IF (NFV(1,kF2).EQ.0) NFV(1,kF2)=NVOL
  377.        IF (NFV(1,kF2).NE.NVOL) NFV(2,kF2)=NVOL
  378.        IF (NFV(1,kF3).EQ.0) NFV(1,kF3)=NVOL
  379.        IF (NFV(1,kF3).NE.NVOL) NFV(2,kF3)=NVOL
  380.        IVOL(9,NVOL)=25
  381. C
  382.        DO 180 I=1,3
  383.               IVOL(I,NVOL)=NFC(I,IF2)
  384. 180    CONTINUE
  385.        IVOL(4,NVOL)=IP
  386.        if (iimpi.eq.1) write (6,1180) nfacet,(ivol(i,nvol),i=1,4)
  387. 1180   FORMAT(' COM433-2 facettes ',i5,' TET4 ',4i5)
  388. *C
  389. *       DO 190 J=1,NPTMAX
  390. *              WRITE(6,1190)J,(NPF(I,J),I=1,40)
  391.  1190          FORMAT(I4,4X,40I3)
  392. *190    CONTINUE
  393. C
  394.  161    continue
  395.         nfcini=nfcmax
  396. C
  397. C      3EME VOLUME : IF3+IP
  398. C      --------------------
  399.       IP1=ISUCC(IF3,II)
  400.       IP2=ISUCC(IF3,IP1)
  401. C  ON RETOMBE SUR JF4  (si on ne l'a pas detruit)
  402. C
  403.        lf1=IFACE3(ip,ii,ip1)
  404. *      IF (lf1.ne.0) write (6,*) ' com433 facette deja existante'
  405.        IF (lf1.eq.0) THEN
  406.         nfcmax=nfcmax+1
  407.         lf1=nfcmax
  408.         NFC(1,lf1)=ip
  409.         NFC(2,lf1)=ii
  410.         NFC(3,lf1)=ip1
  411.         NFC(4,lf1)=0
  412.        elseif (NFC(4,lf1).ne.0.or.ipred(lf1,ip).ne.ii) then
  413.         lf1=0
  414.        endif
  415. *       write (6,*) ' com433 lf1 passe ',lf1
  416. C
  417. C
  418. *     recherche existence de la face
  419.        lf2=IFACE3(ip,ip1,ip2)
  420. *       IF (lf2.ne.0) write (6,*) ' com433 facette assimilee'
  421.        IF (lf2.eq.0) THEN
  422.         nfcmax=nfcmax+1
  423.         lf2=nfcmax
  424.         NFC(1,lf2)=ip
  425.         NFC(2,lf2)=ip1
  426.         NFC(3,lf2)=ip2
  427.         NFC(4,lf2)=0
  428.        elseif (NFC(4,lf2).ne.0.or.ipred(lf2,ip).ne.ip1) then
  429.         lf2=0
  430.        endif
  431. *       write (6,*) ' com433 lf2 passe ',lf2
  432. C
  433. C   ON RETOMBE SUR KF1  (si on ne l'a pas detruit)
  434. C
  435.        lf3=IFACE3(ip,ip2,ii)
  436. *       IF (lf3.ne.0) write (6,*) ' com433 facette deja existante'
  437.        IF (lf3.eq.0) THEN
  438.         nfcmax=nfcmax+1
  439.         lf3=nfcmax
  440.         NFC(1,lf3)=ip
  441.         NFC(2,lf3)=ip2
  442.         NFC(3,lf3)=ii
  443.         NFC(4,lf3)=0
  444.        elseif (NFC(4,lf3).ne.0.or.ipred(lf3,ip).ne.ip2) then
  445.         lf3=0
  446.        endif
  447. *       write (6,*) ' com433 lf3 passe ',lf3
  448. C
  449.        if (diago(ip,ii,diacrd)) then
  450.         lf3=0
  451.         lf1=0
  452.        endif
  453.        if (diago(ip,ip1,diacrd)) then
  454.         lf1=0
  455.         lf2=0
  456.        endif
  457.        if (diago(ip,ip2,diacrd)) then
  458.         lf2=0
  459.         lf3=0
  460.        endif
  461.        if (lf1*lf2*lf3.eq.0) then
  462. *        write (6,*) 'com433 impossibilite '
  463.         NFCMAX=NFCini
  464.         goto 201
  465.        endif
  466. C
  467. C
  468.        CALL REPSUB(IF3)
  469.        CALL REPSUB(LF1)
  470.        CALL REPSUB(LF2)
  471.        CALL REPSUB(LF3)
  472. C
  473. C      LE VOLUME CREE EST-IL VALIDE ?
  474. C      ------------------------------
  475.        IF (.NOT.SOLTET(IF3,LF1,LF2,LF3,ipin)) goto 200
  476.        IF (.NOT.FACET(LF1)) GOTO 200
  477.        IF (.NOT.FACET(LF2)) GOTO 200
  478.        IF (.NOT.FACET(LF3)) GOTO 200
  479.        GOTO 210
  480. C
  481. 200    CONTINUE
  482. *      write (6,*) ' soltet 3 invalide'
  483. C
  484.        NFCMAX=NFCini
  485.        CALL REPSUB(LF3)
  486.        CALL REPSUB(LF2)
  487.        CALL REPSUB(LF1)
  488.        CALL REPSUB(IF3)
  489.        goto 201
  490. C
  491. 210    CONTINUE
  492. C
  493. C      MEMORISATION DU VOLUME IF3, JF2, KF1, LF1 ET LF2
  494. C      ------------------------------------------------
  495.        ICTV=ICTV+1
  496.        NVOL=NVOL+1
  497.        IF (NFV(1,IF3).EQ.0) NFV(1,IF2)=NVOL
  498.        IF (NFV(1,IF3).NE.NVOL) NFV(2,IF2)=NVOL
  499.        IF (NFV(1,lF1).EQ.0) NFV(1,lF1)=NVOL
  500.        IF (NFV(1,lF1).NE.NVOL) NFV(2,lF1)=NVOL
  501.        IF (NFV(1,lF2).EQ.0) NFV(1,lF2)=NVOL
  502.        IF (NFV(1,lF2).NE.NVOL) NFV(2,lF2)=NVOL
  503.        IF (NFV(1,lF3).EQ.0) NFV(1,lF3)=NVOL
  504.        IF (NFV(1,lF3).NE.NVOL) NFV(2,lF3)=NVOL
  505.        IVOL(9,NVOL)=25
  506. C
  507.        DO 220 I=1,3
  508.               IVOL(I,NVOL)=NFC(I,IF3)
  509. 220    CONTINUE
  510.        IVOL(4,NVOL)=IP
  511.        if (iimpi.eq.1) write (6,1240) nfacet,(ivol(i,nvol),i=1,4)
  512. 1240   FORMAT(' COM433-3 facettes ',i5,' TET4 ',4i5)
  513. C
  514. *      DO 230 J=1,NPTMAX
  515. *             WRITE(6,1250)J,(NPF(I,J),I=1,40)
  516.  1250          FORMAT(I4,4X,40I3)
  517. *230    CONTINUE
  518. C
  519.  201    continue
  520.         if (nvol.eq.nvini) then
  521.           nptmax=nptini
  522.           return
  523.         endif
  524. C
  525. *      if (iimpi.ne.0) write (6,*) ' comm433 point ',nptmax
  526.        IGAGNE=1
  527.        RETURN
  528. C
  529. C      FIN DE LA SUBROUTINE COM433
  530.        END
  531.  
  532.  
  533.  
  534.  
  535.  

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