Télécharger la plaquette Cast3M


fr en

Télécharger licham.eso

Retour à la liste

Numérotation des lignes : 

licham

  1. C LICHAM    SOURCE    OF166741  24/10/04    21:15:01     12023          
  2.  
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *     LECTURE D'UN NOUVEAU CHAMELEM SUR LE FICHIER IORES.            *
  6. *                                                                    *
  7. *     Parametres:                                                    *
  8. *                                                                    *
  9. *     IORES   NUMERO DU FICHIER DE LECTURE                           *
  10. *     ITLACC  Pile contenant les nouveaux CHAMELEMs                  *
  11. *     IMAX1   Nombre de CHAMELEMs dans la pile                       *
  12. *     IFORM   Si sauvegarde en format ou non                         *
  13. *                                                                    *
  14. *     APPELE PAR: LIPIL                                              *
  15. *                                                                    *
  16. *     Auteur, date de creation:                                      *
  17. *     Denis ROBERT-MOUGIN, le 29 juin 1989.                          *
  18. *--------------------------------------------------------------------*
  19.       SUBROUTINE LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
  20.  
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCFXDR
  26.  
  27. -INC SMCHAML
  28.  
  29.       SEGMENT,ITLACC
  30.         INTEGER ITLAC(0)
  31.       ENDSEGMENT
  32.       SEGMENT,MTABE1
  33.         INTEGER ITABE1(NM1)
  34.       ENDSEGMENT
  35.       SEGMENT,MTABE2
  36.          INTEGER ITABE2(NM2)
  37.       ENDSEGMENT
  38.       SEGMENT,MTABE4
  39.         CHARACTER*(8) ITABE4(NM4)
  40.       ENDSEGMENT
  41.       SEGMENT,MTABE5
  42.         CHARACTER*(8) ITABE5(NM5)
  43.       ENDSEGMENT
  44.       SEGMENT,MTABE6
  45.         CHARACTER*(8) ITABE6(NM6)
  46.       ENDSEGMENT
  47.  
  48.       INTEGER IDAN(4)
  49.  
  50.       IRETOU=0
  51.  
  52.       NM4=0
  53.       NM6=0
  54.       NM5=0
  55.  
  56. *     Boucle sur les CHAMELEMs contenus dans la pile:
  57.  
  58.       DO 10 IEL=1,IMAX1
  59.  
  60.          MCHELM  = 0
  61.  
  62. *  CREATION ET REMPLISSAGE DU SEGMENT MCHELM
  63.  
  64.          CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
  65.          IF (IRETOU.NE.0) RETURN
  66.  
  67.          N1 = IDAN(1)
  68.          N3LU = IDAN(3)
  69.          IF (N3LU.GT.6) THEN
  70.            write(ioimp,*) 'LICHAM : N3 LU > 6 !'
  71.            call erreur(5)
  72.          ENDIF
  73.          N3 = MAX(N3LU,6)
  74.          L1 = IDAN(4)
  75.  
  76.          SEGINI MCHELM
  77.          IFOCHE = IDAN(2)
  78.  
  79.          CALL LFCDIC(IORES,TITCHE,IRETOU,IFORM)
  80.          IF (IRETOU.NE.0) RETURN
  81.  
  82.          N6 = 3 + N3LU
  83.          NM1 = N1 * N6
  84.          SEGINI,MTABE1
  85.          CALL LFCDIE(IORES,NM1,ITABE1,IRETOU,IFORM)
  86.          IF (IRETOU.NE.0) RETURN
  87.          IF (NIVEAU.GE.4) THEN
  88.             NM5 = N1 * 2
  89.             SEGINI,MTABE5
  90.             CALL LFCDIN(IORES,NM5,ITABE5,IRETOU,IFORM)
  91.             IF (IRETOU.NE.0) RETURN
  92.          ENDIF
  93.          if (niveau.ge.15) then
  94.             nm6=n1
  95.             segini mtabe6
  96.             CALL LFCDIN(IORES,NM6,ITABE6,IRETOU,IFORM)
  97.          endif
  98.  
  99.          DO ISOUEL=1,N1
  100.             ISOU = N6 * (ISOUEL - 1)
  101.             IMACHE(ISOUEL) = ITABE1(ISOU+1)
  102.             N2             = ITABE1(ISOU+3)
  103.             SEGINI MCHAML
  104.             ICHAML(ISOUEL)=MCHAML
  105.             DO IJ=1,N3LU
  106.                INFCHE(ISOUEL,IJ) = ITABE1(ISOU+3+IJ)
  107.             ENDDO
  108. *  Par defaut : support = 1 = aux noeuds
  109.             IF (N3LU.LT.6) THEN
  110.                INFCHE(ISOUEL,6) = 1
  111.             ELSE
  112.                ISUPLU = INFCHE(ISOUEL,6)
  113.                IF (ISUPLU.LT.1 .OR. ISUPLU.GT.9) THEN
  114.                   write(ioimp,*) 'LICHAM : SUPPORT LU inconnu',ISUPLU
  115.                   INFCHE(ISOUEL,6) = 1
  116.                ENDIF
  117.             ENDIF
  118.             IF (INFCHE(ISOUEL,4).EQ.0) INFCHE(ISOUEL,6) = 1
  119.             CONCHE(ISOUEL) = '                        '
  120.             IF (NIVEAU.GE.4) THEN
  121.                CONCHE(ISOUEL)(1:8) = ITABE5(2*ISOUEL-1)
  122.                CONCHE(ISOUEL)(9:16)= ITABE5(2*ISOUEL  )
  123.             ENDIF
  124.             if (niveau.ge.15) then
  125.                conche(isouel)(17:24) =itabe6(isouel)
  126.             endif
  127.          ENDDO
  128.  
  129.          SEGSUP MTABE1
  130.          IF (NIVEAU.GE.4) SEGSUP MTABE5
  131.          if (niveau.ge.15) segsup mtabe6
  132.  
  133. *       BOUCLE SUR LES ZONES ELEMENTAIRES DU CHAMELEM :
  134.  
  135.          DO ISOUEL=1,N1
  136.             MCHAML = ICHAML(ISOUEL)
  137.             N2     = NOMCHE(/2)
  138.             NM2    = N2
  139.             NM4    = N2*2
  140.             SEGINI MTABE2,MTABE4
  141.             CALL LFCDIE(IORES,NM2,ITABE2,IRETOU,IFORM)
  142.             IF (IRETOU.NE.0) RETURN
  143.             CALL LFCDIN(IORES,NM2,NOMCHE,IRETOU,IFORM)
  144.             IF (IRETOU.NE.0) RETURN
  145.             CALL LFCDIN(IORES,NM4,ITABE4,IRETOU,IFORM)
  146.             IF (IRETOU.NE.0) RETURN
  147.  
  148.             DO ICO = 1, N2
  149.                if (iform.ne.2) then
  150.                   WRITE(TYPCHE(ICO),FMT='(2A8)') ITABE4(2*ICO-1),
  151.      &                                           ITABE4(2*ICO)
  152.                else
  153.                   TYPCHE(ICO)(1:8) =ITABE4(2*ICO-1)
  154.                   TYPCHE(ICO)(9:16)=ITABE4(2*ICO  )
  155.                endif
  156.                IF (TYPCHE(ICO).EQ.'POINTEUR MLREEL' )
  157.      &            TYPCHE(ICO)='POINTEURLISTREEL'
  158.                IF (TYPCHE(ICO).EQ.'POINTEUR MEVOLUT' )
  159.      &            TYPCHE(ICO)='POINTEUREVOLUTIO'
  160.             ENDDO
  161.  
  162.             SEGSUP MTABE4
  163.  
  164. *         BOUCLE SUR LES COMPOSANTES :
  165.  
  166.             DO ICO = 1, N2
  167.                IF (ITABE2(ICO).GE.0) THEN
  168. *pas de ielval separe
  169.                   CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
  170.                   IF (IRETOU.NE.0) RETURN
  171.                   N1PTEL = IDAN (1)
  172.                   N1EL   = IDAN (2)
  173.                   N2PTEL = IDAN (3)
  174.                   N2EL   = IDAN (4)
  175.                   L1 = IDAN(1) * IDAN(2)
  176.                   L2 = IDAN(3) * IDAN(4)
  177.                   SEGINI MELVAL
  178.                   IELVAL(ICO) = MELVAL
  179.  
  180. *         LECTURE DU CONTENU DU SEGMENT MELVAL :
  181.  
  182.                   IF (L1.NE.0) THEN
  183.                      CALL LFCDI2(IORES,L1,VELCHE,IRETOU,IFORM)
  184.                      IF (IRETOU.NE.0) RETURN
  185.                   ENDIF
  186.                   IF (L2.NE.0) THEN
  187.                      CALL LFCDIE(IORES,L2,IELCHE,IRETOU,IFORM)
  188.                      IF (IRETOU.NE.0) RETURN
  189.                   ENDIF
  190.                   SEGDES MELVAL
  191.                ELSE
  192. * on va pointer sur la pile des ielval.
  193.                   IELVAL(ICO)=ITABE2(ICO)
  194.                ENDIF
  195.             ENDDO
  196.             SEGSUP MTABE2
  197.  
  198.             SEGDES MCHAML
  199.          ENDDO
  200.  
  201.          DO ISOUEL=1,N1
  202.          ENDDO
  203.  
  204.          SEGDES MCHELM
  205.          ITLAC(**)=MCHELM
  206.  
  207.  10   CONTINUE
  208.  
  209.       RETURN
  210.       END
  211.  
  212.  
  213.  
  214.  

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