Télécharger la plaquette Cast3M


fr en

Télécharger cfl1.eso

Retour à la liste

Numérotation des lignes : 

cfl1

  1. C CFL1      SOURCE    CB215821  24/04/12    21:15:11     11897          
  2.       SUBROUTINE CFL1(IPMODL,IPCHA1,IPCHA2,IPCHA3,IPCHA4,ICAS)
  3. *
  4. *-----------------------------------------------------------------------
  5. *
  6. *    calcul du pas de temps de stabilité operateur CFL
  7. *           de la vitesse du son  operateur CSON
  8. *           de la taille de propagation de l'information opérateur TAILLE
  9. *
  10. * en entrée
  11. *  ipmodl objet model
  12. *  ipcha1 champ de caractéristiques
  13. *  ipcha2 champ de vitesse du son composante 'CSON'
  14. *  ipcha3 champ de taille du maillage composante 'L' ( et 'L2H' facultatif)
  15. *  icas décrit le cas de figure
  16. *            entree            ------->                   sortie
  17. *        = 1 ipcha1                                pas de temps cfl
  18. *        = 2 ipcha2 ( et ipcha1 si cara geom )      "       "      "
  19. *        = 3 ipcha3 et ipcha1                       "       "      "
  20. *        = 4 ipcha1                                vitesse du son
  21. *        = 5 ( et ipcha1 si cara geom )            parametre de taille
  22. * en sortie
  23. *        ipcha4 le champ par element demandé
  24. *
  25. *-----------------------------------------------------------------------
  26. *
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCHAMP
  33. -INC CCGEOME
  34. -INC CCREEL
  35. -INC SMCHAML
  36. -INC SMINTE
  37. -INC SMELEME
  38. -INC SMRIGID
  39. -INC SMMODEL
  40. -INC SMCOORD
  41. -INC SMLREEL
  42. C
  43. *      SEGMENT INFO
  44. *       INTEGER INFELE(JG)
  45. *      ENDSEGMENT
  46. *
  47.       SEGMENT NOTYPE
  48.         CHARACTER*16 TYPE(NBTYPE)
  49.       ENDSEGMENT
  50. *
  51.       SEGMENT MPTVAL
  52.         INTEGER IPOS(NS)    ,NSOF(NS)
  53.         INTEGER      IVAL(NCOSOU)
  54.         CHARACTER*16 TYVAL(NCOSOU)
  55.       ENDSEGMENT
  56. *
  57.       CHARACTER*(NCONCH) CONM
  58.       CHARACTER*8 CMATE
  59.       PARAMETER ( NINF=3 )
  60.       INTEGER INFOS(NINF)
  61.       CHARACTER*4 CMOT
  62.       LOGICAL DEUCMP,lsupma
  63. *--------------------------------------------------------------------*
  64. *
  65. *     call tcloc2(' ',-1,it)
  66.       deucmp=.FALSE.
  67.       IF ( ICAS .EQ. 1) THEN
  68.         IPCHE1 =  IPCHA1
  69.         IPCHE2 = 0
  70.       ELSE IF ( ICAS .EQ. 2 ) THEN
  71.         IPCHE1 = IPCHA1
  72.         IPCHE2 = IPCHA2
  73.       ELSE IF ( ICAS .EQ. 3 ) THEN
  74.          IPCHE1 = IPCHA1
  75.          IPCHE2 = IPCHA3
  76.       ELSE IF ( ICAS .EQ. 4 ) THEN
  77.          IPCHE1 = IPCHA1
  78.          IPCHE2 = 0
  79.       ELSE IF ( ICAS .EQ. 5 ) THEN
  80.          IPCHE1 = IPCHA1
  81.          IPCHE2 = 0
  82.       ENDIF
  83.  
  84.       MMODEL = IPMODL
  85.       SEGACT MMODEL
  86.       NSOUS = KMODEL(/1)
  87. *
  88. *  initialisation de l'objet résultat
  89. *
  90.  
  91.       N1 = NSOUS
  92.       N3 = 6
  93.       L1 = 16
  94.       SEGINI MCHELM
  95.       IF ( ICAS .LE. 3 .OR. ICAS .GE. 1 ) THEN
  96.          TITCHE = 'PAS DE TEMPS CFL'
  97.       ELSE IF ( ICAS .EQ. 4 ) THEN
  98.          TITCHE = 'VITESSE DU SON'
  99.       ELSE IF ( ICAS .EQ. 5 ) THEN
  100.          TITCHE = 'TAILLE CFL'
  101.       ENDIF
  102. *
  103.       IFOCHE = IFOUR
  104. *--------------------------------------------------------------------*
  105. *
  106. *       BOUCLE SUR LES ZONES ELEMENTAIRES ( MEME TYPE D'EF )
  107. *
  108. *--------------------------------------------------------------------*
  109. *
  110.       DO 500 ISOUS=1,NSOUS
  111.         IMODEL=KMODEL(ISOUS)
  112.         SEGACT IMODEL
  113.         lsupma=.true.
  114. *
  115. *    INITIALISATIONS
  116. *
  117.         IVAM1 = 0
  118.         IVAM2 = 0
  119. *
  120.         MELE  = NEFMOD
  121.         IPMAIL= IMAMOD
  122.         CONM  = CONMOD
  123.         NFOR  = FORMOD(/2)
  124.         NMAT  = MATMOD(/2)
  125. *
  126.         IVAMAT=0
  127.         IVACAR=0
  128.         NMATR=0
  129.         NMATF=0
  130.         NCARA=0
  131.         NCARF=0
  132.         MOCARA=0
  133.         MOMATR=0
  134.         DESCR=0
  135.         IMATRI=0
  136. *
  137. C
  138. C   COQUE INTEGREE OU PAS ?
  139. C
  140.       IF(INFMOD(/1).NE.0)THEN
  141.           NPINT=INFMOD(1)
  142.       ELSE
  143.           NPINT=0
  144.       ENDIF
  145. *
  146. *    formulation et matériau ( ca peut servir par la suite )
  147. *
  148.         CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  149. *
  150. * sortie cmate : Nom du materiau (isotrope, orthotrope....)
  151. *        mate :  Numero du materiau
  152. *        intau : Numero de nature
  153. *
  154. *
  155.         IF (CMATE.EQ.' ')THEN
  156.            CALL ERREUR(251)
  157.            SEGSUP MCHELM
  158.            SEGDES IMODEL,MMODEL
  159.            IRET=0
  160.            RETURN
  161.         ENDIF
  162. *
  163. *    information sur l'élément finis : nécessaire pour les tests
  164. *                                      qui donnent les noms de composantes
  165. *
  166. *
  167.          INTTYP = 2
  168. *         CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL)
  169. *
  170.          IF ( IERR.NE.0 ) THEN
  171.            SEGSUP MCHELM
  172.            SEGDES IMODEL,MMODEL
  173.            IPCHA4=0
  174.            RETURN
  175.          ENDIF
  176. *
  177. *         INFO  = IPINF
  178. *         LHOOK = INFELE(10)
  179. *         LHOO2 = LHOOK*LHOOK
  180. *         NSTRS = INFELE(16)
  181.          MFR   = INFELE(13)
  182. *         LW    = INFELE(7)
  183. *         NDDL  = INFELE(15)
  184.          IELE  = INFELE(14)
  185. *         LRE   = INFELE(9)
  186. *         IPORE = INFELE(8)
  187. *          IPINT = INFELE(11)
  188.          ipint=infmod(4)
  189. *
  190. *
  191. *    Verification de compatibilite de MCHAML du point de vue des
  192. *
  193. *    tableaux INFCHE et creation du tableau INFOS pour COMCHA
  194. *
  195.          CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD)
  196.          IF (IRTD.EQ.0) THEN
  197. *                    incompatibilité entre le modele et le chamelem
  198.            SEGDES IMODEL,MMODEL
  199.            SEGSUP MCHELM
  200.            RETURN
  201.          ENDIF
  202.  
  203. *         call tcloc2('Apres ident',6,it)
  204.  
  205. *
  206. *
  207. *--------------------------------------------------------------------*
  208. *       determination des noms de composantes dans les champs
  209. *
  210. * on commence par le champ  2  qui n'existe que dans le cas 2 et 3
  211.         IF (ICAS.EQ.2 .OR.ICAS.EQ.3) THEN
  212.              IF (ICAS.EQ.2) THEN
  213. *             le champ 2 contient la vitesse du son
  214.                NBROBL=1
  215.                NBRFAC=0
  216.                SEGINI NOMID
  217.                LESOBL(1)='CSON'
  218.                NBTYPE=1
  219.                SEGINI NOTYPE
  220.                TYPE(1) = 'REAL*8'
  221.              ELSE IF(ICAS.EQ.3) THEN
  222. *             le champ 2 contient le parametre de taille
  223.                NBROBL=1
  224.                NBRFAC=1
  225.                SEGINI NOMID
  226.                LESOBL(1)='L'
  227.                LESFAC(1) = 'L2H'
  228.                NBTYPE=1
  229.                SEGINI NOTYPE
  230.                TYPE(1) = 'REAL*8'
  231.               ENDIF
  232.               MOTYPE = NOTYPE
  233.               MOMATR = NOMID
  234. *
  235. *
  236. * ===>
  237. *       write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche2'
  238. *       write(6,7001) (lesobl(i),i=1,nbrobl)
  239. *       write(6,*) 'facultatives'
  240. *       write(6,7001) (lesfac(i),i=1,nbrfac)
  241. * 7001  format(4(A4,2X))
  242. *           Recherche des valeurs des composantes dans les MELVAL d'un
  243. *           CHAMELEM. On distingue les composantes obligatoires des
  244. *            composantes facultatives.
  245.           CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM2)
  246.           SEGSUP NOTYPE,NOMID
  247.           IF (IERR.NE.0) THEN
  248.             SEGSUP MCHELM
  249.             SEGDES IMODEL,MMODEL
  250.             RETURN
  251.           ENDIF
  252.         ENDIF
  253. *        call tcloc2('Apres komcha1',6,it)
  254. *
  255. *     dans les cas 1,2 ou 5 il peut y avoir des caractéristiques geometriques
  256. *     dans les cas  1,3 ou 4  il y a des caractéristiques matériau
  257. *       on commence par traiter les caractéristiques matériau
  258.         IF (ICAS .EQ. 1 .OR. ICAS .EQ. 3 .OR. ICAS .EQ. 4) THEN
  259.             IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
  260.                NBROBL=3
  261.                NBRFAC=0
  262.                SEGINI NOMID
  263.                MOMATR=NOMID
  264.                LESOBL(1)='YOUN'
  265.                LESOBL(2)='NU'
  266.                LESOBL(3)='RHO'
  267.                NMATR=NBROBL
  268.                NMATF=NBRFAC
  269.             ELSE
  270.      $      IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
  271. *               indisponible! pour les volontaies voir voir rigi1.eso
  272. *              SEGSUP MCHELM
  273.                SEGDES MMODEL,IMODEL
  274.                CALL ERREUR(251)
  275.                RETURN
  276.             ELSE
  277.      $      IF (FORMOD(1).EQ.'POREUX   '.AND.CMATE.EQ.'ISOTROPE') THEN
  278. *               indisponible! pour les volontaies voir rigi1.eso
  279.                CALL ERREUR(251)
  280.                SEGSUP MCHELM
  281.                SEGDES MMODEL,IMODEL
  282.                RETURN
  283. *
  284.             ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
  285. *               indisponible! pour les volontaies voir rigi1.eso
  286.                SEGSUP MCHELM
  287.                SEGDES MMODEL,IMODEL
  288.                CALL ERREUR(251)
  289.                RETURN
  290. *
  291.             ELSE
  292.               if(lnomid(6).ne.0) then
  293.                nomid=lnomid(6)
  294.                segact nomid
  295.                momatr=nomid
  296.                nmatr=lesobl(/2)
  297.                nmatf=lesfac(/2)
  298.                lsupma=.false.
  299.               else
  300.                lsupma=.true.
  301.                CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  302.               endif
  303.             ENDIF
  304. *
  305. *   type des composantes
  306. *
  307.             IF (CMATE.EQ.'SECTION') THEN
  308.                SEGSUP MCHELM
  309.                SEGDES MMODEL,IMODEL
  310.                CALL ERREUR(251)
  311.                RETURN
  312.             ELSE
  313.               NBTYPE=1
  314.               SEGINI NOTYPE
  315.               TYPE(1)='REAL*8'
  316.               MOTYPE=NOTYPE
  317.             ENDIF
  318.  
  319. *
  320. *  dans le cas ou il y des caractéristiques géometriques on augmente
  321. *  motype
  322. *
  323.           ELSE IF((ICAS.EQ.2 .OR. ICAS.EQ.5).AND.IPCHE1.NE.0)THEN
  324. *  dans ces cas il faut eventuellement récuperer les caractéristiques
  325. *  geométriques et avoir initialiser  notype avant
  326.                NBROBL=0
  327.                NBRFAC=0
  328.                SEGINI NOMID
  329.                MOMATR=NOMID
  330.                NBTYPE=1
  331.                SEGINI NOTYPE
  332.                MOTYPE=NOTYPE
  333.                TYPE(1)='REAL*8'
  334.                NMATR=NBROBL
  335.                NMATF=NBRFAC
  336.          ENDIF
  337. *
  338.          IF((IPCHE1.NE.0).AND.(ICAS.NE.4).AND.(ICAS.NE.3))THEN
  339. *
  340. *
  341. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  342. *
  343.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  344.              NBROBL=NBROBL+1
  345.              IF(MFR.EQ.3.AND.IFOUR.EQ.-2) THEN
  346.                NBRFAC=NBRFAC+2
  347.              ELSE
  348.                NBRFAC=NBRFAC+1
  349.              ENDIF
  350.              SEGADJ NOMID
  351.              MOCARA=NOMID
  352.              LESOBL(NBROBL)='EPAI'
  353.              LESFAC(NBRFAC)='EXCE'
  354.              IF(MFR.EQ.3.AND.IFOUR.EQ.-2)  THEN
  355.                  LESFAC(NBRFAC-1)='EXCE'
  356.                  LESFAC(NBRFAC)='DIM3'
  357.              ELSE
  358.                  LESFAC(NBRFAC)='EXCE'
  359.              ENDIF
  360. *
  361. * SECTION POUR LES BARRES ET LES CERCES
  362. *
  363.           ELSE IF (MFR.EQ.27) THEN
  364.              NBROBL=NBROBL+1
  365.              SEGADJ NOMID
  366.              LESOBL(NBROBL)='SECT'
  367. *
  368. * section, excentrements et orientation pour les barres excentrees
  369. *
  370.           ELSE IF (MFR.EQ.49) THEN
  371.              NBROBL=NBROBL+6
  372.              SEGADJ NOMID
  373.              LESOBL(NBROBL-5)='SECT'
  374.              LESOBL(NBROBL-4)='EXCZ'
  375.              LESOBL(NBROBL-3)='EXCY'
  376.              LESOBL(NBROBL-2)='VX  '
  377.              LESOBL(NBROBL-1)='VY  '
  378.              LESOBL(NBROBL)='VZ  '
  379. *
  380. * CARACTERISTIQUES POUR LES POUTRES
  381. *
  382.           ELSE IF (MFR.EQ.7 ) THEN
  383.                NBROBL=NBROBL+4
  384.                NBRFAC=NBRFAC+2
  385.                SEGADJ NOMID
  386.                LESOBL(NBROBL-3)='TORS'
  387.                LESOBL(NBROBL-2)='INRY'
  388.                LESOBL(NBROBL-1)='INRZ'
  389.                LESOBL(NBROBL)='SECT'
  390.                LESFAC(NBRFAC-1)='SECY'
  391.                LESFAC(NBRFAC)='SECZ'
  392. *
  393. * CARACTERISTIQUES POUR LES TUYAUX
  394. *
  395.           ELSE IF (MFR.EQ.13) THEN
  396. *            pour les autres on ne ient pas compte des modification
  397. *            qui assouplissent le tuyau donc omega max diminue
  398.              NBROBL=NBROBL+2
  399.              SEGADJ NOMID
  400.              LESOBL(NBROBL-1)='EPAI'
  401.              LESOBL(NBROBL)='RAYO'
  402.           ELSE IF (MFR.EQ.39) THEN
  403.              NBROBL=NBROBL+2
  404.              NBRFAC=NBRFAC+2
  405.              SEGADJ NOMID
  406.              LESOBL(NBROBL-1)='EPAI'
  407.              LESOBL(NBROBL)='RAYO'
  408.              LESFAC(NBRFAC-1)='RACO'
  409.              LESFAC(NBRFAC)='PRES'
  410.           ENDIF
  411. *
  412.           MOMATR=NOMID
  413.           NMATR=NBROBL
  414.           NMATF=NBRFAC
  415. *
  416. * ===>
  417. *       write(6,*) 'Sous zone' ,isous,' Composante obligatoire ipche1'
  418. *       write(6,7001) (lesobl(i),i=1,nbrobl)
  419. *       write(6,*) 'facultatives'
  420. *       write(6,7001) (lesfac(i),i=1,nbrfac)
  421. *
  422. *
  423.       ENDIF
  424. *
  425.       IF (NMATR.NE.0) THEN
  426.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAM1)
  427.         SEGSUP NOTYPE
  428.         nomid=momatr
  429.         if(lsupma)segsup NOMID
  430.         IF (IERR.NE.0) THEN
  431.             SEGDES IMODEL,MMODEL
  432.             SEGSUP MCHELM
  433.             RETURN
  434.         ENDIF
  435. *           call tcloc2('Apres komcha2',6,it)
  436.       ENDIF
  437.  
  438. *
  439. *
  440. *--------------------------------------------------------------------*
  441. *       remplissage de la description du sous champ résultat
  442. *
  443. * dimension
  444. *    = 2 si taille et coque ou poutre
  445. *        mfr obtenu par elquoi nous renseigne
  446. *
  447.        IF ((ICAS.EQ.5).AND.
  448.      &    (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.7.OR.MFR.EQ.9.OR.MFR.EQ.13))
  449.      &    THEN
  450.           DEUCMP = .TRUE.
  451.           N2 = 2
  452.           SEGINI MCHAML
  453.           NOMCHE(1) = 'L'
  454.           NOMCHE(2) = 'L2H'
  455.           TYPCHE(1) = 'REAL*8'
  456.           TYPCHE(2) = 'REAL*8'
  457.        ELSE IF (ICAS.EQ.5) THEN
  458.           N2 = 1
  459.           SEGINI MCHAML
  460.           NOMCHE(1) = 'L'
  461.           TYPCHE(1) = 'REAL*8'
  462.        ELSE IF (ICAS.EQ.4) THEN
  463.           N2 = 1
  464.           SEGINI MCHAML
  465.           NOMCHE(1) = 'CSON'
  466.           TYPCHE(1) = 'REAL*8'
  467.        ELSE IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.3) THEN
  468.           N2 = 1
  469.           SEGINI MCHAML
  470.           NOMCHE(1) = 'TCFL'
  471.           TYPCHE(1) = 'REAL*8'
  472.        ENDIF
  473.        ICHAML(ISOUS) = MCHAML
  474. *
  475. * le chamelem est defini au centre de gravité
  476. *
  477.         INFCHE(ISOUS,6) = 2
  478. * il faut brancher sur le segment d'intégration
  479.         INFCHE(ISOUS,4)=IPINT
  480. * nom du constituant
  481.         CONCHE(ISOUS) = CONMOD
  482. * maillage
  483.         IMACHE(ISOUS) = IPMAIL
  484. * a priori info ne set plus
  485. *        SEGSUP INFO
  486. *
  487. *--------------------------------------------------------------------*
  488. *       appel au sous routine spécifiques
  489. *
  490. *     NUMERO DES ETIQUETTES      :
  491. *     Les elements sont groupes comme suit :
  492. *      - massif,liquide 'surface libre' poreux ----------------------> 4
  493. *      - coq3,dkt,coq4,coq8,coq2,dst --------------------------------> 12
  494. *      - poutre,tuyau,linespring,tuyau fissure,barre,homogeneise,jot3> 27
  495. *      - joi4,joi2,poutre de timoschenko,joi3                          29
  496. *
  497. *           1            5              0              5             0
  498.       GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,12,99, 4, 4, 4, 4,99,99,99,
  499.      2      99,99, 4, 4, 4, 4,27,27,29,99,99,99,99,99,99,99,99,99,99,99,
  500.      4      27,29,99,27,99,29,12,99,27,99,99,99,99,99,12,27,99,99,99,99,
  501.      6      99,99,99,99,99,99,99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,
  502.      8      99,99,99,29,99,99,99,99,99,99,99,99,27,12,99,99,99,99,99,99,
  503.      1      99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  504.      2      99,99,99,99,99,99,99),MELE
  505.  99   CONTINUE
  506.       MOTERR(1:4)=NOMTP(MELE)
  507.       MOTERR(9:12)='CFL1'
  508.       CALL ERREUR(86)
  509.       SEGDES IMODEL,MMODEL
  510.       SEGSUP MCHELM,MCHAML
  511.       RETURN
  512. C
  513. C_______________________________________________________________________
  514. C
  515. C     massif
  516. C_______________________________________________________________________
  517. C
  518.    4  CONTINUE
  519. *      write(6,*) 'Appel a cfl2'
  520.       CALL CFL2(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  521.       IF (IERR.NE.0) RETURN
  522.       GOTO 400
  523.  
  524. C_______________________________________________________________________
  525. C
  526. C     ELTS DE RACCORD LIQUIDE SOLIDE  RAC2 RACO LIA3 LIA4 LICO LIC4
  527. C          PAS DE RIGIDITE
  528. C_______________________________________________________________________
  529. C
  530.   12  CONTINUE
  531. *      write(6,*) 'Appel a cfl3'
  532.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  533.       IF (IERR.NE.0) RETURN
  534.       GOTO 400
  535. C_______________________________________________________________________
  536. C
  537. C     coq3,dkt,coq4,coq8,coq2,dst
  538. C_______________________________________________________________________
  539. C
  540.   27  CONTINUE
  541. *      write(6,*) 'Appel a cfl4'
  542.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  543.       IF (IERR.NE.0) RETURN
  544.       GOTO 400
  545. C_______________________________________________________________________
  546. C
  547. C poutre,barre,homogeneise
  548. C poutre de Timoschenko
  549. C_______________________________________________________________________
  550. C
  551.   29  CONTINUE
  552. *      write(6,*) 'Appel a cfl5'
  553. *  ivam1 et 2 sont actifs , ipmail descativé
  554.       CALL CFL5(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2)
  555. *  en sortie melv1 et melv2 sont inactifs
  556.       IF (IERR.NE.0) RETURN
  557.       GOTO 400
  558. *
  559. *
  560. *
  561.  400  CONTINUE
  562. *  on raccroche le résultat
  563.       IELVAL(1) = MELV1
  564.       IF (DEUCMP)  IELVAL(2) = MELV2
  565.       SEGDES MCHAML
  566.       SEGDES IMODEL
  567.       IF (IVAM1.NE.0) THEN
  568.          MPTVAL = IVAM1
  569.          SEGSUP MPTVAL
  570.       ENDIF
  571.       IF (IVAM2.NE.0) THEN
  572.          MPTVAL = IVAM2
  573.          SEGSUP MPTVAL
  574.       ENDIF
  575. * fin boucle sur les sous zone des champs
  576.  500  CONTINUE
  577. *
  578. *
  579. *
  580.        IPCHA4 = MCHELM
  581.        SEGDES MCHELM,MMODEL
  582.        RETURN
  583.        END
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  

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