Télécharger la plaquette Cast3M


fr en

Télécharger chasup.eso

Retour à la liste

Numérotation des lignes : 

chasup

  1. C CHASUP    SOURCE    MB234859  25/09/08    21:15:12     12358          
  2.  
  3. C---------------------------------------------------------------------
  4.  
  5. C     ENTREES:
  6. C
  7. C       IPMODL     Pointeur sur un MMODEL
  8. C       IPOI1      Pointeur sur un MCHAML
  9. C       IPLAC      Indique le type de support demandé :
  10. C               1  scalaire aux NOEUDS
  11. C               2  scalaire au  CENTRE DE GRAVITE
  12. C               3  scalaire aux points d'integration de la RAIDEUR
  13. C               4  scalaire aux points d'integration de la MASSE
  14. C               5  scalaire aux points de CONTRAINTES
  15. C
  16. C      AM  14/6/07  SI IPLAC EST NEGATIF, ON RECUPERE UN CHAMP QUI
  17. C                   NE CONTIENT PAS LES COMPOSANTES COMPLEXES (NON SCALAIRES)
  18. C                   QU'ON A N'A PAS PU CHANGER
  19. C                   SINON, ON SORT EN ERREUR
  20. C
  21. C     SORTIE:
  22. C
  23. C       IPOI2      Pointeur sur un MCHAML
  24. C       IRET      =0 Si tout est ok
  25. C                    Sinon contient le numero d'erreur
  26. C
  27. C     I.MONNIER le 31.05.90
  28. C
  29. C---------------------------------------------------------------------
  30.       SUBROUTINE CHASUP(IPMODL,IPOI1,IPOI2,IRET,IPLAC)
  31.  
  32.       IMPLICIT INTEGER(I-N)
  33.       IMPLICIT REAL*8(A-H,O-Z)
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMMODEL
  38. -INC SMCHAML
  39. -INC SMELEME
  40. -INC SMINTE
  41. -INC SMCOORD
  42.       CHARACTER*8 CHARIN,CHARTY,MO24a,MO24b
  43.       CHARACTER*(LOCOMP) MOCOMP
  44.  
  45.       SEGMENT SWORK
  46.         REAL*8 VAL1(NBPGA1),VAL2(NBPGAU),VALN(NBNN)
  47.         REAL*8 SHP(6,NBNN) ,XE(3,NBNN)
  48.       ENDSEGMENT
  49.  
  50.       SEGMENT SWORK2
  51.         INTEGER LETAB(N22)
  52.       ENDSEGMENT
  53. *
  54. *     NBPGA1,NBPGAU DESIGNENT LES TAILLES MAX DES CHAMPS CH1 ET CH2
  55. *     N1PTE1,N1PTEL DESIGNENT LES TAILLES EFFECTIVES DE CES CHAMPS
  56. *
  57. *      write(ioimp,*) 'coucou chasup'
  58. *      write(ioimp,*) 'iplac=',iplac
  59. *      write(ioimp,*) ' MCHAML'
  60. *      call ecrobj('MCHAML  ',IPOI1)
  61. *      call prlist
  62. *      CALL ACTOBJ('MCHAML  ',IPOI1,1)
  63. *      write(ioimp,*) ' MCHAML'
  64. *      call ecrobj('MMODEL  ',IPMODL)
  65. *      call prlist
  66. *      CALL ACTOBJ('MMODEL  ',IPMODL,1)
  67.  
  68.       IRET  =0
  69.       IPOIN1=0
  70.       call oooeta(mcoord,ieta,imod)
  71. C
  72. C     ACTIVATION DU MODELE
  73. C
  74.       MMODEL=IPMODL
  75.       NSOUS1=KMODEL(/1)
  76. C
  77. C     ACTIVATION DES MCHELM
  78. C
  79.       MCHEL1 =IPOI1
  80.       NSOUS=MCHEL1.ICHAML(/1)
  81.       IF(NSOUS.GT.NSOUS1)THEN
  82. *  on va essayer de reduir le champ
  83.          call reduaf(mchel1,mmodel,mchel2,0,ire,kerre)
  84. **     if (ire.ne.1) then
  85. **       call erreur(kerre)
  86. **       IRET=553
  87. **       RETURN
  88. **     endif
  89.          if (ire.eq.1)  mchel1=mchel2
  90.          NSOUS=MCHEL1.ICHAML(/1)
  91.       ENDIF
  92.       N1=NSOUS
  93.       L1=MCHEL1.TITCHE(/1)
  94.       N3=MCHEL1.INFCHE(/2)
  95.       NINF=N3
  96.       IF (N3.LT.6) N3=6
  97.       SEGINI MCHELM
  98.       TITCHE=MCHEL1.TITCHE
  99.       IFOCHE=IFOUR
  100.  
  101.       IPOI2=MCHELM
  102.       iresu=0
  103. C
  104. C  ON BOUCLE SUR LES SOUS-ZONES DU MCHAML
  105. C
  106.       DO 100 ISOUS=1,NSOUS
  107.  
  108.          IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)
  109.          CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)
  110.          DO IP=1,NINF
  111.             INFCHE(ISOUS,IP)=MCHEL1.INFCHE(ISOUS,IP)
  112.          ENDDO
  113. C
  114. C       MISE EN CONCORDANCE DES POINTEURS DE MAILLAGE
  115. C
  116.          MELEME=IMACHE(ISOUS)
  117.          MO24a =CONCHE(ISOUS)
  118.  
  119.          INS=0
  120.          DO IO=1,NSOUS1
  121.             IMODEL=KMODEL(IO)
  122.             IPMAIL=IMAMOD
  123. C
  124. C      CAS DE LA FORMULATION DARCY ON VA EXTRAIRE LE MAILLAGE SOMMET
  125.             CALL PLACE(FORMOD,FORMOD(/2),IDARC,'DARCY           ')
  126.             IF (IDARC.NE.0)THEN
  127.                CALL LEKMOD(MMODEL,IPTABL,INEFMD)
  128.                CHARIN = 'MAILLAGE'
  129.                CALL LEKTAB(IPTABL,CHARIN, IOBRE)
  130.                IF (IERR.NE.0) RETURN
  131.                IPT1 = IOBRE
  132.                IPMAIL= IOBRE
  133.                IF(N1.GT.1.and.ipt1.lisous(/1).ge.n1)THEN
  134.                   IPMAIL= IPT1.LISOUS(ISOUS)
  135.                ENDIF
  136.             ENDIF
  137.             IF (IPMAIL.EQ.MELEME) INS=INS+1
  138.          ENDDO
  139.  
  140.          DO IO=1,NSOUS1
  141.             IMODEL=KMODEL(IO)
  142.             IPMAIL=IMODEL.IMAMOD
  143. C
  144. C      CAS DE LA FORMULATION DARCY ON VA EXTRAIRE LE MAILLAGE SOMMET
  145.             CALL PLACE(FORMOD,FORMOD(/2),IDARC,'DARCY           ')
  146.             IF(IDARC.NE.0)THEN
  147.                CALL LEKMOD(MMODEL,IPTABL,INEFMD)
  148.                CHARIN = 'MAILLAGE'
  149.                CALL LEKTAB(IPTABL,CHARIN, IOBRE)
  150.                IF (IERR.NE.0) RETURN
  151.                IPT1 = IOBRE
  152.                IPMAIL= IOBRE
  153.                IF(N1.GT.1.and.ipt1.lisous(/1).ge.n1)THEN
  154.                   IPMAIL= IPT1.LISOUS(ISOUS)
  155.                ENDIF
  156.             ENDIF
  157.  
  158.             MO24b=imodel.CONMOD
  159.             IF (IPMAIL.EQ.MELEME.AND.(INS.GE.1.OR.MO24a.EQ.MO24b))GOTO
  160.      $           160
  161.          ENDDO
  162. *
  163.          IRET=472
  164.          SEGSUP MCHELM
  165.          RETURN
  166. *
  167.  160     CONTINUE
  168.          MELE=NEFMOD
  169.  
  170. c*         write(6,*) 'chasup - mele ',mele,imodel,ipmail
  171. *  on saute si element sans les supports
  172.          if(mele.eq.22 ) go to 100
  173.          if(mele.eq.259) go to 100
  174.          if(mele.eq.107) go to 100
  175.          if(mele.eq.165) go to 100
  176.          if(mele.eq.261) go to 100
  177. *
  178. *      DANS LE CAS DES COQUES INTEGREES ON SORT EN ERREUR
  179. *
  180.          IF (NINF.LT.4.OR.MCHEL1.INFCHE(ISOUS,4).EQ.0) THEN
  181.             MINTE1=0
  182.             IPLACA=0
  183.          ELSE
  184.             MINTE1=MCHEL1.INFCHE(ISOUS,4)
  185.             IPLACA=MCHEL1.INFCHE(ISOUS,6)
  186.          ENDIF
  187. C
  188.          ithdm = 0
  189.          if (formod(1).eq.'LIAISON         ') then
  190.             IPLAC1 = 1
  191.          else
  192.             IPLAC1 = ABS(IPLAC)
  193.             IF ( IPLAC1 .EQ. 6 ) ithdm = 1
  194. C le modele contient t il de la thermique OU diffusion OU metallurgie ?
  195. C  ==> le segment d'integration est particulier
  196.             IF ( FORMOD(1).EQ.'THERMIQUE       ' .OR.
  197.      &           FORMOD(1).EQ.'DIFFUSION       ' .OR.
  198.      &           FORMOD(1).EQ.'METALLURGIE     ' ) THEN
  199.                ithdm = 1
  200.  
  201. C               nmat = matmod(/2)
  202. C               CALL PLACE(matmod,nmat,icov,'CONVECTION')
  203. C               CALL PLACE(matmod,nmat,iray,'RAYONNEMENT')
  204. C               IF (icov+iray.EQ.0) THEN
  205.                  IF ( IPLAC1 .GT. 2 ) IPLAC1 = 6
  206. C               ENDIF
  207.  
  208.                IF(MELE .EQ. 265)THEN
  209. C             Cas des JOI1 ==> Ressorts THERMIQUES
  210. C             ============
  211.                   ithdm = 0
  212.                   IPLAC1 = 1
  213.                ENDIF
  214.  
  215.             ENDIF
  216.          endif
  217. C
  218.          IF (ithdm.EQ.1 .AND. IPLAC1.GT.1) THEN
  219.             IPMINT = 0
  220.             IF (IPLAC1.EQ.1) CALL TSHAPE(MELE,'NOEUD  ',IPMINT)
  221.             IF (IPLAC1.EQ.2) CALL TSHAPE(MELE,'GRAVITE',IPMINT)
  222.             IF (IPLAC1.EQ.5) CALL TSHAPE(MELE,'GAUSS  ',IPMINT)
  223.             IF (IPLAC1.EQ.6) CALL TSHAPE(MELE,'GAUSS  ',IPMINT)
  224.             IF (IERR .NE. 0) GOTO 665
  225.             MINTE=IPMINT
  226.             MELGEO=NUMGEO(MELE)
  227.          ELSE
  228.            MINTE = INFMOD(2+IPLAC1)
  229.            MELGEO= INFELE(14)
  230.          ENDIF
  231.          INFCHE(ISOUS,4)=MINTE
  232.          IF(IPLAC1.EQ.1)INFCHE(ISOUS,4)=0
  233.          INFCHE(ISOUS,6)=IPLAC1
  234. C
  235. C     ON RECUPERE LE NOMBRE D ELEMENTS
  236. C
  237.          NBNN  =NUM(/1)
  238.          NBELEM=NUM(/2)
  239. C
  240. C     ON RECUPERE LE NOMBRE DE POINTS SUPPORT
  241. C     NBPGA1 POUR L'ANCIEN CHAMP ET NBPGAU POUR LE NOUVEAU
  242. C
  243.          IF(MINTE1.NE.0)THEN
  244.             NBPGA1 = MINTE1.SHPTOT(/3)
  245.          ELSE
  246.             NBPGA1=NBNN
  247.          ENDIF
  248.          if (minte.eq.0) then
  249.             call erreur(5)
  250.             return
  251.          endif
  252.          NBPGAU = SHPTOT(/3)
  253.          nbpga1=max(nbpga1,nbpgau)
  254. C
  255.          NEL   =NBELEM
  256.          SEGINI SWORK
  257. C
  258. C       PREPARATION POUR CREATION DU MCHAML
  259. C
  260.          MCHAM1=MCHEL1.ICHAML(ISOUS)
  261. C
  262.          N22 = MCHAM1.NOMCHE(/2)
  263. *
  264. *     SI IPLAC < 0, ON CHERCHE LE NOMBRE DE COMPOSANTES A CONSERVER
  265. *
  266.          SEGINI SWORK2
  267. *
  268.          IF(IPLAC.GE.0) THEN
  269.             N2 = N22
  270.             DO ICOMP=1,N22
  271.                LETAB(ICOMP) = ICOMP
  272.             ENDDO
  273. *
  274.          ELSE
  275. *
  276. *         BOUCLE SUR LES COMPOSANTES
  277. *
  278.             JECO = 0
  279.             DO ICOMP=1,N22
  280. C
  281.                CHARTY=MCHAM1.TYPCHE(ICOMP)
  282.                MELVA1=MCHAM1.IELVAL(ICOMP)
  283.                LETAB(ICOMP) = 0
  284. *
  285.                IF(CHARTY(1:6).EQ.'REAL*8') THEN
  286.                   JECO = JECO + 1
  287.                   LETAB(ICOMP) = JECO
  288.                ENDIF
  289. *
  290. *            cas de variables complexes
  291. *
  292.                IF(CHARTY(1:8).EQ.'POINTEUR') THEN
  293.                   N2PTE1=MELVA1.IELCHE(/1)
  294. *
  295. * ... Comme on ne sait pas extrapoler ou interpoler de variables
  296. *     composées, on n'en accepte qu'une par élément ...
  297.  
  298.                   IF(N2PTE1.EQ.1) THEN
  299.                      JECO = JECO + 1
  300.                      LETAB(ICOMP) = JECO
  301.                   ENDIF
  302.                ENDIF
  303.             ENDDO
  304.             N2 = JECO
  305. *
  306.          ENDIF
  307. *
  308. *    CREATION DU MCHAML
  309. *
  310.          SEGINI MCHAML
  311.          iresu=iresu+1
  312.          ICHAML(iresu)=MCHAML
  313. C
  314. C       BOUCLE SUR LES COMPOSANTES EN ENTREE
  315. C
  316.          DO 180 ICOMP=1,N22
  317. C
  318.             JCOMP = LETAB(ICOMP)
  319.             IF(JCOMP.EQ.0) GO TO 180
  320.  
  321.             NOMCHE(JCOMP)=MCHAM1.NOMCHE(ICOMP)
  322.             TYPCHE(JCOMP)=MCHAM1.TYPCHE(ICOMP)
  323. C
  324.             MELVA1=MCHAM1.IELVAL(ICOMP)
  325. *
  326. *  RECHERCHE DES TAILLES DU NOUVEAU CHAMELEM - dans le cas scalaire
  327. *
  328.             IF(TYPCHE(JCOMP)(1:6).EQ.'REAL*8') THEN
  329.                N1PTE1=MELVA1.VELCHE(/1)
  330.                IF (N1PTE1.EQ.1) THEN
  331.                   N1PTEL=1
  332.                ELSE
  333.                   N1PTEL=NBPGAU
  334.                ENDIF
  335.                N1EL  =MELVA1.VELCHE(/2)
  336. *
  337. *  PETIT TEST DE COMPATIBILITE DES NOMBRES D'ELEMENTS
  338. *
  339.                IF(N1EL.NE.NEL.AND.N1EL.NE.1.AND.NEL.NE.1) THEN
  340.                   SEGSUP SWORK,SWORK2,MCHAML
  341.                   IRET=146
  342.                   MOTERR(1:8)='CHASUP  '
  343.                   GO TO 665
  344.                ENDIF
  345. *
  346.                N1PAUX=N1PTE1
  347. C
  348. C-----------------------------------------------------------------------
  349. C                     PETIT TEST POUR LE COQ4
  350. C       SI LE NOMBRE DE POINTS DE GAUSS VAUT 5 , ON NE PREND QUE
  351. C       LES 4 PREMIERS , LE 5-EME SERVANT UNIQUEMENT AU CISAILLEMENT
  352. C
  353.                IF (MELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4
  354. C-----------------------------------------------------------------------
  355. C
  356.             ELSE
  357.                N1PTEL=0
  358.                N1EL=0
  359.             ENDIF
  360. *
  361. *     ... Et dans le cas de variables complexes ...
  362. *
  363.             IF(TYPCHE(JCOMP)(1:8).EQ.'POINTEUR') THEN
  364.                N2PTE1=MELVA1.IELCHE(/1)
  365.                IF (N2PTE1.EQ.1) THEN
  366.                   N2PTEL=1
  367.                ELSE
  368.                   N2PTEL=NBPGAU
  369.                ENDIF
  370.                N2EL  =MELVA1.IELCHE(/2)
  371. *
  372. * ... Comme on ne sait pas extrapoler ou interpoler de variables
  373. *     composées, on n'en accepte qu'une par élément ...
  374.  
  375. *           IF(N2PTEL.NE.1) THEN
  376. *             SEGSUP SWORK,SWORK2,MCHAML
  377. *             IRET=755
  378. *             GO TO 665
  379. *           ENDIF
  380. *
  381. *  PETIT TEST DE COMPATIBILITE DES NOMBRES D'ELEMENTS
  382. *
  383.                IF(N2EL.NE.NEL.AND.N2EL.NE.1.AND.NEL.NE.1) THEN
  384.                   SEGSUP SWORK,SWORK2,MCHAML
  385.                   IRET=146
  386.                   MOTERR(1:8)='CHASUP  '
  387.                   GO TO 665
  388.                ENDIF
  389.  
  390.             ELSE
  391.                N2PTEL=0
  392.                N2EL=0
  393.             ENDIF
  394.             SEGINI MELVAL
  395.             IELVAL(JCOMP)=MELVAL
  396. *
  397. *  TRAITEMENT IMMEDIAT SI CHAMP CONSTANT
  398. *
  399. *         if(iplac1.eq.4) write(6,*)' n2ptel n1ptel',n2ptel,n1ptelq
  400.             IF(n2ptel.ne.0) then
  401.                IF(N2PTEL.EQ.1) THEN
  402.                   DO 4119 IEL=1,N2EL
  403.                      IELCHE(1,IEL)=MELVA1.IELCHE(1,IEL)
  404.  4119             CONTINUE
  405. C*        ELSE IF (N2PTEL.NE.1) THEN
  406.                ELSE
  407.                   IF (MINTE.NE.MINTE1. AND. IPLAC1.NE.IPLACA) THEN
  408.                      SEGSUP SWORK,SWORK2,MCHAML
  409.                      IRET=755
  410.                      GO TO 665
  411.                   ENDIF
  412.                   DO 4109 IGAU=1,N2PTEL
  413.                      DO 41091 IEL=1,N2EL
  414.                         IELCHE(IGAU,IEL)=MELVA1.IELCHE(IGAU,IEL)
  415. 41091                CONTINUE
  416.  4109             CONTINUE
  417.                ENDIF
  418.             else
  419.                IF(N1PTE1.EQ.1) THEN
  420.                   DO 4120 IEL=1,N1EL
  421.                      VELCHE(1,IEL)=MELVA1.VELCHE(1,IEL)
  422.  4120             CONTINUE
  423. *
  424.                ELSE
  425. *
  426. *          write (6,*) melva1.velche(/1),melva1.velche(/2)
  427.  
  428.                   DO 3120 IEL=1,NEL
  429.                      IF(IEL.GT.1.AND.N1EL.EQ.1) GO TO 3130
  430.                      DO 3121 IGAU=1,N1PTE1
  431.                         VAL1(IGAU)=MELVA1.VELCHE(IGAU,IEL)
  432.  3121                CONTINUE
  433.  
  434. *          write(6,*) 'MINTE1 = ',minte1
  435.  
  436. C
  437. C      1-ER CAS : LE CHAMELEM N'EST PAS AUX NOEUDS
  438. C
  439.                      IF(MINTE1.NE.0)THEN
  440. C
  441. C           MEME SUPPORT? ( attention test sur iplaca et iplac1 pour DKT)
  442. C
  443. *            write(6,*) ' meme support?',minte,minte1,iplac1,iplaca
  444.                         IF(MINTE.EQ.MINTE1. OR. IPLAC1.eq.IPLACA)
  445.      $                       THEN
  446.                            DO 3124 IGAU=1,N1PTE1
  447.                               VELCHE(IGAU,IEL)=VAL1(IGAU)
  448.  3124                      CONTINUE
  449. C
  450. C           SUPPORTS DIFFERENTS
  451. C
  452.                         ELSE
  453. C
  454. C   COQUE INTEGREE OU PAS ?
  455. C
  456.                            NPINT=INFMOD(1)
  457.                            IF (NPINT.NE.0.AND.NPINT.NE.1)THEN
  458.                               IRET = 19
  459.                               SEGSUP SWORK,SWORK2,MCHAML,MELVAL
  460.                               GO TO 665
  461.                            ENDIF
  462. C
  463.                            if (ieta.ne.1) then
  464.                               ieta=1
  465.                               segact mcoord
  466.                            endif
  467.                            CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  468.                            CALL QUEDIM(MELGEO,KERRE)
  469.                            CALL CH1CH2(MELE,MINTE,MINTE1,N1PTEL
  470.      $                          ,N1PAUX,NBNN,SWORK,IPOIN1,KERRE)
  471.                            IF(KERRE.NE.0) THEN
  472.                               IRET=KERRE
  473.                               SEGSUP SWORK,SWORK2,MCHAML,MELVAL
  474.                               GO TO 665
  475.                            ENDIF
  476. *
  477.                            DO 3122 IGAU=1,N1PTEL
  478.                               VELCHE(IGAU,IEL)=VAL2(IGAU)
  479.  3122                      CONTINUE
  480.                         ENDIF
  481. C
  482. C      2-EME CAS : LE CHAMELEM EST AUX NOEUDS
  483. C
  484.                      ELSE
  485. *
  486. *  AM  1/4/16 CAS PARTICULIER DES JOINTS
  487. *
  488.                         IF( MELGEO.EQ.12.OR.MELGEO.EQ.13
  489.      &                       .OR.MELGEO.EQ.29.OR.MELGEO.EQ.30
  490.      &                       .OR.MELGEO.EQ.31) THEN
  491. *
  492.                            IF(((IPLACA.EQ.0.OR.IPLACA.EQ.1).AND.
  493.      $                          IPLAC1.EQ.1).AND.(N1PTEL.EQ.N1PTE1))
  494.      $                          THEN
  495.                               DO IGAU=1,N1PTE1
  496.                                  VELCHE(IGAU,IEL)=VAL1(IGAU)
  497.                               ENDDO
  498.                            ELSE
  499. *
  500.                               IDECA=0
  501.                               IF(MELGEO.EQ.29) IDECA=2
  502.                               IF(MELGEO.EQ.30) IDECA=3
  503.                               IF(MELGEO.EQ.31) IDECA=4
  504.                               NBNOU=NBNN-IDECA
  505.                               NBNOV=SHPTOT(/2)-IDECA
  506. *
  507.                               MOCOMP=NOMCHE(JCOMP)
  508.                               IF (MOCOMP.EQ.'P  '.OR.
  509.      &                            MOCOMP.EQ.'PQ '.OR.
  510.      &                            MOCOMP.EQ.'TP '    ) THEN
  511.                                  DO IGAU=1,N1PTEL
  512.                                     VALG=0.D0
  513.                                     DO INO=1,IDECA
  514.                                        INO1 = NBNOU + INO
  515.                                        INO2 = NBNOV + INO
  516.                                        VALG=VALG+SHPTOT(1,INO2,IGAU)
  517.      $                                      *VAL1(INO1)
  518.                                     ENDDO
  519.                                     VELCHE(IGAU,IEL)=VALG
  520.                                  ENDDO
  521.  
  522.                               ELSE
  523.                                  DO IGAU=1,N1PTEL
  524.                                     VALG=0.D0
  525.                                     DO INO=1,NBNOU
  526.                                        VALG=VALG+SHPTOT(1,INO,IGAU)
  527.      $                                      *VAL1(INO)
  528.                                     ENDDO
  529.                                     VELCHE(IGAU,IEL)=VALG/2.D0
  530.                                  ENDDO
  531.                               ENDIF
  532.                            ENDIF
  533.  
  534.                         ELSE
  535.                            DO IGAU=1,N1PTEL
  536.                               VALG=0.D0
  537.                               DO INO=1,NBNN
  538.                                  VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO)
  539.                               ENDDO
  540.                               VELCHE(IGAU,IEL)=VALG
  541.                            ENDDO
  542.                         ENDIF
  543.  
  544.                      ENDIF
  545.  3120             CONTINUE
  546.  3130             CONTINUE
  547.  
  548.                ENDIF
  549.             endif
  550.  180     CONTINUE
  551.          SEGSUP SWORK,SWORK2
  552.  
  553.  100  CONTINUE
  554.       if (iresu.ne.nsous) then
  555.          n1=iresu
  556.          segadj mchelm
  557.       endif
  558.  
  559.  665  CONTINUE
  560. c      return
  561.       END
  562.  
  563.  
  564.  
  565.  
  566.  

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