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

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