source: branches/GRISLIv3/SOURCES/readinput.f90 @ 443

Last change on this file since 443 was 427, checked in by dumas, 15 months ago

Use only in reso_adv_diff_2D_vect relaxation_waterdif_mod and dat2netcdf

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