Télécharger la plaquette Cast3M


fr en

Télécharger lfdien.eso

Retour à la liste

Numérotation des lignes : 

lfdien

  1. C LFDIEN    SOURCE    PV        21/07/07    21:15:01     11062          
  2.       SUBROUTINE LFDIEN(NBAND,SEGTAB,iretou,IFORM)
  3.  
  4.       IMPLICIT INTEGER(I-N)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC CCFXDR
  9.  
  10.       SEGMENT SEGTAB
  11.         CHARACTER*(LCHAWR) ITAB(NM)
  12.       ENDSEGMENT
  13.  
  14. C     CFORMAT : Format pour lire en 'FORMAT' dans le fichier
  15.       CHARACTER*12 CFORMAT
  16.  
  17.       LCHAWR=SEGTAB.ITAB(/1)
  18.       NM    =SEGTAB.ITAB(/2)
  19.  
  20.       IF (NM.EQ.0)RETURN
  21.  
  22. C     Calcul du format des chaines
  23.       CFORMAT='('
  24.       IF(IONIVE .LT. 23)THEN
  25.         CFORMAT='(16(1X,A4))'
  26.         JCH=11
  27.  
  28.       ELSE
  29.         ICH=2
  30.         IF    (NM.GT.0  .AND. NM.LE.9  )THEN
  31.           JCH=ICH
  32.           WRITE(CFORMAT(ICH:JCH) ,FMT='(I1)') NM
  33.         ELSEIF(NM.GT.9  .AND. NM.LE.99 )THEN
  34.           ICH=2
  35.           JCH=ICH+1
  36.           WRITE(CFORMAT(ICH:JCH) ,FMT='(I2)') NM
  37.         ELSEIF(NM.GT.99 .AND. NM.LE.999)THEN
  38.           ICH=3
  39.           JCH=ICH+2
  40.           WRITE(CFORMAT(ICH:JCH) ,FMT='(I3)') NM
  41.         ELSE
  42.           PRINT*,'ECDIEN.ESO-Valeur de NM:',NM
  43.           CALL ERREUR(5)
  44.         ENDIF
  45.         ICH=ICH+1
  46.         CFORMAT(ICH:ICH+4)='(1X,A'
  47.  
  48.         ICH=ICH+5
  49.         IF    (LCHAWR.GT.0  .AND. LCHAWR.LE.9  )THEN
  50.           JCH=ICH
  51.           WRITE(CFORMAT(ICH:JCH) ,FMT='(I1)') LCHAWR
  52.  
  53.         ELSEIF(LCHAWR.GT.9  .AND. LCHAWR.LE.99 )THEN
  54.           JCH=ICH+1
  55.           WRITE(CFORMAT(ICH:JCH) ,FMT='(I2)') LCHAWR
  56.           CFORMAT(ICH+2:ICH+2)=')'
  57.  
  58.         ELSEIF(LCHAWR.GT.99 .AND. LCHAWR.LE.999)THEN
  59.           JCH=ICH+2
  60.           WRITE(CFORMAT(ICH:JCH),FMT='(I3)') LCHAWR
  61.           CFORMAT(ICH+3:ICH+3)=')'
  62.  
  63.         ELSE
  64.           PRINT*,'ECDIEN.ESO-Valeur de LCHAWR:',LCHAWR
  65.           CALL ERREUR(5)
  66.         ENDIF
  67.  
  68.         ICH=JCH+1
  69.         JCH=ICH+1
  70.         CFORMAT(ICH:JCH)='))'
  71.       ENDIF
  72.       iretou=0
  73.       IF (IFORM.EQ.1)read(NBAND,FMT=CFORMAT,err=1000)(ITAB(I),I=1,NM)
  74.       IF (IFORM.EQ.0)read(NBAND,err=1000)            (ITAB(I),I=1,NM)
  75.       if (iform.eq.2)then 
  76.        ios=IXDRSTRING(ixdrr,itab(1)(1:LCHAWR*NM))
  77.        iretou=ios
  78.       endif
  79.  
  80.       RETURN
  81.  1000 continue
  82.       iretou=1
  83.       return
  84.       END
  85.  
  86.  
  87.  

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