Télécharger la plaquette Cast3M


fr en

Télécharger wrnuag.eso

Retour à la liste

Numérotation des lignes : 

wrnuag

  1. C WRNUAG    SOURCE    PV        05/04/13    21:17:06     5073
  2.       SUBROUTINE WRNUAG (IOSAU,ITLACC,IMAX1,IFORM,IDEB)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C      BUT     : ECRITURE DES NUAGES SUR LE FICHIER IOSAU
  7. C      APPELE PAR WRPIL
  8. C      APPELLE :  ECDIFE ECDIFM ECDIFR
  9. C=======================================================================
  10. C=======================================================================
  11. -INC SMNUAGE
  12. -INC CCFXDR
  13.       SEGMENT/ITLACC/(ITLAC(0)),ITLAC1.ITLACC,ITLAC2.ITLACC,
  14.      1 ITLAC3.ITLACC,ITLAC4.ITLACC,ITLAC5.ITLACC,ITLAC6.ITLACC
  15. C=======================================================================
  16. C=======================================================================
  17.       SEGMENT/ITBBE1/( ITABE1(NN))
  18.       SEGMENT/ITBBM1/( ITABM1(NM))
  19.       segment itbbc1
  20.        character*4 itabc1(nm)
  21.       endsegment
  22.       CHARACTER*8 CTYP
  23.       DIMENSION ILENA(2)
  24. C
  25. C======================================================================
  26. C
  27. C     ************************  NUAGE **************************
  28.       DO 1101 IEL=IDEB,IMAX1
  29.          MNUAGE=ITLAC(IEL)
  30.          IF (MNUAGE.EQ.0) GO TO 11
  31. C
  32.          SEGACT MNUAGE
  33.          NVAR=NUAPOI(/1)
  34.          ILENA(1)=NVAR
  35.          CTYP = NUATYP(1)
  36. *         write(6,fmt='( '' ctyp '' , a8)') ctyp
  37.          IF(CTYP.EQ.'FLOTTANT') THEN
  38.             NUAVFL=NUAPOI(1)
  39.             SEGACT NUAVFL
  40.             NBCOUP=NUAFLO(/1)
  41.          ELSEIF(CTYP.EQ.'MOT     ') THEN
  42.             NUAVMO=NUAPOI(1)
  43.             SEGACT NUAVMO
  44.             NBCOUP=NUAMOT(/2)
  45.          ELSEIF(CTYP.EQ.'LOGIQUE ') THEN
  46.             NUAVLO=NUAPOI(1)
  47.             SEGACT NUAVLO
  48.             NBCOUP=NUALOG(/1)
  49.          ELSE
  50.             NUAVIN=NUAPOI(1)
  51.             SEGACT NUAVIN
  52.             NBCOUP=NUAINT(/1)
  53.          ENDIF
  54.          ILENA(2)=NBCOUP
  55. *         write(6,fmt='(''  nbcoup '',i6)')nbcoup
  56.          CALL ECDIFE(IOSAU,2,ILENA,IFORM)
  57.          NM=4*NVAR
  58.          SEGINI ITBBM1,itbbc1
  59.          DO 1 I=1,NVAR
  60.             J = 4*I -3
  61.             READ (NUANOM(I),FMT='(2A4)') ITABM1(J),ITABM1(J+1)
  62.             READ (NUATYP(I),FMT='(2A4)') ITABM1(J+2),ITABM1(J+3)
  63.             itabc1(j)=nuanom(i)(1:4)
  64.             itabc1(j+1)=nuanom(i)(5:8)
  65.             itabc1(j+2)=nuatyp(i)(1:4)
  66.             itabc1(j+3)=nuatyp(i)(5:8)
  67.    1     CONTINUE
  68.          if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM)
  69.          if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4))
  70.          SEGSUP ITBBM1,itbbc1
  71.          DO 2 I= 1,NVAR
  72.             CTYP = NUATYP(I)
  73.             IF( CTYP.EQ.'FLOTTANT') THEN
  74.                NUAVFL=NUAPOI(I)
  75.                SEGACT NUAVFL
  76.                NBCOUP=NUAFLO(/1)
  77.                CALL ECDIFR(IOSAU,NBCOUP,NUAFLO,IFORM)
  78.                SEGDES NUAVFL
  79.             ELSEIF(CTYP.EQ.'MOT     ') THEN
  80.                NUAVMO=NUAPOI(I)
  81.                SEGACT NUAVMO
  82.                NBCOUP=NUAMOT(/2)
  83.                NM = NBCOUP*2
  84.                SEGINI ITBBM1,itbbc1
  85.                DO 3 K=1,NBCOUP
  86.                   J=2*K -1
  87.                   READ (NUAMOT(K),FMT='(2A4)') ITABM1(J),ITABM1(J+1)
  88.                   itabc1(j)=nuamot(k)(1:4)
  89.                   itabc1(j+1)=nuamot(k)(5:8)
  90.     3          CONTINUE
  91.                if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM)
  92.                if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4))
  93.                SEGDES NUAVMO
  94.                SEGSUP ITBBM1,itbbc1
  95.             ELSEIF(CTYP.EQ.'LOGIQUE ') THEN
  96.                NUAVLO=NUAPOI(I)
  97.                SEGACT NUAVLO
  98.                NN=NUALOG(/1)
  99.                SEGINI ITBBE1
  100.                DO 4 K=1,NN
  101.                   IF(NUALOG(K)) ITABE1(K)=1
  102.    4           CONTINUE
  103.                CALL ECDIFE(IOSAU,NN,ITABE1,IFORM)
  104.                SEGSUP ITBBE1
  105.                SEGDES NUAVLO
  106.             ELSE
  107.                NUAVIN=NUAPOI(I)
  108.                SEGACT NUAVIN
  109.                NN=NUAINT(/1)
  110.                CALL ECDIFE(IOSAU,NN,NUAINT,IFORM)
  111.                SEGDES NUAVIN
  112.             ENDIF
  113.     2    CONTINUE
  114.          SEGDES MNUAGE
  115.    11    CONTINUE
  116.  1101 CONTINUE
  117.       RETURN
  118.       END
  119.  
  120.  
  121.  
  122.  
  123.  

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