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

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