1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
| PROGRAM TESTLECTURE
IMPLICIT NONE
TYPE FICHIER
CHARACTER(LEN=4) :: nom
INTEGER :: unite
END TYPE
INTEGER :: n
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: t
TYPE (fichier) :: sat1,sat2
sat1%nom = "sat1"
sat2%nom = "sat2"
sat1%unite = 15
sat2%unite = 16
CALL ouverturecompte(sat1%nom,sat1%unite,n)
ALLOCATE(t(n))
write(*,*) n
CALL lecture(sat1%nom,sat1%unite,n,t)
CALL ecriture(sat2%nom,sat2%unite,n,t)
CONTAINS
SUBROUTINE OUVERTURECOMPTE(nomfichier,unitee,nlc)
CHARACTER(LEN=*),INTENT(IN) :: nomfichier
INTEGER ,INTENT(IN) :: unitee
INTEGER ,INTENT(OUT) :: nlc
INTEGER :: ios=0, ios2
open(unit=unitee,file = nomfichier,form='formatted',status='old',action='read',iostat=ios)
if (ios .ne. 0) stop "Pb avec comptage"
ios2 = 0
nlc = 0
do while(ios2 .eq. 0)
read(unit=unitee,FMT=*,iostat=ios2)
nlc = nlc+1
enddo
close(unit=unitee)
nlc=nlc-1
END SUBROUTINE OUVERTURECOMPTE
SUBROUTINE LECTURE(nomfichier,unitee,nlc,tcheck)
CHARACTER(LEN=*) ,INTENT(IN) :: nomfichier
INTEGER ,INTENT(IN) :: unitee
INTEGER ,INTENT(IN) :: nlc
INTEGER :: k
DOUBLE PRECISION, DIMENSION(nlc),INTENT(OUT) :: tcheck
INTEGER :: ios=0
write(*,*)unitee
open(unit=unitee,file = nomfichier,form='formatted',status='old',action='read',iostat=ios)
if (ios .ne. 0) stop "Pb avec lecture!"
do k=1,nlc
read(unit=unitee,FMT=*) tcheck(k)
enddo
close(unit=unitee)
RETURN
END SUBROUTINE LECTURE
SUBROUTINE ECRITURE(nomfichier,unitee,nlc,tcheck)
CHARACTER(LEN=*) ,INTENT(IN) :: nomfichier
INTEGER ,INTENT(IN) :: unitee
INTEGER ,INTENT(IN) :: nlc
INTEGER :: k
DOUBLE PRECISION, DIMENSION(nlc),INTENT(OUT) :: tcheck
INTEGER :: ios=0
open(unit=unitee,file=nomfichier,form='formatted',status='replace',action='readwrite' ,iostat=ios)
if (ios .ne. 0) stop "Pb ecriture"
do k=1,nlc
write(unit=unitee,FMT='(e18.11)') tcheck(k)
enddo
close(unit=unitee)
RETURN
END SUBROUTINE ECRITURE
END PROGRAM TESTLECTURE |
Partager