Télécharger la plaquette Cast3M


fr en

Télécharger formch.eso

Retour à la liste

Numérotation des lignes : 

formch

  1. C FORMCH    SOURCE    MB234859  25/09/08    21:15:26     12358          
  2.  
  3.       SUBROUTINE FORMCH(IPMODL,IPCHEL,IPT,IRET,IPCHCA1,MCOOR1)
  4.  
  5. C--------------------------------------------------------------------
  6. C
  7. C   REACTUALISATION DES CARACTERISTIQUES POUR CERTAINES FORMULATIONS
  8. C   ROUTINE APPELEE PAR FORM
  9. C
  10. C--------------------------------------------------------------------
  11. C
  12. C  ENTREES :
  13. C  ---------
  14. C
  15. C     IPMODL   POINTEUR SUR UN MMODEL
  16. C     IPCHEL   POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  17. C     IPT      POINTEUR SUR UN CHPOINT
  18. C     Les pointeurs ci-dessus sont actifs en E/S (via FORM/ACTOBJ).
  19. C
  20. C
  21. C  SORTIE :
  22. C  --------
  23. C
  24. C     IRET      1 SI L'OPERATION EST POSSIBLE
  25. C               0 SI L'OPERATION EST IMPOSSIBLE
  26. C     IPCHCA1  POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUES
  27. C
  28. C-------------------------------------------------------------------
  29. C
  30.       IMPLICIT INTEGER(I-N)
  31.       IMPLICIT REAL*8(A-H,O-Z)
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC CCHAMP
  36.  
  37. -INC SMCHAML
  38. -INC SMCOORD
  39. -INC SMELEME
  40. -INC SMMODEL
  41.  
  42. -INC TMPTVAL
  43.  
  44.       SEGMENT IWRK
  45.          REAL*8 XDDL(LRE),XE(3,NBNN),WORK(LW)
  46.       ENDSEGMENT
  47.  
  48.       SEGMENT NOTYPE
  49.          CHARACTER*16 TYPE(NBTYPE)
  50.       ENDSEGMENT
  51.  
  52.       CHARACTER*8 CMATE
  53.       CHARACTER*(NCONCH) CONM
  54.       PARAMETER ( NINF=3 )
  55.       INTEGER INFOS(NINF)
  56.       LOGICAL lsupdp
  57.  
  58.       DIMENSION VECT(6)
  59.  
  60.       IRET    = 0
  61.       IPCHCA1 = 0
  62.       IPCHDEP = 0
  63. C
  64. C  SUPPORT des CHAMPS DE CARACTERISTIQUES :
  65. C
  66.       ISUPCA = 3
  67. C
  68. C  ON VERIFIE QUE LE MCHAML DE CARACTERISTIQUES EST SUR SON SUPPORT
  69. C
  70.       CALL QUESUP (IPMODL,IPCHEL,ISUPCA,1,ISUP,IRETCA)
  71.       IF (ISUP.NE.0) RETURN
  72. C
  73. C  ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT
  74. C Amelioration possible : Ne faire le MCHAML IPCHDEP que si necessaire ?
  75. C
  76.       CALL CHAME1(0,IPMODL,IPT,' ',IPCHDEP,1)
  77.       IF (IERR.NE.0) RETURN
  78. C
  79. C  ON COPIE LE CHAMELEM DE CARACTERISTIQUES
  80. C  On ne recopie que le chapeau sans MELVAL -> seuls les melvals devant
  81. C  etre modifies seront copies plus bas dans la boucle !
  82.       mchelm = IPCHEL
  83.       SEGINI,mchel1=mchelm
  84.       NSOUS  = mchel1.IMACHE(/1)
  85.       DO IC = 1, NSOUS
  86.         MCHAM1 = mchel1.ICHAML(IC)
  87.         SEGINI,MCHAML=MCHAM1
  88.         mchel1.ICHAML(IC) = MCHAML
  89.       ENDDO
  90.       IPCHE1 = mchel1
  91. c-dbg      write(ioimp,*)
  92. c-dbg      write(ioimp,*)'(E)IPCHE1=',ipche1,NSOUS
  93. c-dbg      do ic = 1, nsous
  94. c-dbg        mchaml = mchel1.ICHAML(IC)
  95. c-dbg        write(ioimp,*)'  mchaml=',mchaml,ic,ielval(/1)
  96. c-dbg        write(ioimp,*)'  nomche=',(nomche(id),id=1,ielval(/1))
  97. c-dbg        write(ioimp,*)'  melval=',(ielval(id),id=1,ielval(/1))
  98. c-dbg      enddo
  99. C
  100. C  Un petit segment utile pour les CARACTERISTIQUES :
  101. C
  102.       nbtype = 1
  103.       SEGINI,notype
  104.       notype.TYPE(1) = 'REAL*8'
  105.       MOTYR8 = NOTYPE
  106.  
  107. C____________________________________________________________________
  108. C
  109. C  BOUCLE SUR LES SOUS-ZONES DU MODELE :
  110. C____________________________________________________________________
  111. C
  112.       MMODEL=IPMODL
  113.       NSOUS = KMODEL(/1)
  114.  
  115.       DO 200 ISOUS = 1, NSOUS
  116.  
  117.          KERRE=0
  118.  
  119.          IMODEL = KMODEL(ISOUS)
  120.  
  121.          IPMAIL = IMAMOD
  122.          MELE   = NEFMOD
  123.          CONM   = CONMOD
  124.  
  125.          MOCARA=0
  126.          IVACAR=0
  127.          IVACA1=0
  128.          MODEPL=0
  129.          IVADEP=0
  130.          lsupdp=.false.
  131.  
  132. C____________________________________________________________________
  133. C
  134. C        INFORMATION SUR L'ELEMENT FINI
  135. C____________________________________________________________________
  136. C
  137.          IFORM=INFELE(13)
  138.          NBG  =INFELE(6)
  139.          LW   =INFELE(7)
  140.          LRE  =INFELE(9)
  141. C
  142.          MELEME=IPMAIL
  143.          NBNN  =NUM(/1)
  144.          NBELEM=NUM(/2)
  145. C
  146. C        CREATION DU TABLEAU INFOS
  147. C
  148. C*         CALL IDENT(IPMAIL,CONM,IPCHEL,IPCHDEP,INFOS,IRTD)
  149.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHDEP,INFOS,IRTD)
  150.          IF (IRTD.EQ.0) GOTO 150
  151. C____________________________________________________________________
  152. C
  153. C TRAITEMENT DU CHAMP DE CARACTERISTIQUES
  154. C____________________________________________________________________
  155. C
  156.          NBROBL = 0
  157.          NBRFAC = 0
  158.          NOMID  = 0
  159. *
  160. * Toutes les caracteristiques sont de type 'REAL*8' (MOTYR8)
  161. *
  162. * CARACTERISTIQUES POUR LES BARRES
  163. *
  164. C*?         IF (IFORM.EQ.27) THEN
  165. C*?            NBROBL=1
  166. C*?            SEGINI NOMID
  167. C*?            LESOBL(1)='SECT'
  168. *
  169. * CARACTERISTIQUES POUR LES POUTRES ET LES TUYAU
  170. *
  171.          IF ((IFORM.EQ.7.OR.IFORM.EQ.13).AND.(IDIM.EQ.3)) THEN
  172.             NBRFAC=3
  173.             SEGINI NOMID
  174.             LESFAC(1)='VX'
  175.             LESFAC(2)='VY'
  176.             LESFAC(3)='VZ'
  177. *
  178. * CARACTERISTIQUES POUR LES LINESPRING
  179. *
  180.          ELSE IF (IFORM.EQ.15) THEN
  181.             NBROBL=3
  182.             SEGINI NOMID
  183.             LESOBL(1)='VX  '
  184.             LESOBL(2)='VY  '
  185.             LESOBL(3)='VZ  '
  186. *
  187. * CARACTERISTIQUES POUR LES TUFI
  188. *
  189.          ELSE IF (IFORM.EQ.17) THEN
  190.             NBROBL=6
  191.             SEGINI NOMID
  192.             LESOBL(1)='VX  '
  193.             LESOBL(2)='VY  '
  194.             LESOBL(3)='VZ  '
  195.             LESOBL(4)='VXF '
  196.             LESOBL(5)='VYF '
  197.             LESOBL(6)='VZF '
  198. *
  199. * (fdp) CARACTERISTIQUES POUR LES JOI1
  200. *       ROTATION APPLIQUEE AUX VECTEURS ORIENTANT LE JOINT SI DEMANDEE DANS LE MODELE !
  201. *
  202.          ELSE IF (IFORM.EQ.75) THEN
  203.            ITOUR=-1*INFMOD(9)
  204.            IF (ITOUR.EQ.1) THEN
  205.              IF (IDIM.EQ.3) THEN
  206.                NBROBL=6
  207.                SEGINI NOMID
  208.                LESOBL(1)='V1X '
  209.                LESOBL(2)='V1Y '
  210.                LESOBL(3)='V1Z '
  211.                LESOBL(4)='V2X '
  212.                LESOBL(5)='V2Y '
  213.                LESOBL(6)='V2Z '
  214.              ELSE IF (IDIM.EQ.2) THEN
  215.                NBROBL=2
  216.                SEGINI NOMID
  217.                LESOBL(1)='V1X '
  218.                LESOBL(2)='V1Y '
  219.              ENDIF
  220.            ENDIF
  221.          ENDIF
  222.          MOCARA = NOMID
  223.          NCARA  = NBROBL
  224.          NCARF  = NBRFAC
  225.          NCARR  = NCARA+NCARF
  226.  
  227. C Pas de caracteristiques a transformer : rien de plus a faire
  228.          IF (MOCARA.EQ.0) GOTO 150
  229.  
  230. C*         IF (MOCARA.NE.0)  THEN
  231.             CALL KOMCHA(IPCHEL,IPMAIL,CONM,MOCARA,MOTYR8,1,
  232.      &                  INFOS,3,IVACAR)
  233.             IF (IERR.NE.0) GOTO 150
  234.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYR8,1,
  235.      &                  INFOS,3,IVACA1)
  236.             IF (IERR.NE.0) GOTO 150
  237. *
  238. *  IVACAR et IVACA1 pointent vers les memes MELVAL ...et..
  239. *  RECOPIE ET AJUSTEMENT DE LA DIMENSION DES MELVAL de IVACA1
  240. *  (composantes scalaires 'REAL*8')
  241. *
  242.             MPTVAL = IVACA1
  243.             nsca1 = ipos(/1)
  244. c-dbg      write(ioimp,*)'ivaca1=',ivaca1,nsca1,ival(/1),ipmail
  245. c-dbg      write(ioimp,*)'  ipos=',(ipos(ic),nsof(ic),ic=1,ipos(/1))
  246. c-dbg      write(ioimp,*)'  ival=',(ival(ic),ic=1,ncarr)
  247.             DO IC = 1,NCARR
  248.               MELVA1 = IVAL(IC)
  249.               IF (MELVA1.NE.0) THEN
  250.                 SEGINI,MELVAL=MELVA1
  251.                 N1PTEL=VELCHE(/1)
  252.                 N1EL  =VELCHE(/2)
  253. c*                N2PTEL=IELCHE(/1) = 0 !
  254. c*                N2EL  =IELCHE(/2) = 0 !
  255. C (fdp) correction : on remplace .LT. par .LE. pour gerer le cas ou il
  256. C                    n'y a qu'un seul element
  257. C                    (sinon plantage dans le cas d'un seul element TUFI)
  258.                 IF ((N1EL.LE.NBELEM).OR.(N1PTEL.LE.NBG)) THEN
  259.                   N1EL  = MAX(N1EL,NBELEM)
  260.                   N1PTEL= MAX(N1PTEL,NBG)
  261.                   IF (IFORM.EQ.7.OR.IFORM.EQ.13) N1PTEL=1
  262.                   N2PTEL=0
  263.                   N2EL  =0
  264.                   SEGADJ,MELVAL
  265.                 ENDIF
  266.                 IVAL(IC) = MELVAL
  267. C*-> Il faut mettre MELVAL dans IPCHE1 a la place de MELVA1 !
  268.                 DO id = 1, nsca1
  269.                   mchaml = mchel1.ichaml(ipos(id))
  270.                   call place2(mchaml.ielval(1),ielval(/1),idm,melva1)
  271.                   if (idm.gt.0) then
  272.                     mchaml.ielval(idm) = melval
  273. c-dbg      write(ioimp,*)'melval found',id,idm,melval,'->',melva1
  274.                     goto 0312
  275.                   endif
  276.                 enddo
  277.  0312           continue
  278.                 if (idm.eq.0) write(ioimp,*)'MELVAL',melval,'not found'
  279.               ENDIF
  280.             ENDDO
  281. C*         ENDIF
  282. C*         IF (IVACAR.EQ.0) GOTO 150
  283.  
  284. C______________________________________________________________________
  285. C
  286. C TRAITEMENT DU CHAMP DE DEPLACEMENT
  287. C______________________________________________________________________
  288. C
  289.          IF (lnomid(1).ne.0) THEN
  290.             MODEPL=lnomid(1)
  291.             nomid=MODEPL
  292.             NDEP=nomid.lesobl(/2)
  293.             nfac=nomid.lesfac(/2)
  294.             lsupdp=.false.
  295.          ELSE
  296.             CALL IDPRIM(IMODEL,IFORM,MODEPL,NDEP,NFAC)
  297.             lsupdp=.true.
  298.          ENDIF
  299. C
  300. C        VERIFICATION DE LEUR PRESENCE
  301. C
  302.          CALL KOMCHA(IPCHDEP,IPMAIL,CONM,MODEPL,MOTYR8,1,INFOS,ISUPCA,
  303.      &               IVADEP)
  304.          IF (IERR.NE.0) GOTO 150
  305. C______________________________________________________________________
  306. C
  307. C BRANCHEMENT SELON LES FORMULATIONS S'IL Y A BESOIN
  308. C______________________________________________________________________
  309. C
  310. C (fdp) on prevoit le cas des elements JOI1 (iform = 75)
  311.          IF (iform.EQ.75) GOTO 75
  312.          IF (iform.GT.38) GOTO 30
  313.          GOTO (30,22,30,22,30,22,120,22,30,22,22,22,120,22,90,22,
  314.      &         70,22,22,22,22,22,22,22,22,22,30,22,22,22,30,22,30,22,
  315.      &         30,22,22,22),IFORM
  316. C_______________________________________________________________________
  317. C
  318. C    FORMULATION MASSIVE - RIEN DE SPECIAL A FAIRE
  319. C    FORMULATION POREUSE - RIEN DE SPECIAL A FAIRE
  320. C    FORMULATIONS COQUE  - ON NE FAIT RIEN
  321. C    FORMULATIONS UNIAXIALE  - ON NE FAIT RIEN
  322. C    AUTRE(S) FORMULATION(S) : RIEN A FAIRE
  323. C_______________________________________________________________________
  324. C
  325.  22      CONTINUE
  326.  30      CONTINUE
  327.          GOTO 150
  328. C______________________________________________________________________
  329. C
  330. C    FORMULATION LINESPRING
  331. C______________________________________________________________________
  332. C
  333.  90      CONTINUE
  334.          SEGINI IWRK
  335.          DO IB=1,NBELEM
  336. C
  337. C           ON CHERCHE LES COORDONNEES DES NOEUDS ET LES DEPLACEMENTS
  338. C
  339.             CALL DOXE(MCOOR1.XCOOR,IDIM,NBNN,NUM,IB,XE)
  340.  
  341.             IE=1
  342.             MPTVAL=IVADEP
  343.             DO IGAU=1,NBNN
  344.                DO IC=1,NDEP
  345.                   MELVAL=IVAL(IC)
  346.                   IGMN=MIN(IGAU,VELCHE(/1))
  347.                   IBMN=MIN(IB  ,VELCHE(/2))
  348.                   XDDL(IE)=VELCHE(IGMN,IBMN)
  349.                   IE=IE+1
  350.                ENDDO
  351.             ENDDO
  352. C
  353.             DO IC=1,NBG
  354.                IF (IC.EQ.2) GO TO 948
  355.                MPTVAL=IVACAR
  356.                DO ID=1,3
  357.                   MELVAL=IVAL(ID)
  358.                   IGMN=MIN(IC,VELCHE(/1))
  359.                   IBMN=MIN(IB,VELCHE(/2))
  360.                   VECT(ID)=VELCHE(IGMN,IBMN)
  361.                ENDDO
  362.                ICC=1
  363.                IF(IC.GT.1) ICC=2
  364.                CALL LSPFRM(IWRK,KERRE,VECT,ICC)
  365. C
  366.                IF(KERRE.NE.0) THEN
  367.                  INTERR(1)=ISOUS
  368.                  INTERR(2)=IB
  369.                  GO TO 927
  370.                ENDIF
  371. C
  372. C              REMPLISSAGE
  373. C
  374.  948           CONTINUE
  375.                MPTVAL=IVACA1
  376.                DO ID=1,3
  377.                   MELVAL=IVAL(ID)
  378.                   VELCHE(IC,IB)=VECT(ID)
  379.                enddo
  380.             enddo
  381.  
  382.          ENDDO
  383. C
  384.   927    SEGSUP IWRK
  385.          GOTO 151
  386. C_______________________________________________________________________
  387. C
  388. C    FORMULATION TUYAU FISSURE
  389. C_______________________________________________________________________
  390. C
  391.  70      CONTINUE
  392.          SEGINI IWRK
  393.          DO IB=1,NBELEM
  394. C
  395. C           ON CHERCHE LES COORDONNEES DES NOEUDS ET LES DEPLACEMENTS
  396. C
  397.             CALL DOXE(MCOOR1.XCOOR,IDIM,NBNN,NUM,IB,XE)
  398.  
  399.             MPTVAL=IVADEP
  400.             IE=1
  401.             DO IC=1,NBNN
  402.                DO ID=1,NDEP
  403.                   MELVAL=IVAL(ID)
  404.                   IGMN=MIN(IC,VELCHE(/1))
  405.                   IBMN=MIN(IB,VELCHE(/2))
  406.                   XDDL(IE)=VELCHE(IGMN,IBMN)
  407.                   IE=IE+1
  408.                enddo
  409.             enddo
  410. C
  411.             MPTVAL=IVACAR
  412.             DO ID=1,6
  413.                MELVAL=IVAL(ID)
  414.                IBMN=MIN(IB,VELCHE(/2))
  415.                VECT(ID)=VELCHE(1,IBMN)
  416.             ENDDO
  417. C
  418.             CALL TUYFRM(IWRK,KERRE,VECT,VECT(4))
  419. C
  420.             IF(KERRE.NE.0) THEN
  421.                INTERR(1)=ISOUS
  422.                INTERR(2)=IB
  423.                GO TO 727
  424.             ENDIF
  425. C
  426. C           REMPLISSAGE
  427. C
  428.             MPTVAL=IVACA1
  429.             DO IC=1,NBG
  430.                DO ID=1,6
  431.                   MELVAL=IVAL(ID)
  432.                   VELCHE(IC,IB)=VECT(ID)
  433.                enddo
  434.             enddo
  435.  
  436.          ENDDO
  437. C
  438.  727     SEGSUP IWRK
  439.          GOTO 151
  440. C_______________________________________________________________________
  441. C
  442. C (fdp) FORMULATION JOINT 1 AVEC REPERE LOCAL LIE
  443. C_______________________________________________________________________
  444. C
  445.  75      CONTINUE
  446.          SEGINI IWRK
  447. C
  448. c* Test fait plus haut :         ITOUR=-1*INFMOD(9)
  449. C
  450.          DO IB=1,NBELEM
  451. C
  452. C           ON CHERCHE LES COORDONNEES DES NOEUDS, LES DEPLACEMENTS ET
  453. C           LES ROTATIONS
  454. C
  455.             CALL DOXE(MCOOR1.XCOOR,IDIM,NBNN,NUM,IB,XE)
  456.             IE=1
  457.  
  458.             DO IC=1,NBNN
  459.                MPTVAL=IVADEP
  460.                DO ID=1,NDEP
  461.                   MELVAL=IVAL(ID)
  462.                   IGMN=MIN(IC,VELCHE(/1))
  463.                   IBMN=MIN(IB,VELCHE(/2))
  464.                   XDDL(IE)=VELCHE(IGMN,IBMN)
  465.                   IE=IE+1
  466.                ENDDO
  467.             ENDDO
  468. C
  469. C           ON CHERCHE LES VECTEURS ORIENTANT L'ELEMENT JOINT DANS LE
  470. C           CHAMP DE CARACTERISTIQUES
  471. C
  472.             MPTVAL=IVACAR
  473.             DO IC=1,NCARA
  474.                MELVAL=IVAL(IC)
  475.                IBMN=MIN(IB,VELCHE(/2))
  476.                VECT(IC)=VELCHE(1,IBMN)
  477.             ENDDO
  478. C
  479. C           ON APPLIQUE LA ROTATION AUX VECTEURS ORIENTANT LE JOINT
  480. C
  481. c* Test fait plus haut :            IF (ITOUR.EQ.1) THEN
  482.                CALL JOIFRM(IWRK,KERRE,VECT,IDIM)
  483.                IF (KERRE.EQ.1) THEN
  484.                  CALL ERREUR(277)
  485.                  GOTO 150
  486.                ENDIF
  487. c* Test fait plus haut :            ENDIF
  488. C
  489. C           REMPLISSAGE DU CHAMP DE CARACTERISTIQUES AVEC LES NOUVEAUX
  490. C           VECTEURS
  491. C
  492.             MPTVAL=IVACA1
  493.             DO IC=1,NCARA
  494.                MELVAL=IVAL(IC)
  495.                VELCHE(1,IB)=VECT(IC)
  496.             ENDDO
  497. C
  498.          ENDDO
  499. C
  500.          SEGSUP IWRK
  501.          GOTO 151
  502. C_______________________________________________________________________
  503. C
  504. C    FORMULATION POUTRE ET TUYAU
  505. C_______________________________________________________________________
  506. C
  507.  120     CONTINUE
  508.          SEGINI IWRK
  509. C
  510.          DO IB=1,NBELEM
  511. C
  512. C           ON CHERCHE LES COORDONNEES DES NOEUDS ET LES DEPLACEMENTS
  513. C
  514.             CALL DOXE(MCOOR1.XCOOR,IDIM,NBNN,NUM,IB,XE)
  515.             IE=1
  516.             DO IC=1,NBNN
  517.                MPTVAL=IVADEP
  518.                DO ID=1,NDEP
  519.                   MELVAL=IVAL(ID)
  520.                   IGMN=MIN(IC,VELCHE(/1))
  521.                   IBMN=MIN(IB,VELCHE(/2))
  522.                   XDDL(IE)=VELCHE(IGMN,IBMN)
  523.                   IE=IE+1
  524.                enddo
  525.             enddo
  526. C
  527.             MPTVAL=IVACAR
  528.             do id=1,3
  529.               MELVAL=IVAL(id)
  530.               IBMN=MIN(IB,VELCHE(/2))
  531.               VECT(id)=vELCHE(1,IBMN)
  532.             enddo
  533.  
  534.             CALL POUFRM(IWRK,KERRE,VECT)
  535. C
  536.             IF(KERRE.NE.0) THEN
  537.               INTERR(1)=ISOUS
  538.               INTERR(2)=IB
  539.               GO TO 127
  540.             ENDIF
  541. C
  542. C              REMPLISSAGE
  543. C
  544.             MPTVAL=IVACA1
  545.             DO ID=1,3
  546.               MELVAL=IVAL(ID)
  547.               VELCHE(1,IB)=VECT(ID)
  548.             enddo
  549.  
  550.          ENDDO
  551. C
  552.  127     SEGSUP IWRK
  553.          GOTO 151
  554. C_______________________________________________________________________
  555. C
  556. C    AUTRE FORMULATION
  557. C_______________________________________________________________________
  558. C
  559.  151     CONTINUE
  560.          IF(KERRE.EQ.1) CALL ERREUR(128)
  561.          IF(KERRE.EQ.2) CALL ERREUR(138)
  562.          IF(KERRE.EQ.3) CALL ERREUR(277)
  563.  
  564.  150     CONTINUE
  565.          IF (MOCARA.NE.0) THEN
  566.            nomid=MOCARA
  567.            SEGSUP,NOMID
  568.            MPTVAL=IVACAR
  569.            SEGSUP,MPTVAL
  570.            MPTVAL=IVACA1
  571.            SEGSUP,MPTVAL
  572.          ENDIF
  573.          IF (MODEPL.NE.0) THEN
  574.            nomid=MODEPL
  575.            if (lsupdp) SEGSUP,NOMID
  576.            MPTVAL=IVADEP
  577.            SEGSUP,MPTVAL
  578.          ENDIF
  579.          IF (KERRE.NE.0) GOTO 9990
  580.          IF (IERR.NE.0) GOTO 9990
  581. C
  582.  200  CONTINUE
  583. C
  584. *  remettre mchel1 en read
  585.         CALL ACTOBJ('MCHAML  ',MCHEL1,1)
  586.  
  587.  
  588.       IRET    = 1
  589.       IPCHCA1 = IPCHE1
  590.  
  591. c-dbg      write(ioimp,*)'(S)IPCHE1=',ipche1,NSOUS
  592. c-dbg      do ic = 1, nsous
  593. c-dbg        mchaml = mchel1.ICHAML(IC)
  594. c-dbg        write(ioimp,*)'mchaml=',mchaml,ic,ielval(/1)
  595. c-dbg        write(ioimp,*)'  nomche=',(nomche(id),id=1,ielval(/1))
  596. c-dbg        write(ioimp,*)'  melval=',(ielval(id),id=1,ielval(/1))
  597. c-dbg      enddo
  598.  
  599.  9990 CONTINUE
  600.       notype = MOTYR8
  601.       SEGSUP,notype
  602. *?      IF (IPCHDEP.NE.0) CALL DTCHAM(IPCHDEP)
  603.  
  604.       RETURN
  605.       END
  606.  
  607.  
  608.  
  609.  
  610.  

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