Télécharger la plaquette Cast3M


fr en

Télécharger ecnuag.eso

Retour à la liste

Numérotation des lignes : 

ecnuag

  1. C ECNUAG    SOURCE    CB215821  15/05/04    21:15:03     8516
  2.       SUBROUTINE ECNUAG(INUA)
  3. C----------------------------------------------------------------------
  4. C             IMPRESSION D'UN OBJET DE TYPE  NUAGE
  5. C----------------------------------------------------------------------
  6.       IMPLICIT INTEGER(I-N)
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMNUAGE
  10. -INC CCNOYAU
  11.       CHARACTER*(8) ITYPE,INOM,IWR(5)
  12.       CHARACTER*4 FAUX,VRAI
  13.       CHARACTER*8 IWRI
  14.       REAL*8 XRR(5)
  15.       INTEGER INRE(5)
  16.       LOGICAL BRET
  17.       MNUAGE=INUA
  18.       SEGACT MNUAGE
  19.       NVAR=NUAPOI(/1)
  20.  
  21.       IF (NVAR .EQ. 0) THEN
  22.         NBCOUP = 0
  23.       ELSE
  24.         ITYPE=NUATYP(1)
  25.         IF( ITYPE.EQ.'FLOTTANT') THEN
  26.           NUAVFL=NUAPOI(1)
  27.           SEGACT NUAVFL
  28.           NBCOUP=NUAFLO(/1)
  29.         ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  30.           NUAVLO=NUAPOI(1)
  31.           SEGACT NUAVLO
  32.           NBCOUP=NUALOG(/1)
  33.         ELSEIF(ITYPE.EQ.'MOT     ') THEN
  34.           NUAVMO=NUAPOI(1)
  35.           SEGACT NUAVMO
  36.           NBCOUP=NUAMOT(/2)
  37.         ELSE
  38.           NUAVIN=NUAPOI(1)
  39.           SEGACT NUAVIN
  40.           NBCOUP=NUAINT(/1)
  41.         ENDIF
  42.       ENDIF
  43.  
  44.       INTERR(1) = MNUAGE
  45.       INTERR(2) = NVAR
  46.       INTERR(3)=NBCOUP
  47.       CALL ERREUR(-287)
  48.  
  49.       IF (NVAR .EQ. 0) THEN
  50.         SEGDES MNUAGE
  51.         RETURN
  52.       ENDIF
  53.  
  54.   513 FORMAT(5(2X,I8))
  55.   514 FORMAT(5(1X,1PE9.2))
  56.   515 FORMAT(5(2X,A8))
  57.  
  58.       DO 1 IV = 1,NVAR
  59.       MOTERR(1:8) = NUANOM(IV)
  60.       MOTERR(9:16)= NUATYP(IV)
  61.       INTERR(1)   = IV
  62.       CALL ERREUR(-288)
  63.  
  64.       ITYPE=NUATYP(IV)
  65.       IF( ITYPE.EQ.'FLOTTANT') THEN
  66.         NUAVFL=NUAPOI(IV)
  67.         SEGACT NUAVFL
  68.         NBCOUP=NUAFLO(/1)
  69.         NN = 0
  70.         DO 12  K = 1,NBCOUP,5
  71.         NI = MIN ( 5 , NBCOUP - NN)
  72.         DO 13 NW = 1, NI
  73.         XRR(NW)=NUAFLO(K-1+NW)
  74.    13   CONTINUE
  75.         WRITE(IOIMP,514) (XRR(IK),IK=1,NI)
  76.         NN = NN + 5
  77.    12   CONTINUE
  78.         SEGDES NUAVFL
  79.  
  80.       ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN
  81.         NUAVLO=NUAPOI(IV)
  82.         SEGACT NUAVLO
  83.         NBCOUP=NUALOG(/1)
  84.         NN = 0
  85.         DO 121  K = 1,NBCOUP,5
  86.         NI = MIN ( 5 , NBCOUP - NN)
  87.         DO 131 NW = 1, NI
  88.         IWR(NW) = 'FAUX'
  89.         IF( NUALOG(K-1+NW))  IWR(NW) ='VRAI'
  90.   131   CONTINUE
  91.         WRITE(IOIMP,515) (IWR(IK),IK=1,NI)
  92.         NN = NN + 5
  93.   121   CONTINUE
  94.         SEGDES NUAVLO
  95.  
  96.       ELSEIF(ITYPE.EQ.'MOT     ') THEN
  97.         NUAVMO=NUAPOI(IV)
  98.         SEGACT NUAVMO
  99.         NBCOUP=NUAMOT(/2)
  100.         NN = 0
  101.         DO 122  K = 1,NBCOUP,5
  102.         NI = MIN ( 5 , NBCOUP - NN)
  103.         DO 132 NW = 1, NI
  104.         IWR(NW) =  NUAMOT(K-1+NW)
  105.   132   CONTINUE
  106.         WRITE(IOIMP,515) (IWR(IK),IK=1,NI)
  107.         NN = NN + 5
  108.   122   CONTINUE
  109.         SEGDES NUAVMO
  110.  
  111.       ELSE
  112.         NUAVIN=NUAPOI(IV)
  113.         SEGACT NUAVIN
  114.         NBCOUP=NUAINT(/1)
  115.         NN = 0
  116.         DO 123  K = 1,NBCOUP,5
  117.         NI = MIN ( 5 , NBCOUP - NN)
  118.         DO 133 NW = 1, NI
  119.         INRE(NW) =  NUAINT(K-1+NW)
  120.   133   CONTINUE
  121.         WRITE(IOIMP,513) (INRE(IK),IK=1,NI)
  122.         NN = NN + 5
  123.   123   CONTINUE
  124.         SEGDES NUAVIN
  125.       ENDIF
  126.    1  CONTINUE
  127.  
  128.       SEGDES MNUAGE
  129.       RETURN
  130.       END
  131.  
  132.  
  133.  

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