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

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