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

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