source: trunk/SOURCES/readinput.f90 @ 23

Last change on this file since 23 was 6, checked in by sleclech, 10 years ago

Modification initialisation pointeurs lecture NetCDF pour compatibilité avec ifort 13

File size: 7.3 KB
Line 
1
2!> subroutine dat2netcdf
3!! convertion of a ZBL file to an netcdf one
4!! @param  nxx                dimension along x
5!! @param  nyy                dimension along y
6!! @param  filename           
7!! @return Tab                the value of Tab(nxx,nyy): Warning it is a real
8
9subroutine dat2netcdf(nxx,nyy,numcol,base_name,filename,fil_sortie)
10
11  use netcdf
12  use io_netcdf_grisli
13  implicit none
14  integer,intent(in)  :: nxx                    !< dimension along x
15  integer,intent(in)  :: nyy                    !< dimension along y
16  integer,intent(in)  :: numcol                 !< column number
17  character(len=*), intent(in) :: base_name     !< base name of the variable to write
18  character(len=20) :: base_name1               !< base name of the variable to write
19  character(len=*),intent(in) :: filename       !< name of the file
20  character(len=*)::fil_sortie
21  real*8,dimension(:,:),pointer :: Tab1,Tab2,Tab3    !< the array that is read and returned
22  integer  :: i,j                !< working integers
23  integer  :: lx,ly              !< nxx, nyy read in the file
24  real,dimension(3) :: a         !< working tab
25  logical,save :: init
26  integer ncid1,status1
27  character(len=20),dimension(2) :: dimnames2d        !< dimensions pour netcdf pour tableau 2d
28
29  if ((index(filename,'no') .eq. 0)) then
30
31     if (.not. init) then
32        status1  = nf90_create(trim(fil_sortie),NF90_WRITE,ncid1)    ! ouverture du fichier
33        status1  = nf90_close(ncid1)                                 ! fermeture
34        call init_ncdf(nxx,nyy,fil_sortie,dimnames2d)
35        init= .true.
36     end if
37
38
39     open(22,file=trim(filename))
40     read(22,*) lx,ly
41
42     if ((lx.ne.nxx).or.(ly.ne.nyy)) then
43        write(6,*) 'wrong dimension of the file', filename
44        write(6,*) 'in the file',lx,ly
45        write(6,*) 'should be',nxx,nyy
46        stop
47     end if
48
49     if (numcol .eq. 1) then
50        allocate(Tab1(nxx,nyy))
51        do j=1,nyy
52           do i=1,nxx
53              read(22,*) a(1)
54              Tab1(i,j)=a(1)
55           end do
56        end do
57        base_name1= trim(base_name)//'_1'
58        call Write_Ncdf_var(base_name1,dimnames2d,trim(fil_sortie),Tab1,'double')
59        deallocate(Tab1)
60     endif
61
62     if (numcol .eq. 2) then
63        allocate(Tab1(nxx,nyy),Tab2(nxx,nyy))
64        do j=1,nyy
65           do i=1,nxx
66              read(22,*) a(1),a(2)
67              Tab1(i,j)=a(1)
68              Tab2(i,j)=a(2)
69           end do
70        end do
71        base_name1= trim(base_name)//'_1'
72        call Write_Ncdf_var(base_name1,dimnames2d,trim(fil_sortie),Tab1,'double')
73        base_name1=trim(base_name)//'_2'
74        call Write_Ncdf_var(base_name1,dimnames2d,trim(fil_sortie),Tab2,'double')
75        deallocate(Tab1,Tab2)
76     endif
77
78     if (numcol .eq. 3) then
79        allocate(Tab1(nxx,nyy),Tab2(nxx,nyy),Tab3(nxx,nyy))
80        do j=1,nyy
81           do i=1,nxx
82              read(22,*) a(1),a(2),a(3)
83              Tab1(i,j)=a(1)
84              Tab2(i,j)=a(2)
85              Tab3(i,j)=a(3)
86           end do
87        end do
88        base_name1= trim(base_name)//'_1'
89        call Write_Ncdf_var(base_name1,dimnames2d,trim(fil_sortie),Tab1,'double')
90        base_name1=trim(base_name)//'_2'
91        call Write_Ncdf_var(base_name1,dimnames2d,trim(fil_sortie),Tab2,'double')
92        base_name1=trim(base_name)//'_3'
93        call Write_Ncdf_var(base_name1,dimnames2d,trim(fil_sortie),Tab3,'double')
94        deallocate(Tab1,Tab2,Tab3)
95     endif
96
97     close(22)
98  end if
99
100end subroutine dat2netcdf
101
102!> subroutine init_ncdf
103!! Initialise the netcdf file
104!! @param nxx                dimension along x
105!! @param nyy                dimension along y
106!! @param fil_sortie         name of the file to initialise
107!! @ param dimnames2d        dimensions for netcdf
108
109subroutine init_ncdf(nxx,nyy,fil_sortie,dimnames2d)
110  use netcdf
111  use io_netcdf_grisli
112  implicit none
113  integer,intent(in)  :: nxx                    !< dimension along x
114  integer,intent(in)  :: nyy                    !< dimension along y
115  character(len=*)::fil_sortie
116  character(len=20),dimension(2) :: dimnames2d  !< dimensions pour netcdf pour tableau 2d
117  ! initialisation
118  call write_ncdf_dim('x',trim(fil_sortie),nxx)               ! dimensions des tableaux
119  call write_ncdf_dim('y',trim(fil_sortie),nyy)
120  ! ecriture d'un tableau tab 2D
121  dimnames2d(1)='x'
122  dimnames2d(2)='y'
123end subroutine init_ncdf
124
125
126!> subroutine lect_ncfile
127!! Read the nc file given
128!! @param varname              The name of the variable to read
129!! @param  filename            File to read from
130!! @return Tab                 The value of Tab: Warning it is a real
131
132subroutine lect_ncfile(varname,Tab,filename)
133  use netcdf
134  use io_netcdf_grisli
135  implicit none
136
137  character(*),intent(in) :: varname          !< Var name to read
138  real,dimension(:,:),intent(inout) :: Tab    !< Array to read in
139  character(*),intent(in) :: filename         !< File to read from
140  real*8, dimension(:,:), pointer :: tabvar
141
142
143  if(.not. associated(tabvar)) then
144     allocate(tabvar(size(Tab,1),size(Tab,2))) 
145  else  ! to nullify the pointer if undefined
146    if (any(shape(tabvar).ne.(/size(Tab,1),size(Tab,2)/)) ) then
147        tabvar => null()
148    end if
149  end if
150
151
152  call read_ncdf_var(varname,filename,tabvar)
153  Tab(:,:)= tabvar(:,:)
154!write(6,*) filename,varname,Tab(154,123)
155end subroutine lect_ncfile
156
157
158!> subroutine lect_input
159!! Read the file given
160!! @param numcol               Column number
161!! @param basename             Base name of the variable to read
162!! @param col                  The column to read
163!! @param  filename            File to read from
164!! @param ncfileout            File out in case of .dat file to read
165!! @return tabvar              The value of Tab(nxx,nyy): Warning it is a real
166
167
168
169subroutine lect_input (numcol,basename,col,tabvar,filename,ncfileout) 
170  !use netcdf
171  !use io_netcdf_grisli
172  implicit none
173  integer,intent(in)  :: numcol                 !< column number
174  character(len=*), intent(in) :: basename      !< base name of the variable to read
175  integer,intent(in)  :: col                    !< column   1->average, 2->minval 3->maxval 
176                                                !          ??? double emploi avec numcol
177  real,dimension(:,:),intent(inout) :: tabvar   !< array to read in the variable
178  character(len=*),intent(in) :: filename       !< name of the file to read
179  character(len=*)::ncfileout                   !< name of the nc file to create
180
181  interface     !<<<<<<<<<<<<<<<<<<<
182     subroutine lect_ncfile(varname,Tab,filename)           
183       character(*),intent(in) :: varname
184       real,dimension(:,:),intent(inout) :: Tab
185       character(*),intent(in) :: filename
186       real*8, dimension(:,:), pointer :: tabvar
187     end subroutine lect_ncfile
188  end interface !<<<<<<<<<<<<<<<<<<<
189
190
191  character(1)  xcol
192  write( xcol,'(i1)')  col
193
194  if (index(filename,'.dat')  .ne.0) then    ! file in is a .dat
195
196     call dat2netcdf(size(tabvar,1),size(tabvar,2),numcol,basename,filename,ncfileout)
197     call lect_ncfile(trim(basename)//'_'//xcol,tabvar,ncfileout)               
198  else
199 
200     if(index(filename,'.grd') .ne.0) then   ! file in is a .grd
201 
202        call lect_ncfile('z',tabvar,filename)
203     else
204                            ! file in is a .nc
205        if(index(filename,'.nc') .ne.0) then
206           call lect_ncfile(basename,tabvar,filename)
207        endif
208     endif
209  endif
210
211
212end subroutine lect_input
213
Note: See TracBrowser for help on using the repository browser.