Télécharger la plaquette Cast3M


fr en

Télécharger prgtab.eso

Retour à la liste

Numérotation des lignes : 

prgtab

  1. C PRGTAB    SOURCE    SP204843  23/02/16    21:15:05     11600          
  2.       SUBROUTINE PRGTAB
  3. *---------------------------------------------------------------------
  4. *
  5. *     OPTION TABLE OPERATEUR PROG
  6. *
  7. *     SYNTAXE : voir notice PROG
  8. * 
  9. *--------------------------------------------------------------------
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13.       CHARACTER*8 CTYP,CTYP2
  14.       LOGICAL     LCROI,LABSO
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC SMLREEL
  19. -INC SMTABLE
  20. -INC SMLENTI
  21.  
  22. C     write(6,*) '***PROG, option TABLE' 
  23.  
  24. C---------------------------------
  25. C     LECTURE DE LA TABLE
  26. C---------------------------------
  27.       CALL LIROBJ('TABLE   ',ITAB1,1,IRET)
  28.       IF (IERR.NE.0) RETURN
  29.  
  30. C---------------------------------
  31. C     LISTE INDICES ENTIERS DE LA TABLE
  32. C---------------------------------
  33.       MTABLE = ITAB1
  34.       SEGACT, MTABLE
  35.       JG = MLOTAB
  36.       SEGINI, MLENTI, MLENT1
  37.       DO 10 I1=1,MLOTAB
  38.         IF (MTABTI(I1).EQ.'ENTIER  ') THEN
  39.           LECT(I1) = MTABII(I1)
  40.           CTYP     = MTABTV(I1)
  41.         ENDIF
  42.  10   CONTINUE
  43.  
  44. c     write(6,*) 'MLENTI,MLENT1,CTYP=',MLENTI,MLENT1,CTYP
  45.  
  46. C---------------------------------
  47. C     VERIFICATION TYPE OBJET EN INDICE
  48. C---------------------------------
  49.       IF (CTYP.NE.'FLOTTANT'.AND.CTYP.NE.'ENTIER  ') THEN
  50.         MOTERR(1:8) = 'FLOTTANT'
  51.         CALL ERREUR(37)
  52.         RETURN
  53.       ENDIF
  54.       CTYP2 = 'ENTIER  '
  55.       IF (CTYP.EQ.'ENTIER  ') CTYP2 = 'FLOTTANT'
  56.  
  57. C---------------------------------
  58. C     RANGEMENT PAR ORDRE CROISSANT INDICES ENTIER DE LA TABLE
  59. C---------------------------------
  60.       LCROI = .true.
  61.       LABSO = .false.
  62.       CALL ORDON2(MLENTI,LCROI,LABSO,MLENT1)
  63.       IF (IERR.NE.0) RETURN
  64.       SEGACT,MLENT1
  65.  
  66. c     write(6,*) 'MLENT1.lect(/1)=',MLENT1.LECT(/1)
  67.  
  68. C---------------------------------
  69. C     DEFINITION DU LISTREEL
  70. C---------------------------------
  71.  
  72.       JG = MLOTAB
  73.       SEGINI, MLREEL
  74.       NRE1 = 0
  75.       DO 1 IND1=1,MLOTAB
  76.         IND2  = MLENT1.LECT(IND1)
  77.         IF (MTABTI(IND2)(1:8).NE.'ENTIER  ') GOTO 1
  78.         IF (MTABTV(IND2).NE.CTYP.AND.MTABTV(IND2).NE.CTYP2) THEN
  79.           MOTERR(1:8) = CTYP
  80.           CALL ERREUR(39)
  81.           RETURN
  82.         ENDIF
  83.         NRE1 = NRE1+1
  84.         IF (MTABTV(IND2).EQ.'ENTIER  ') THEN
  85.           PROG(NRE1) = MTABIV(IND2)
  86.         ELSE IF(MTABTV(IND2).EQ.'FLOTTANT') THEN
  87.           PROG(NRE1) = RMTABV(IND2)
  88.         ELSE
  89.           CALL ERREUR(5)
  90.           RETURN
  91.         ENDIF
  92.  1    CONTINUE
  93.  
  94. C     Ecriture du resultat 
  95.       JG = NRE1
  96.       SEGADJ, MLREEL
  97.       CALL ECROBJ('LISTREEL',MLREEL)
  98.  
  99.       RETURN
  100.       END
  101.  
  102.  
  103.  
  104.  

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