Télécharger la plaquette Cast3M


fr en

Télécharger chame1.eso

Retour à la liste

Numérotation des lignes : 

chame1

  1. C CHAME1    SOURCE    MB234859  25/09/08    21:15:09     12358          
  2.  
  3. C____________________________________________________________________*
  4. C                                                                    *
  5. C     transformation de CHPOINT en MCHAML                            *
  6. C                                                                    *
  7. C     entrees:                                                       *
  8. C     ________                                                       *
  9. C                                                                    *
  10. C     ipmail       pointeur sur un maillage                          *
  11. C ou  ipmodl       pointeur sur un mmodel                            *
  12. C     ipchpo       pointeur sur le chpoint                           *
  13. C     cha          chaine de caractere contenant un sous type eventuel
  14. C     isup         indique le type de support demande :              *
  15. C                  1 le mchaml est laisse aux noeuds                 *
  16. C                  2 au centre de gravite                            *
  17. C                  3 aux points de gauss de la raideur               *
  18. C                  4 aux points de gauss de la masse                 *
  19. C                  5 aux points de gauss des contraintes             *
  20. C                  6 aux point de gauss de la thermique & diffusion  *
  21. C                    & metallurgie                                   *
  22. C                                                                    *
  23. C     sorties:                                                       *
  24. C     ________                                                       *
  25. C                                                                    *
  26. C     ipchel       pointeur sur le mchaml resultat                   *
  27. C                                                                    *
  28. C     Remarque : le passage du mchaml sur un autre support que les   *
  29. C     --------   noeuds n'est possible que si l'on a donne un mmodel *
  30. C                                                                    *
  31. C                le traitement d'harmoniques de fourier n'est pas    *
  32. C                implemente                                          *
  33. C                                                                    *
  34. C____________________________________________________________________*
  35. C                                                                    *
  36.       SUBROUTINE CHAME1(IPMAIL,IPMODL,IPCHPO,CHA,IPCHEL,ISUP)
  37.  
  38.       IMPLICIT INTEGER(I-N)
  39.       IMPLICIT REAL*8(A-H,O-Z)
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC CCGEOME
  44. -INC CCASSIS
  45. -INC CCPRECO
  46. C==DEB= FORMULATION HHO == Include specifique ==========================
  47. -INC CCHHOPA
  48. C==FIN= FORMULATION HHO ================================================
  49.  
  50. -INC SMCHAML
  51. -INC SMCHPOI
  52. -INC SMINTE
  53. -INC SMMODEL
  54. -INC SMELEME
  55. -INC SMCOORD
  56.  
  57.       COMMON/cham1c/IPARA1,IPARA2
  58.       EXTERNAL CHAM1I
  59.       LOGICAL  BTHRD
  60.  
  61.       SEGMENT SPARA1
  62.         INTEGER NBTHR1
  63.         INTEGER IPCH1
  64.         INTEGER IPTP1
  65.         INTEGER IPTR1
  66.       ENDSEGMENT
  67.  
  68.       SEGMENT SPARA2
  69.         INTEGER NBTHRD
  70.         INTEGER IISUP
  71.         INTEGER IPSAU
  72.         INTEGER IPMOD
  73.         INTEGER IPCHE
  74.         INTEGER IPTPR
  75.         INTEGER IPTRA
  76.       ENDSEGMENT
  77.  
  78.       SEGMENT ISAUT(IVAL,NSOUS)
  79.       SEGMENT ICPR(nbpts)
  80.  
  81.       SEGMENT MTRA2
  82. C      Copie du CHPOINT dans MTRA2 pour aller plus vite ensuite
  83.        CHARACTER*(LOCOMP) INCO(N2)
  84.        REAL*8      BB(NX,N2)
  85. C        INCO  : Nom des INCONNUES du CHPOINT
  86. C        BB    : Valeurs au noeuds du MMODEL (associees au ICPR)
  87. C                NX : Nombre de noeuds differents dans le MODELE
  88. C                N2 : Nombre de composantes dans le CHPOINT
  89.       ENDSEGMENT
  90.  
  91.       CHARACTER*(*) CHA
  92.       CHARACTER*(LOCOMP) MOCOMP
  93.       CHARACTER*1 MO1,VID1
  94.  
  95. C   soutyp = sous-type du champ par element resultat
  96. C   lsouty = longueur utile de la chaine "soutyp"
  97.       INTEGER LSOUTY
  98.       CHARACTER*72 SOUTYP
  99.       LOGICAL ICOQ
  100.  
  101.       if (isup.lt.1 .or. isup.gt.6) then
  102.         write(ioimp,*) 'CHAME1 : isup < 1 or isup > 6'
  103.         call erreur(5)
  104.       endif
  105.  
  106. c*      write(ioimp,*) 'chame1 ',ipmAIL,IPMODL,IPCHPO,CHA,ISUP
  107. *  preconditionnement on regarde si on a sauve le resultat
  108. *  on ne fait l'horodatage que pour le chp par mesure d'economie
  109.       ith=oothrd
  110.       ihomai = 0
  111.       ihomod = 0
  112.       if (ipmodl.ne.0.and.ipmail.ne.0) ipmail=0
  113.       if (ipmail.ne.0) call oooho1(ipmail,ihomai)
  114.       if (ipmodl.ne.0) call oooho1(ipmodl,ihomod)
  115.       call oooho1(ipchpo,ihochp)
  116.       do 100 iprec=1,nprcha
  117.        if (iprma(iprec,ith).ne.ipmail) goto 100
  118.        if (iprhoa(iprec,ith).ne.ihomai) goto 100
  119.        if (iprmo(iprec,ith).ne.ipmodl) goto 100
  120.        if (iprhom(iprec,ith).ne.ihomod) goto 100
  121.        if (iprchp(iprec,ith).ne.ipchpo) goto 100
  122.        if (iprhoc(iprec,ith).ne.ihochp) goto 100
  123.        if (iprsu(iprec,ith).ne.isup  ) goto 100
  124.        if (iprcha(iprec,ith).ne.cha  ) goto 100
  125.        if (iprcnf(iprec,ith).ne.mcoord) goto 100
  126. *  preconditionnement trouve
  127.        ipchel=iprchl(iprec,ith)
  128. **     if(ith.eq.1)
  129. **   > write(6,*) ' preconditionnement trouve ',iprec,ith,ipchel
  130.        call actobj('MCHAML',ipchel,1)
  131.        return
  132.  100  continue
  133.  
  134.       IPARA1= 0
  135.       IPARA2= 0
  136.  
  137.       NT1   = 1
  138.       NT2   = 1
  139.       IOPTIM= 100
  140.  
  141.       IPCHEL= 0
  142.       VID1  = ' '
  143.       MO1   = ' '
  144.  
  145.       ither = 0
  146.       idiff = 0
  147.       imeta = 0
  148. C
  149. C   Informations sur le chpoint
  150. C
  151.       MCHPOI = IPCHPO
  152.  
  153. C     Renvoie le nombre de composantes
  154.       CALL NBCOMP(MCHPOI,'CHPOINT ',N2)
  155.  
  156.       NSOUPO = IPCHP(/1)
  157.  
  158.       ICOQ=.FALSE.
  159.       DO ISOUPO=1,NSOUPO
  160.         MSOUPO=IPCHP(ISOUPO)
  161.         NCOMPO=NOCOMP(/2)
  162.         DO ICO=1,NCOMPO
  163.           MOCOMP=MSOUPO.NOCOMP(ICO)
  164.           IF (MOCOMP(1:4).EQ.'TINF'.OR.MOCOMP(1:4).EQ.'TSUP') THEN
  165.             ICOQ=.TRUE.
  166.             GOTO 1
  167.           ENDIF
  168.         ENDDO
  169.       ENDDO
  170.  1    CONTINUE
  171. C
  172. C     on cree l'objet maillage contenant tous les points du chpoint
  173.       IF (IPMAIL.NE.0) THEN
  174.          IPT1=IPMAIL
  175.          NSOU1 = IPT1.LISOUS(/1)
  176.          NSOUS = MAX(1,NSOU1)
  177.       ELSE IF (IPMODL.NE.0) THEN
  178.          MMODEL = IPMODL
  179.          NSOUS  = KMODEL(/1)
  180.       ENDIF
  181. C
  182. C     initialisation du segment descripteur du champ par element
  183. C
  184.       N1 = NSOUS
  185.       N3 = 6
  186.       MO1 = CHA(1:1)
  187.       IF (MO1.EQ.VID1) THEN
  188.          L1=8
  189.          SOUTYP=MTYPOI
  190.       ELSE
  191.          L1=LEN(CHA)
  192.          SOUTYP=CHA
  193.       ENDIF
  194.  
  195.       NX    =0
  196.  
  197. C     Dimensionnement de ISAUT
  198.       IVAL=6
  199.       IF (ICOQ) IVAL = IVAL + 2
  200.  
  201.       IF(OOTHRD .NE.0) call oooprl(1)
  202.       SEGINI,ICPR,ISAUT
  203.       IF(OOTHRD .NE.0) call oooprl(0)
  204.  
  205.       NSCHM = 0
  206.  
  207.       DO 19 ISOUS = 1, NSOUS
  208.  
  209.          IPMINT=0
  210.  
  211.          IF (IPMAIL.NE.0) THEN
  212.  
  213.             ISUP1 = 1
  214.  
  215.             IF (NSOU1.GE.1) THEN
  216.                IPT2=IPT1.LISOUS(ISOUS)
  217.             ELSE
  218.                IPT2=IPMAIL
  219.             ENDIF
  220.  
  221.          ELSE IF (IPMODL.NE.0) THEN
  222.  
  223.             ISUP1 = ISUP
  224.  
  225.             IMODEL = KMODEL(ISOUS)
  226.  
  227.             IPT2 = IMAMOD
  228.             MELE = NEFMOD
  229.  
  230. C==DEB= FORMULATION HHO ================================================
  231. C= On ne fait pas de MCHAML pour les HHO (a voir par la suite...)
  232.             IF (MELE.EQ.HHO_NUM_ELEMENT) THEN
  233.               GOTO 19
  234.             END IF
  235. C==FIN= FORMULATION HHO ================================================
  236.  
  237. c           pour les elements MULT, on autorise que les MCHAML aux noeuds
  238.             if (ISUP1.ne.1) then
  239.               if(mele.eq.22 .OR. mele.eq.259) goto 19
  240.             endif
  241.  
  242.             if (formod(1)(1:8).eq.'LIAISON ') then
  243. C             ne fait rien si le maillage de LIAISON n'appartient pas au CHPOINT
  244.  
  245.               IVAL1 = IPT2.num(1,1)
  246.               DO I=1,NSOUPO
  247.                 MSOUPO=IPCHP(I)
  248.                 MELEME=IGEOC
  249.                 do jno = 1, num(/2)
  250.                   if (num(1,jno).eq.IVAL1) goto 191
  251.                 enddo
  252.                 goto 19
  253.               ENDDO
  254.  191          CONTINUE
  255.             endif
  256.  
  257.             NPINT = INFMOD(1)
  258. C
  259. C           Changement de support si besoin selon la formulation ?
  260.             IF (ISUP1 .NE. 1) THEN
  261.               NFOR = FORMOD(/2)
  262.               CALL PLACE(FORMOD,NFOR,icont,'CONTACT         ')
  263.               CALL PLACE(FORMOD,NFOR,ichph,'CHANGEMENT_PHASE')
  264.               IF (icont.NE.0 .OR. ichph.NE.0) THEN
  265.                 ISUP1 = 1
  266.               ELSE
  267.                 CALL PLACE(FORMOD,NFOR,ither,'THERMIQUE')
  268.                 CALL PLACE(FORMOD,NFOR,idiff,'DIFFUSION')
  269.                 CALL PLACE(FORMOD,NFOR,imeta,'METALLURGIE')
  270.                 IF (ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  271.                   nmat = matmod(/2)
  272.                   CALL PLACE(matmod,nmat,iray,'RAYONNEMENT')
  273. C                 Support 6 SAUF pour le RAYONNEMENT...
  274. C                 Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  275.                   IF (iray.EQ.0) THEN
  276.                     IF (ISUP1.GT.2) ISUP1 = 6
  277.                   ENDIF
  278.                 ENDIF
  279.               ENDIF
  280.             ENDIF
  281. C
  282. C           on recupere le pointeur sur le minte correspondant a isup1
  283. C
  284.             IF (ISUP1.GT.1) THEN
  285. C              cas de la THERMIQUE(sauf RAYONNEMENT) OU DIFFUSION OU METALLURGIE
  286.                IF (ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  287.                  IF ( ISUP1 .EQ. 2) THEN
  288.                    CALL TSHAPE(MELE,'GRAVITE',IPMINT)
  289. cc                 ELSE IF ( ISUP1 .EQ. 6) THEN
  290.                  ELSE
  291.                    CALL TSHAPE(MELE,'GAUSS  ',IPMINT)
  292.                  ENDIF
  293.                  IF (IERR.NE.0) RETURN
  294.                  IELE = NUMGEO(MELE)
  295.                  NBNN = NBNNE(IELE)
  296.                ELSE
  297.                  IPMINT=INFMOD(2+ISUP1)
  298.                  IELE  =INFELE(14)
  299.                  NBNN  =NBNNE(IELE)
  300.                ENDIF
  301. C
  302. C              initialisation de ipore pour milieu poreux
  303. C
  304.                IPORE=0
  305.                IF(MELE.GE.79 .AND.MELE.LE.83 ) IPORE=NBNN
  306.                IF(MELE.GE.173.AND.MELE.LE.177) IPORE=NBNN
  307.                IF(MELE.GE.178.AND.MELE.LE.182) IPORE=NBNN
  308. C              cas XFEM il faut seulement les 4 premier noeuds (support geometrique)
  309. C*??               IF (MELE.EQ.263 .OR. MELE.EQ.264) IPORE=NBNN
  310.                IF (MELE.GE.263) IPORE=NBNN
  311.  
  312.                IF(IPORE .EQ. 0)THEN
  313.                  MINTE         =IPMINT
  314.                  ISAUT(5,ISOUS)=SHPTOT(/2)
  315.                ELSE
  316.                  ISAUT(5,ISOUS)=IPORE
  317.                ENDIF
  318.             ENDIF
  319. C
  320. C           Quels sont les modeles concernes par TINF et TSUP
  321.             IF (ICOQ) THEN
  322.               ISAUT(IVAL-1,ISOUS)=0
  323.               IPNOMC = 0
  324.               CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
  325.               IF (ITHER.NE.0) THEN
  326.                 IPNOMC = LNOMID(1)
  327.               ENDIF
  328.               CALL PLACE(FORMOD,NFOR,IMECA,'MECANIQUE')
  329.               IF (IMECA.NE.0) THEN
  330.                 IPNOMC = LNOMID(8)
  331.               ENDIF
  332.               IF (IPNOMC.EQ.0) GOTO 192
  333.               NOMID = IPNOMC
  334.               NCOBL = LESOBL(/2)
  335.               DO IJC = 1,NCOBL
  336.                 MOCOMP = LESOBL(IJC)
  337.                 IF (MOCOMP(1:4).EQ.'TINF'.OR.MOCOMP(1:4).EQ.'TSUP') THEN
  338.                   ISAUT(IVAL-1,ISOUS)=1
  339.                   GOTO 192
  340.                 ENDIF
  341.               ENDDO
  342.  192          CONTINUE
  343.             ENDIF
  344. C
  345.          ELSE
  346.            CALL ERREUR(5)
  347.            RETURN
  348.          ENDIF
  349.  
  350.          NSCHM = NSCHM + 1
  351.  
  352.          NBNO = IPT2.NUM(/1)
  353.          N1EL = IPT2.NUM(/2)
  354.  
  355. C        Remplissage de l'ICPR a partir des noeuds du MMODEL
  356. C          L'utilisation d'un ICPR par MMODEL limite l'utilisation de
  357. C          memoire en parallele dans les ASSISTANTS
  358.          DO IEL=1,N1EL
  359.            DO INO=1,NBNO
  360.               INOEU=IPT2.NUM(INO,IEL)
  361.               IF(ICPR(INOEU) .EQ. 0)THEN
  362.                 NX=NX+1
  363.                 ICPR(INOEU)=NX
  364.               ENDIF
  365.            ENDDO
  366.          ENDDO
  367.  
  368.          IF(IPMINT .EQ. 0)THEN
  369.            N1PTEL=NBNO
  370.          ELSE
  371.            MINTE =IPMINT
  372.            N1PTEL=SHPTOT(/3)
  373.          ENDIF
  374.          NT2 = MAX(NT2,N1EL*N1PTEL)
  375.  
  376.          ISAUT(1,ISOUS) = IPT2
  377.          ISAUT(2,ISOUS) = N1EL
  378.          ISAUT(3,ISOUS) = N1PTEL
  379.          ISAUT(4,ISOUS) = IPMINT
  380.          ISAUT(6,ISOUS) = ISUP1
  381.  
  382.  19   CONTINUE
  383.  
  384. C     Creation d'un MAXIMUM de SEGMENTS dans un LOCK
  385.       N1 = NSCHM
  386.       IF(OOTHRD .NE.0) call oooprl(1)
  387.       SEGINI,MCHELM
  388.  
  389.       TITCHE=SOUTYP
  390.       IFOCHE=IFOUR
  391.  
  392.       N2PTEL=0
  393.       N2EL  =0
  394.  
  395.       ischm = 0
  396.       DO ISOUS = 1, NSOUS
  397.         IF (ISAUT(1,ISOUS).NE.0) THEN
  398.           ischm = ischm + 1
  399.           SEGINI,MCHAML
  400.           ICHAML(ischm) = MCHAML
  401.           N1EL   = ISAUT(2,ISOUS)
  402.           N1PTEL = ISAUT(3,ISOUS)
  403.           DO ICOMP=1,N2
  404.             SEGINI,MELVAL
  405.             IELVAL(ICOMP)=MELVAL
  406.           ENDDO
  407.           IF (ICOQ) THEN
  408.             IF (ISAUT(IVAL-1,ISOUS).EQ.1) THEN
  409.               SEGINI,MELVAL
  410.               ISAUT(IVAL,ISOUS) = MELVAL
  411.             ENDIF
  412.           ENDIF
  413.         ENDIF
  414.       ENDDO
  415.       IF (ischm.NE.NSCHM) THEN
  416.         write(ioimp,*) 'CHAME1 : Incompatibilite ischm & NSCHM'
  417.         CALL ERREUR(5)
  418.       ENDIF
  419.  
  420.       SEGINI,MTRA2
  421.       IF(OOTHRD .NE.0) call oooprl(0)
  422.  
  423.       NCO = 0
  424.       DO ISOUPO=1,NSOUPO
  425.         MSOUPO=IPCHP(ISOUPO)
  426.         MELEME=IGEOC
  427.         NT1   =MAX(NT1,NUM(/2))
  428.         NC    =MSOUPO.NOHARM(/1)
  429.         DO 101 ICO=1,NC
  430.           MOCOMP=MSOUPO.NOCOMP(ICO)
  431.           DO K=1,NCO
  432.             IF (MOCOMP .EQ. MTRA2.INCO(K)) GOTO 101
  433.           ENDDO
  434.           NCO = NCO + 1
  435.           K   = NCO
  436.           MTRA2.INCO(NCO)=MOCOMP
  437.  101    CONTINUE
  438.       ENDDO
  439.  
  440. C----------------------------------------------------------------------C
  441. C  Remplissage du MTRA2
  442. C----------------------------------------------------------------------C
  443.       NBTHR=MIN(MAX(NT1/IOPTIM,1),NBTHRS)
  444.       IF ((NBTHR .EQ. 1) .OR. (NBTHRS .EQ. 1) .OR. (OOTHRD .GT. 0)) THEN
  445. C       CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  446. C                  DEJA DANS LES ASSISTANTS
  447.         NBTHR = 1
  448.         BTHRD = .FALSE.
  449.       ELSE
  450.         BTHRD = .TRUE.
  451.         CALL THREADII
  452.       ENDIF
  453.  
  454.       IF (BTHRD) THEN
  455. C       Remplissage du 'COMMON/cham1c'
  456.         SEGINI,SPARA1
  457.         IPARA1=SPARA1
  458.         IPARA2=0
  459.  
  460.         SPARA1.NBTHR1=NBTHR
  461.         SPARA1.IPCH1 =MCHPOI
  462.         SPARA1.IPTP1 =ICPR
  463.         SPARA1.IPTR1 =MTRA2
  464.  
  465.         DO ith=2,NBTHR
  466.           CALL THREADID(ith,CHAM1i)
  467.         ENDDO
  468.         CALL CHAM1i(1)
  469.  
  470. C       Attente de la fin de tous les threads en cours de travail
  471.         DO ith=2,NBTHR
  472.           CALL THREADIF(ith)
  473.         ENDDO
  474.  
  475. C       On libère les Threads
  476.         CALL THREADIS
  477.         SEGSUP,SPARA1
  478.  
  479.       ELSE
  480. C       Appel de la SUBROUTINE qui fait le travail
  481.         ith=1
  482.         CALL CHAM11(NBTHR,ith,MCHPOI,ICPR,MTRA2)
  483.       ENDIF
  484.  
  485. C----------------------------------------------------------------------C
  486. C  Remplissage du MCHAML
  487. C----------------------------------------------------------------------C
  488.  
  489.       NBTHR=MIN(MAX(NT2/IOPTIM,1),NBTHRS)
  490.       IF ((NBTHR .EQ. 1) .OR. (NBTHRS .EQ. 1) .OR. (OOTHRD .GT. 0)) THEN
  491. C       CB215821 : DESACTIVE LA PARALLELISATION PTHREAD LORSQUE ON EST
  492. C                  DEJA DANS LES ASSISTANTS
  493.         NBTHR = 1
  494.         BTHRD = .FALSE.
  495.       ELSE
  496.         BTHRD = .TRUE.
  497.         CALL THREADII
  498.       ENDIF
  499.  
  500.       IF (BTHRD) THEN
  501. C       Remplissage du 'COMMON/cham1c'
  502.         SEGINI,SPARA2
  503.         IPARA1=0
  504.         IPARA2=SPARA2
  505.  
  506.         SPARA2.NBTHRD=NBTHR
  507.         SPARA2.IISUP =ISUP
  508.         SPARA2.IPSAU =ISAUT
  509.         SPARA2.IPMOD =IPMODL
  510.         SPARA2.IPCHE =MCHELM
  511.         SPARA2.IPTPR =ICPR
  512.         SPARA2.IPTRA =MTRA2
  513.  
  514.         DO ith=2,NBTHR
  515.           CALL THREADID(ith,CHAM1i)
  516.         ENDDO
  517.         CALL CHAM1i(1)
  518.  
  519. C       Attente de la fin de tous les threads en cours de travail
  520.         DO ith=2,NBTHR
  521.           CALL THREADIF(ith)
  522.         ENDDO
  523.  
  524. C       On libere les Threads
  525.         CALL THREADIS
  526.         SEGSUP,SPARA2
  527.  
  528.       ELSE
  529. C       Appel de la SUBROUTINE qui fait le travail
  530.         ith=1
  531.         CALL CHAM12(NBTHR,ith,ISUP,ISAUT,IPMODL,MCHELM,ICPR,MTRA2)
  532.       ENDIF
  533.  
  534. C     Modification pour les modeles avec TINF ou TSUP
  535.       IF (ICOQ.AND.IPMODL.NE.0) THEN
  536.         ischm = 0
  537.         DO ISOUS = 1, NSOUS
  538.           IF (ISAUT(1,ISOUS).NE.0) THEN
  539.             ischm = ischm + 1
  540.             IF (ISAUT(IVAL-1,ISOUS).EQ.2) THEN
  541.               MCHAM1 = ICHAML(ischm)
  542.               DO IJC = 1,N2
  543.                 MOCOMP = MCHAM1.NOMCHE(IJC)
  544.                 IF (MOCOMP.EQ.'T       ') GOTO 25
  545.               ENDDO
  546.  25           CONTINUE
  547.               MCHAM1.IELVAL(IJC)=ISAUT(IVAL,ISOUS)
  548.             ENDIF
  549.           ENDIF
  550.         ENDDO
  551.       ENDIF
  552. C
  553.       SEGSUP,MTRA2,ISAUT,ICPR
  554.  
  555. C COMPACTAGE DU CHAMP OBTENU :
  556.       NSCHM = mchelm.ICHAML(/1)
  557.       DO ischm = 1, NSCHM
  558.         MCHAML = mchelm.ICHAML(ischm)
  559.         N2 = mchaml.IELVAL(/1)
  560.         DO ijc = 1, N2
  561.           MELVAL = mchaml.IELVAL(ijc)
  562.           IF (MELVAL .NE. 0) CALL COMRED(MELVAL)
  563.         ENDDO
  564.       ENDDO
  565.  
  566.       IPCHEL=MCHELM
  567. *  preconditionnement on garde l'operation en memoire
  568.       ith=oothrd
  569.       do iprec=nprcha,2,-1
  570.       iprma(iprec,ith) =iprma(iprec-1,ith)
  571.       iprhoa(iprec,ith)=iprhoa(iprec-1,ith)
  572.       iprmo(iprec,ith) =iprmo(iprec-1,ith)
  573.       iprhom(iprec,ith)=iprhom(iprec-1,ith)
  574.       iprchp(iprec,ith)=iprchp(iprec-1,ith)
  575.       iprhoc(iprec,ith)=iprhoc(iprec-1,ith)
  576.       iprsu(iprec,ith) =iprsu(iprec-1,ith)
  577.       iprcha(iprec,ith)=iprcha(iprec-1,ith)
  578.       iprcnf(iprec,ith)=iprcnf(iprec-1,ith)
  579.       iprchl(iprec,ith)=iprchl(iprec-1,ith)
  580.       enddo
  581.       iprma(1,ith) =ipmail
  582.       iprhoa(1,ith)=ihomai
  583.       iprmo(1,ith) =ipmodl
  584.       iprhom(1,ith)=ihomod
  585.       iprchp(1,ith)=ipchpo
  586.       iprhoc(1,ith)=ihochp
  587.       iprsu(1,ith) =isup
  588.       iprcha(1,ith)=cha
  589.       iprcnf(1,ith)=mcoord
  590.       iprchl(1,ith)=ipchel
  591. **    write(6,*) ' preconditionnement de ',ipchel
  592.  
  593.       END
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  

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