Télécharger la plaquette Cast3M


fr en

Télécharger limtik.eso

Retour à la liste

Numérotation des lignes : 

limtik

  1. C LIMTIK    SOURCE    PV        20/09/26    21:18:39     10724          
  2.       SUBROUTINE LIMTIK(IFRES,ITLACC,IMAX1,IRET,IFORM)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C***********************************************************************
  6. C NOM         : LIMTAK
  7. C DESCRIPTION : Lecture d'un objet de type MATRIK sur le
  8. C               fichier IFRES
  9. C               (appelé par lipil.eso)
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES (E/S)    : LFCDIE (lecture d'un tableau d'entiers)
  16. C                    LFCDI2 (lecture d'un tableau de REAL*8)
  17. C                    LFCDIM (lecture d'un tableau de CHARACTER*4)
  18. C***********************************************************************
  19. C SYNTAXE GIBIANE    : RESTITUER
  20. C ENTREES            : IFRES, numéro du fichier de lecture
  21. C                      IMAX1, nombre d'objets MATRIK à lire
  22. C                      IFORM, le fichier à lire est formaté ou
  23. C                             non.
  24. C ENTREES/SORTIES    : ITLACC, la pile des objets MATRIK à
  25. C                      laquelle on ajoute les objets lus
  26. C CODE RETOUR (IRET) : 0, ok
  27. C                      1, erreur dans la lecture de l'objet
  28. C***********************************************************************
  29. C VERSION    : v1, 15/07/98, version initiale
  30. C HISTORIQUE : v1, 15/07/98, création
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  42. -INC TMCOLAC
  43.       SEGMENT/ITBBM1/( ITABM1(NM))
  44. C
  45.       INTEGER NDTAB
  46.       INTEGER IEL,I,J,K,L
  47.       INTEGER ILENA(11)
  48. C======================================================================
  49. *
  50. * Executable statements
  51. *
  52.       IRET=0
  53.       IRETOU=0
  54.       NM=0
  55.       SEGINI ITBBM1
  56.       DO 1 IEL=1,IMAX1
  57. C     Restitution du chapeau
  58. C.... On initialise des piles d'objets non connus de CASTEM
  59. C     MINC, PMORS, IZA, IDMAT
  60.          SEGINI ITLAC1
  61.          SEGINI ITLAC2
  62.          SEGINI ITLAC3
  63.          SEGINI ITLAC4
  64.          MATRIK=0
  65. C       Dimensions
  66.          NDTAB=4
  67.          CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  68.          IF (IRETOU.NE.0) GOTO 9999
  69.          NRIGE =ILENA(1)
  70.          NMATRI=ILENA(2)
  71.          NKID  =ILENA(3)
  72.          NKMT  =ILENA(4)
  73.          SEGINI MATRIK
  74. C       Rigidités élémentaires
  75.          NDTAB = NRIGE * NMATRI
  76.          CALL LFCDIE(IFRES,NDTAB,IRIGEL,IRETOU,IFORM)
  77.          IF (IRETOU.NE.0) GOTO 9999
  78. C       Matrice assemblée
  79.          NDTAB=11
  80.          CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  81.          IF (IRETOU.NE.0) GOTO 9999
  82.          KSYM  =ILENA( 1)
  83.          KMINC =ILENA( 2)
  84.          KMINCP=ILENA( 3)
  85.          KMINCD=ILENA( 4)
  86.          KIZM  =ILENA( 5)
  87.          KISPGT=ILENA( 6)
  88.          KISPGP=ILENA( 7)
  89.          KISPGD=ILENA( 8)
  90.          KNTTT =ILENA( 9)
  91.          KNTTP =ILENA(10)
  92.          KNTTD =ILENA(11)
  93.          NDTAB=NKID
  94.          CALL LFCDIE(IFRES,NDTAB,KIDMAT,IRETOU,IFORM)
  95.          IF (IRETOU.NE.0) GOTO 9999
  96.          NDTAB=NKMT
  97.          CALL LFCDIE(IFRES,NDTAB,KKMMT,IRETOU,IFORM)
  98.          IF (IRETOU.NE.0) GOTO 9999
  99. C     Restitution des IMATRI
  100.          DO 11 I=1,NMATRI
  101.             IMATRI=IRIGEL(4,I)
  102.             IF (IMATRI.NE.0) THEN
  103.                NDTAB=2
  104.                CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  105.                IF (IRETOU.NE.0) GOTO 9999
  106.                NBSOUS=ILENA(1)
  107.                NBME  =ILENA(2)
  108.                SEGINI IMATRI
  109.                NM=4*NBME
  110.                SEGADJ ITBBM1
  111.                CALL LFCDIM(IFRES,NM,ITABM1,IRETOU,IFORM)
  112.                DO 111 J=1,NBME
  113.                   J4=(4*J)-3
  114.                   WRITE(LISPRI(J),FMT='(2A4)') ITABM1(J4),ITABM1(J4+1)
  115.                   WRITE(LISDUA(J),FMT='(2A4)') ITABM1(J4+2),ITABM1(J4+3)
  116.  111           CONTINUE
  117.                NDTAB=NBSOUS*NBME
  118.                CALL LFCDIE(IFRES,NDTAB,LIZAFM,IRETOU,IFORM)
  119.                IF (IRETOU.NE.0) GOTO 9999
  120.                NDTAB=2
  121.                CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  122.                IF (IRETOU.NE.0) GOTO 9999
  123.                KSPGP=ILENA(1)
  124.                KSPGD=ILENA(2)
  125. C     Restitution des IZAFM
  126.                DO 112 K=1,NBME
  127.                   DO 1121 L=1,NBSOUS
  128.                      IZAFM=LIZAFM(L,K)
  129.                      IF (IZAFM.NE.0) THEN
  130.                         NDTAB=3
  131.                         CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  132.                         IF (IRETOU.NE.0) GOTO 9999
  133.                         NBEL=ILENA(1)
  134.                         NP  =ILENA(2)
  135.                         MP  =ILENA(3)
  136.                         SEGINI IZAFM
  137.                         NDTAB=NBEL*NP*MP
  138.                         CALL LFCDI2(IFRES,NDTAB,AM,IRETOU,IFORM)
  139.                         IF (IRETOU.NE.0) GOTO 9999
  140.                         SEGDES IZAFM
  141.                         LIZAFM(L,K)=IZAFM
  142.                      ENDIF
  143.  1121             CONTINUE
  144.  112           CONTINUE
  145.                SEGDES IMATRI
  146.                IRIGEL(4,I)=IMATRI
  147.             ENDIF
  148.  11      CONTINUE
  149. C     Restitution des MINC
  150.          NDTAB=4
  151.          CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  152.          IF (IRETOU.NE.0) GOTO 9999
  153.          NBMINC=ILENA(1)
  154.          JMINC =ILENA(2)
  155.          JMINCP=ILENA(3)
  156.          JMINCD=ILENA(4)
  157.          DO 12 I=1,NBMINC
  158.             NDTAB=2
  159.             CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  160.             IF (IRETOU.NE.0) GOTO 9999
  161.             NPT=ILENA(1)
  162.             NBI=ILENA(2)
  163.             SEGINI MINC
  164.             NM=2*NBI
  165.             SEGADJ ITBBM1
  166.             CALL LFCDIM(IFRES,NM,ITABM1,IRETOU,IFORM)
  167.             IF (IRETOU.NE.0) GOTO 9999
  168.             DO 121 J=1,NBI
  169.                J2=(2*J)-1
  170.                WRITE(LISINC(J),FMT='(2A4)') ITABM1(J2),ITABM1(J2+1)
  171.  121        CONTINUE
  172.             NDTAB=NPT+1
  173.             CALL LFCDIE(IFRES,NDTAB,NPOS,IRETOU,IFORM)
  174.             IF (IRETOU.NE.0) GOTO 9999
  175.             NDTAB=NPT*(NBI+1)
  176.             CALL LFCDIE(IFRES,NDTAB,MPOS,IRETOU,IFORM)
  177.             IF (IRETOU.NE.0) GOTO 9999
  178.             SEGDES MINC
  179.             ITLAC1.ITLAC(**)=MINC
  180.  12      CONTINUE
  181.          IF (JMINC.NE.0)  KMINC =ITLAC1.ITLAC(JMINC)
  182.          IF (JMINCP.NE.0) KMINCP=ITLAC1.ITLAC(JMINCP)
  183.          IF (JMINCD.NE.0) KMINCD=ITLAC1.ITLAC(JMINCD)
  184. C     Restitution des PMORS
  185.          NDTAB=3
  186.          CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  187.          IF (IRETOU.NE.0) GOTO 9999
  188.          NBMORS=ILENA(1)
  189.          JMORS =ILENA(2)
  190.          JMRST =ILENA(3)
  191.          DO 13 I=1,NBMORS
  192.             NDTAB=2
  193.             CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  194.             IF (IRETOU.NE.0) GOTO 9999
  195.             NTT=ILENA(1)
  196.             NJA=ILENA(2)
  197.             SEGINI PMORS
  198.             NDTAB=NTT+1
  199.             CALL LFCDIE(IFRES,NDTAB,IA,IRETOU,IFORM)
  200.             IF (IRETOU.NE.0) GOTO 9999
  201.             NDTAB=NJA
  202.             CALL LFCDIE(IFRES,NDTAB,JA,IRETOU,IFORM)
  203.             IF (IRETOU.NE.0) GOTO 9999
  204.             SEGDES PMORS
  205.             ITLAC2.ITLAC(**)=PMORS
  206.  13      CONTINUE
  207.          IF (JMORS.NE.0) KIDMAT(4)=ITLAC2.ITLAC(JMORS)
  208.          IF (JMRST.NE.0) KIDMAT(6)=ITLAC2.ITLAC(JMRST)
  209. C     Restitution des IDMAT (faite avant les IZA
  210. C     car IDIAG pointe sur un IZA)
  211.          NDTAB=3
  212.          CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  213.          IF (IRETOU.NE.0) GOTO 9999
  214.          NBIDMA=ILENA(1)
  215.          JDMATP=ILENA(2)
  216.          JDMATD=ILENA(3)
  217.          DO 15 I=1,NBIDMA
  218.             NDTAB=4
  219.             CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  220.             IF (IRETOU.NE.0) GOTO 9999
  221.             NTT =ILENA(1)
  222.             NPT =ILENA(2)
  223.             NBLK=ILENA(3)
  224.             SEGINI IDMAT
  225.             IDIAG=ILENA(4)
  226.             NDTAB=NTT
  227.             CALL LFCDIE(IFRES,NDTAB,KZA,IRETOU,IFORM)
  228.             IF (IRETOU.NE.0) GOTO 9999
  229.             NDTAB=2*NTT
  230.             CALL LFCDIE(IFRES,NDTAB,NUIA,IRETOU,IFORM)
  231.             IF (IRETOU.NE.0) GOTO 9999
  232.             NDTAB=NPT
  233.             CALL LFCDIE(IFRES,NDTAB,NUAN,IRETOU,IFORM)
  234.             IF (IRETOU.NE.0) GOTO 9999
  235.             NDTAB=NPT
  236.             CALL LFCDIE(IFRES,NDTAB,NUNA,IRETOU,IFORM)
  237.             IF (IRETOU.NE.0) GOTO 9999
  238.             NDTAB=NBLK
  239.             CALL LFCDIE(IFRES,NDTAB,IDESCL,IRETOU,IFORM)
  240.             IF (IRETOU.NE.0) GOTO 9999
  241.             NDTAB=NBLK
  242.             CALL LFCDIE(IFRES,NDTAB,IDESCU,IRETOU,IFORM)
  243.             IF (IRETOU.NE.0) GOTO 9999
  244.             NDTAB=NBLK+1
  245.             CALL LFCDIE(IFRES,NDTAB,NLDBLK,IRETOU,IFORM)
  246.             IF (IRETOU.NE.0) GOTO 9999
  247.             SEGDES IDMAT
  248.             ITLAC4.ITLAC(**)=IDMAT
  249.  15      CONTINUE
  250.          IF (JDMATP.NE.0) KIDMAT(1)=ITLAC4.ITLAC(JDMATP)
  251.          IF (JDMATD.NE.0) KIDMAT(2)=ITLAC4.ITLAC(JDMATD)
  252. C     Restitution des IZA
  253.          NDTAB=8
  254.          CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  255.          IF (IRETOU.NE.0) GOTO 9999
  256.          NBIZA =ILENA( 1)
  257.          JS2B  =ILENA( 2)
  258.          JISA  =ILENA( 3)
  259.          JIST  =ILENA( 4)
  260.          JZDU  =ILENA( 5)
  261.          JZDP  =ILENA( 6)
  262.          JZFU  =ILENA( 7)
  263.          JZFP  =ILENA( 8)
  264.          DO 14 I=1,NBIZA
  265.             NDTAB=1
  266.             CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM)
  267.             IF (IRETOU.NE.0) GOTO 9999
  268.             NBVA=ILENA(1)
  269.             SEGINI IZA
  270.             NDTAB=NBVA
  271.             CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM)
  272.             IF (IRETOU.NE.0) GOTO 9999
  273.             SEGDES IZA
  274.             ITLAC3.ITLAC(**)=IZA
  275.  14      CONTINUE
  276.          IF (JS2B.NE.0) KIDMAT(3)=ITLAC3.ITLAC(JS2B)
  277.          IF (JISA.NE.0) KIDMAT(5)=ITLAC3.ITLAC(JISA)
  278.          IF (JIST.NE.0) KIDMAT(7)=ITLAC3.ITLAC(JIST)
  279.          IF (JZDU.NE.0) KKMMT (4)=ITLAC3.ITLAC(JZDU)
  280.          IF (JZDP.NE.0) KKMMT (5)=ITLAC3.ITLAC(JZDP)
  281.          IF (JZFU.NE.0) KKMMT (6)=ITLAC3.ITLAC(JZFU)
  282.          IF (JZFP.NE.0) KKMMT (7)=ITLAC3.ITLAC(JZFP)
  283. C    Restauration des pointeurs des IZA dans IDMAT
  284.          DO 17 I=1,NBIDMA
  285.             IDMAT=ITLAC4.ITLAC(I)
  286.             SEGACT IDMAT*MOD
  287.             NBLK=IDESCL(/1)
  288. C       IDIAG
  289.             IV3=IDIAG
  290.             IF (IV3.NE.0) IDIAG=ITLAC3.ITLAC(IV3)
  291. C       IDESCL
  292.             DO 171 J=1,NBLK
  293.                IV3=IDESCL(J)
  294.                IF (IV3.NE.0) IDESCL(J)=ITLAC3.ITLAC(IV3)
  295.  171        CONTINUE
  296. C       IDESCU
  297.             DO 172 J=1,NBLK
  298.                IV3=IDESCU(J)
  299.                IF (IV3.NE.0) IDESCU(J)=ITLAC3.ITLAC(IV3)
  300.  172        CONTINUE
  301.             SEGDES IDMAT
  302.  17      CONTINUE
  303.          SEGDES MATRIK
  304.          ITLAC(**)=MATRIK
  305.          SEGSUP ITLAC4
  306.          SEGSUP ITLAC3
  307.          SEGSUP ITLAC2
  308.          SEGSUP ITLAC1
  309.  1    CONTINUE
  310.       SEGSUP ITBBM1
  311. *
  312. * Normal termination
  313. *
  314.       IRET=0
  315.       RETURN
  316. *
  317. * Format handling
  318. *
  319. *
  320. * Error handling
  321. *
  322.  9999 CONTINUE
  323.       WRITE(IOIMP,*) 'An error was detected in subroutine limtik'
  324.       IRET=1
  325.       RETURN
  326. *
  327. * End of subroutine LIMTIK
  328. *
  329.       END
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  

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