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 55 : CALL ECDIFE(IOSAU,2,ILENA,IFORM) 56 : NM=4*NVAR 57 : SEGINI ITBBM1,itbbc1 58 : DO 1 I=1,NVAR 59 : J = 4*I -3 60 : READ (NUANOM(I),FMT='(2A4)') ITABM1(J),ITABM1(J+1) 61 : READ (NUATYP(I),FMT='(2A4)') ITABM1(J+2),ITABM1(J+3) 62 : itabc1(j)=nuanom(i)(1:4) 63 : itabc1(j+1)=nuanom(i)(5:8) 64 : itabc1(j+2)=nuatyp(i)(1:4) 65 : itabc1(j+3)=nuatyp(i)(5:8) 66 : 1 CONTINUE 66 : if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM) 67 : if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4)) 68 : SEGSUP ITBBM1,itbbc1 69 : DO 2 I= 1,NVAR 70 : CTYP = NUATYP(I) 71 : IF( CTYP.EQ.'FLOTTANT') THEN 72 : NUAVFL=NUAPOI(I) 73 : SEGACT NUAVFL 74 : NBCOUP=NUAFLO(/1) 74 : CALL ECDIFR(IOSAU,NBCOUP,NUAFLO,IFORM) 75 : SEGDES NUAVFL 76 : ELSEIF(CTYP.EQ.'MOT ') THEN 77 : NUAVMO=NUAPOI(I) 78 : SEGACT NUAVMO 79 : NBCOUP=NUAMOT(/2) 80 : NM = NBCOUP*2 81 : SEGINI ITBBM1,itbbc1 82 : DO 3 K=1,NBCOUP 83 : J=2*K -1 84 : READ (NUAMOT(K),FMT='(2A4)') ITABM1(J),ITABM1(J+1) 85 : itabc1(j)=nuamot(k)(1:4) 86 : itabc1(j+1)=nuamot(k)(5:8) 87 : 3 CONTINUE 87 : if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM) 88 : if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4)) 89 : SEGDES NUAVMO 90 : SEGSUP ITBBM1,itbbc1 91 : ELSEIF(CTYP.EQ.'LOGIQUE ') THEN 92 : NUAVLO=NUAPOI(I) 93 : SEGACT NUAVLO 94 : NN=NUALOG(/1) 95 : SEGINI ITBBE1 96 : DO 4 K=1,NN 97 : IF(NUALOG(K)) ITABE1(K)=1 98 : 4 CONTINUE 98 : CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 99 : SEGSUP ITBBE1 100 : SEGDES NUAVLO 101 : ELSE 102 : NUAVIN=NUAPOI(I) 103 : SEGACT NUAVIN 104 : NN=NUAINT(/1) 104 : CALL ECDIFE(IOSAU,NN,NUAINT,IFORM) 105 : SEGDES NUAVIN 106 : ENDIF 107 : 2 CONTINUE 108 : SEGDES MNUAGE 109 : 11 CONTINUE 110 : 1101 CONTINUE 111 : RETURN 112 : END 113 : 114 : 115 : 116 :
© Cast3M 2003 - All rights reserved.
Disclaimer