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/03/04    21:15:02     12169          
  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. -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(5)
  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.          idan(5)=0
  64.          if (niveau.le.26) CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
  65.          if (niveau.gt.26) CALL LFCDIE(IORES,5,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.          mclcnf=idan(5)
  79.          IFOCHE = IDAN(2)
  80.  
  81.          CALL LFCDIC(IORES,TITCHE,IRETOU,IFORM)
  82.          IF (IRETOU.NE.0) RETURN
  83.  
  84.          N6 = 3 + N3LU
  85.          NM1 = N1 * N6
  86.          SEGINI,MTABE1
  87.          CALL LFCDIE(IORES,NM1,ITABE1,IRETOU,IFORM)
  88.          IF (IRETOU.NE.0) RETURN
  89.          IF (NIVEAU.GE.4) THEN
  90.             NM5 = N1 * 2
  91.             SEGINI,MTABE5
  92.             CALL LFCDIN(IORES,NM5,ITABE5,IRETOU,IFORM)
  93.             IF (IRETOU.NE.0) RETURN
  94.          ENDIF
  95.          if (niveau.ge.15) then
  96.             nm6=n1
  97.             segini mtabe6
  98.             CALL LFCDIN(IORES,NM6,ITABE6,IRETOU,IFORM)
  99.          endif
  100.  
  101.          DO ISOUEL=1,N1
  102.             ISOU = N6 * (ISOUEL - 1)
  103.             IMACHE(ISOUEL) = ITABE1(ISOU+1)
  104.             N2             = ITABE1(ISOU+3)
  105.             SEGINI MCHAML
  106.             ICHAML(ISOUEL)=MCHAML
  107.             DO IJ=1,N3LU
  108.                INFCHE(ISOUEL,IJ) = ITABE1(ISOU+3+IJ)
  109.             ENDDO
  110. *  Par defaut : support = 1 = aux noeuds
  111.             IF (N3LU.LT.6) THEN
  112.                INFCHE(ISOUEL,6) = 1
  113.             ELSE
  114.                ISUPLU = INFCHE(ISOUEL,6)
  115.                IF (ISUPLU.LT.1 .OR. ISUPLU.GT.9) THEN
  116.                   write(ioimp,*) 'LICHAM : SUPPORT LU inconnu',ISUPLU
  117.                   INFCHE(ISOUEL,6) = 1
  118.                ENDIF
  119.             ENDIF
  120.             IF (INFCHE(ISOUEL,4).EQ.0) INFCHE(ISOUEL,6) = 1
  121.             CONCHE(ISOUEL) = '                        '
  122.             IF (NIVEAU.GE.4) THEN
  123.                CONCHE(ISOUEL)(1:8) = ITABE5(2*ISOUEL-1)
  124.                CONCHE(ISOUEL)(9:16)= ITABE5(2*ISOUEL  )
  125.             ENDIF
  126.             if (niveau.ge.15) then
  127.                conche(isouel)(17:24) =itabe6(isouel)
  128.             endif
  129.          ENDDO
  130.  
  131.          SEGSUP MTABE1
  132.          IF (NIVEAU.GE.4) SEGSUP MTABE5
  133.          if (niveau.ge.15) segsup mtabe6
  134.  
  135. *       BOUCLE SUR LES ZONES ELEMENTAIRES DU CHAMELEM :
  136.  
  137.          DO ISOUEL=1,N1
  138.             MCHAML = ICHAML(ISOUEL)
  139.             N2     = NOMCHE(/2)
  140.             NM2    = N2
  141.             NM4    = N2*2
  142.             SEGINI MTABE2,MTABE4
  143.             CALL LFCDIE(IORES,NM2,ITABE2,IRETOU,IFORM)
  144.             IF (IRETOU.NE.0) RETURN
  145.             CALL LFCDIN(IORES,NM2,NOMCHE,IRETOU,IFORM)
  146.             IF (IRETOU.NE.0) RETURN
  147.             CALL LFCDIN(IORES,NM4,ITABE4,IRETOU,IFORM)
  148.             IF (IRETOU.NE.0) RETURN
  149.  
  150.             DO ICO = 1, N2
  151.                if (iform.ne.2) then
  152.                   WRITE(TYPCHE(ICO),FMT='(2A8)') ITABE4(2*ICO-1),
  153.      &                                           ITABE4(2*ICO)
  154.                else
  155.                   TYPCHE(ICO)(1:8) =ITABE4(2*ICO-1)
  156.                   TYPCHE(ICO)(9:16)=ITABE4(2*ICO  )
  157.                endif
  158.                IF (TYPCHE(ICO).EQ.'POINTEUR MLREEL' )
  159.      &            TYPCHE(ICO)='POINTEURLISTREEL'
  160.                IF (TYPCHE(ICO).EQ.'POINTEUR MEVOLUT' )
  161.      &            TYPCHE(ICO)='POINTEUREVOLUTIO'
  162.             ENDDO
  163.  
  164.             SEGSUP MTABE4
  165.  
  166. *         BOUCLE SUR LES COMPOSANTES :
  167.  
  168.             DO ICO = 1, N2
  169.                IF (ITABE2(ICO).GE.0) THEN
  170. *pas de ielval separe
  171.                   CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
  172.                   IF (IRETOU.NE.0) RETURN
  173.                   N1PTEL = IDAN (1)
  174.                   N1EL   = IDAN (2)
  175.                   N2PTEL = IDAN (3)
  176.                   N2EL   = IDAN (4)
  177.                   L1 = IDAN(1) * IDAN(2)
  178.                   L2 = IDAN(3) * IDAN(4)
  179.                   SEGINI MELVAL
  180.                   IELVAL(ICO) = MELVAL
  181.  
  182. *         LECTURE DU CONTENU DU SEGMENT MELVAL :
  183.  
  184.                   IF (L1.NE.0) THEN
  185.                      CALL LFCDI2(IORES,L1,VELCHE,IRETOU,IFORM)
  186.                      IF (IRETOU.NE.0) RETURN
  187.                   ENDIF
  188.                   IF (L2.NE.0) THEN
  189.                      CALL LFCDIE(IORES,L2,IELCHE,IRETOU,IFORM)
  190.                      IF (IRETOU.NE.0) RETURN
  191.                   ENDIF
  192.                   SEGDES MELVAL
  193.                ELSE
  194. * on va pointer sur la pile des ielval.
  195.                   IELVAL(ICO)=ITABE2(ICO)
  196.                ENDIF
  197.             ENDDO
  198.             SEGSUP MTABE2
  199.  
  200.             SEGDES MCHAML
  201.          ENDDO
  202.  
  203.          DO ISOUEL=1,N1
  204.          ENDDO
  205.  
  206.          SEGDES MCHELM
  207.          ITLAC(**)=MCHELM
  208.  
  209.  10   CONTINUE
  210.  
  211.       RETURN
  212.       END
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  

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