Télécharger la plaquette Cast3M


fr en

Télécharger liatta.eso

Retour à la liste

Numérotation des lignes : 

liatta

  1. C LIATTA    SOURCE    CHAT      05/01/13    01:16:50     5004
  2.       SUBROUTINE LIATTA (IORES,ITLACC,IMAX1,IRET,IFORM)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C   BUT        : LECTURE DES MATTAC
  7. C   APPELE PAR : LIPIL
  8. C   APPELLE    : LFCDIM LFCDIE LFCDI2
  9. C   ECRIT PAR FARVACQUE    -REPRIS PAR LENA
  10. C
  11.       DIMENSION ILECBI(1)
  12. -INC SMATTAC
  13. C
  14.       SEGMENT/ ITLACC/(ITLAC(0))
  15.       SEGMENT /ILECB1/(ILECB2(NP))
  16. C
  17. C=======================================================================
  18. C
  19.       DIMENSION ILENA(10),IAUX(1)
  20. C--------------------------------------------------------------------
  21. C     ***************************** MATTAC *****************************
  22.       IRET=0
  23.       IRETOU=0
  24.       DO 150 IEL=1,IMAX1
  25.       CALL LFCDIE (IORES,1    ,ILENA,IRETOU,IFORM)
  26.       IF (IRETOU.NE.0) GO TO 1000
  27.       N=ILENA(1)
  28.       NN=N
  29.       SEGINI MATTAC
  30.       ITLAC(**)=MATTAC
  31.       DO 151 I=1,NN
  32.       CALL LFCDIE (IORES,2    ,ILENA,IRETOU,IFORM)
  33.       IF (IRETOU.NE.0) GO TO 1000
  34.       M=ILENA(1)
  35.       N=ILENA(2)
  36.       SEGINI MSOUMA
  37.       LISATT(I)=MSOUMA
  38.       CALL LFCDIM (IORES,1    ,ILECBI,IRETOU,IFORM)
  39.       WRITE(ITYATT,FMT='(A4)')ILECBI(1)
  40.       IF (IRETOU.NE.0) GO TO 1000
  41.       CALL LFCDIE (IORES,M    ,IPMATK,IRETOU,IFORM)
  42.       IF (IRETOU.NE.0) GO TO 1000
  43.       CALL LFCDIE (IORES,N    ,IATREL,IRETOU,IFORM)
  44.       IF (IRETOU.NE.0) GO TO 1000
  45.       CALL LFCDIE (IORES,1    ,IGEOCH,IRETOU,IFORM)
  46.       IF (IRETOU.NE.0) GO TO 1000
  47.       CALL LFCDIE (IORES,1    ,IAUX,IRETOU,IFORM)
  48.       MPHYCH=IAUX(1)
  49.       IF (IRETOU.NE.0) GO TO 1000
  50. C
  51.       IF (IGEOCH.EQ.0) GO TO 152
  52.       CALL LFCDIE (IORES,5    ,ILENA,IRETOU,IFORM)
  53.       IF (IRETOU.NE.0) GO TO 1000
  54.       NI=ILENA(1)
  55.       NJ=ILENA(2)
  56.       N1=ILENA(3)
  57.       NP=ILENA(4)
  58.       NT=ILENA(5)
  59.       SEGINI MGEOCH
  60.       IGEOCH=MGEOCH
  61.       CALL LFCDIE (IORES,NI   ,INORCH,IRETOU,IFORM)
  62.       IF (IRETOU.NE.0) GO TO 1000
  63.       CALL LFCDI2  (IORES,NJ   ,RJEUCH,IRETOU,IFORM)
  64.       IF (IRETOU.NE.0) GO TO 1000
  65.       CALL LFCDIE (IORES,N1   ,IMAPRO,IRETOU,IFORM)
  66.       IF (IRETOU.NE.0) GO TO 1000
  67.       SEGINI ILECB1
  68.       CALL LFCDIM (IORES,NP   ,ILECB2,IRETOU,IFORM)
  69.       WRITE(MPOPRO,FMT='(18A4)')(ILECB2(IY),IY=1,NP)
  70.       SEGDES ILECB1
  71.       IF (IRETOU.NE.0) GO TO 1000
  72.       CALL LFCDI2  (IORES,NT   ,TAIPRO,IRETOU,IFORM)
  73.       IF (IRETOU.NE.0) GO TO 1000
  74.       SEGDES MGEOCH
  75.   152 CONTINUE
  76. C
  77.       IF (MPHYCH.EQ.0) GO TO 153
  78.       CALL LFCDIE (IORES,3    ,ILENA,IRETOU,IFORM)
  79.       IF (IRETOU.NE.0) GO TO 1000
  80.       NRAI=ILENA(1)
  81.       NA=ILENA(2)
  82.       NF=ILENA(3)
  83.       SEGINI MPHYCH
  84.       IPHYCH=MPHYCH
  85.       CALL LFCDI2  (IORES,NRAI ,RAIPRO,IRETOU,IFORM)
  86.       IF (IRETOU.NE.0) GO TO 1000
  87.       CALL LFCDI2  (IORES,NA   ,AMOPRO,IRETOU,IFORM)
  88.       IF (IRETOU.NE.0) GO TO 1000
  89.       CALL LFCDI2  (IORES,NF   ,FROPRO,IRETOU,IFORM)
  90.       IF (IRETOU.NE.0) GO TO 1000
  91.       SEGDES MPHYCH
  92.   153 CONTINUE
  93. C
  94.       SEGDES MSOUMA
  95.   151 CONTINUE
  96.       SEGDES MATTAC
  97.   150 CONTINUE
  98.  1000 CONTINUE
  99.       IRET=IRETOU
  100.       RETURN
  101. C -------------------------------------------------------
  102.       END
  103.  
  104.  

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