My Project
 All Classes Files Functions Variables Macros
write_field.F90
Go to the documentation of this file.
1 !
2 ! $Id: write_field.F90 1279 2009-12-10 09:02:56Z fairhead $
3 !
4 module write_field
5 implicit none
6 
7  integer, parameter :: MaxWriteField = 100
8  integer, dimension(MaxWriteField),save :: FieldId
9  integer, dimension(MaxWriteField),save :: FieldVarId
10  integer, dimension(MaxWriteField),save :: FieldIndex
11  character(len=255), dimension(MaxWriteField) :: FieldName
12 
13  integer,save :: NbField = 0
14 
15  interface writefield
16  module procedure writefield3d,writefield2d,writefield1d
17  end interface writefield
18  contains
19 
20  function getfieldindex(name)
21  implicit none
22  integer :: getfieldindex
23  character(len=*) :: name
24 
25  character(len=255) :: truename
26  integer :: i
27 
28 
29  truename=trim(adjustl(name))
30 
31  getfieldindex=-1
32  do i=1,nbfield
33  if (truename==fieldname(i)) then
34  getfieldindex=i
35  exit
36  endif
37  enddo
38  end function getfieldindex
39 
40  subroutine writefield3d(name,Field)
41  implicit none
42  character(len=*) :: name
43  real, dimension(:,:,:) :: field
44  integer, dimension(3) :: dim
45 
46  dim=shape(field)
47  call writefield_gen(name,field,dim(1),dim(2),dim(3))
48 
49  end subroutine writefield3d
50 
51  subroutine writefield2d(name,Field)
52  implicit none
53  character(len=*) :: name
54  real, dimension(:,:) :: field
55  integer, dimension(2) :: dim
56 
57  dim=shape(field)
58  call writefield_gen(name,field,dim(1),dim(2),1)
59 
60  end subroutine writefield2d
61 
62  subroutine writefield1d(name,Field)
63  implicit none
64  character(len=*) :: name
65  real, dimension(:) :: field
66  integer, dimension(1) :: dim
67 
68  dim=shape(field)
69  call writefield_gen(name,field,dim(1),1,1)
70 
71  end subroutine writefield1d
72 
73  subroutine writefield_gen(name,Field,dimx,dimy,dimz)
74  implicit none
75  include 'netcdf.inc'
76  character(len=*) :: name
77  integer :: dimx,dimy,dimz
78  real,dimension(dimx,dimy,dimz) :: field
79  integer,dimension(dimx*dimy*dimz) :: ndex
80  integer :: status
81  integer :: index
82  integer :: start(4)
83  integer :: count(4)
84 
85 
86  index=getfieldindex(name)
87  if (index==-1) then
88  call createnewfield(name,dimx,dimy,dimz)
89  index=getfieldindex(name)
90  else
91  fieldindex(index)=fieldindex(index)+1.
92  endif
93 
94  start(1)=1
95  start(2)=1
96  start(3)=1
97  start(4)=fieldindex(index)
98 
99  count(1)=dimx
100  count(2)=dimy
101  count(3)=dimz
102  count(4)=1
103 
104  status = nf_put_vara_double(fieldid(index),fieldvarid(index),start,count,field)
105  status = nf_sync(fieldid(index))
106 
107  end subroutine writefield_gen
108 
109  subroutine createnewfield(name,dimx,dimy,dimz)
110  implicit none
111  include 'netcdf.inc'
112  character(len=*) :: name
113  integer :: dimx,dimy,dimz
114  integer :: tabdim(4)
115  integer :: status
116 
117 
118  nbfield=nbfield+1
119  fieldname(nbfield)=trim(adjustl(name))
120  fieldindex(nbfield)=1
121 
122 
123  status = nf_create(trim(adjustl(name))//'.nc', nf_clobber, fieldid(nbfield))
124  status = nf_def_dim(fieldid(nbfield),'X',dimx,tabdim(1))
125  status = nf_def_dim(fieldid(nbfield),'Y',dimy,tabdim(2))
126  status = nf_def_dim(fieldid(nbfield),'Z',dimz,tabdim(3))
127  status = nf_def_dim(fieldid(nbfield),'iter',nf_unlimited,tabdim(4))
128  status = nf_def_var(fieldid(nbfield),fieldname(nbfield),nf_double,4,tabdim,fieldvarid(nbfield))
129  status = nf_enddef(fieldid(nbfield))
130 
131  end subroutine createnewfield
132 
133 
134 
135  subroutine write_field1d(name,Field)
136  implicit none
137 
138  integer, parameter :: maxdim=1
139  character(len=*) :: name
140  real, dimension(:) :: field
141  real, dimension(:),allocatable :: new_field
142  character(len=20) :: str
143  integer, dimension(MaxDim) :: dim
144  integer :: i,nb
145  integer, parameter :: id=10
146  integer, parameter :: nbcol=4
147  integer :: columnsize
148  integer :: pos
149  character(len=255) :: form
150  character(len=255) :: maxlen
151 
152 
153  open(unit=id,file=name//'.field',form='formatted',status='replace')
154  write (id,'("----- Field '//name//'",//)')
155  dim=shape(field)
156  maxlen=int2str(len(trim(int2str(dim(1)))))
157  columnsize=20+6+3+len(trim(int2str(dim(1))))
158  nb=0
159  pos=2
160  do i=1,dim(1)
161  nb=nb+1
162 
163  if (mod(nb,nbcol)==0) then
164  form='(t'//trim(int2str(pos))// ',i'//trim(maxlen) //'," ---> ",g22.16,/)'
165  pos=2
166  else
167  form='(t'//trim(int2str(pos))// ',i'//trim(maxlen) //'," ---> ",g22.16," | ",)'
168  pos=pos+columnsize
169  endif
170  write (id,form,advance='no') i,field(i)
171  enddo
172 
173  close(id)
174 
175  end subroutine write_field1d
176 
177  subroutine write_field2d(name,Field)
178  implicit none
179 
180  integer, parameter :: maxdim=2
181  character(len=*) :: name
182  real, dimension(:,:) :: field
183  real, dimension(:,:),allocatable :: new_field
184  character(len=20) :: str
185  integer, dimension(MaxDim) :: dim
186  integer :: i,j,nb
187  integer, parameter :: id=10
188  integer, parameter :: nbcol=4
189  integer :: columnsize
190  integer :: pos,offset
191  character(len=255) :: form
192  character(len=255) :: spacing
193 
194  open(unit=id,file=name//'.field',form='formatted',status='replace')
195  write (id,'("----- Field '//name//'",//)')
196 
197  dim=shape(field)
198  offset=len(trim(int2str(dim(1))))+len(trim(int2str(dim(2))))+3
199  columnsize=20+6+3+offset
200 
201  spacing='(t2,"'//repeat('-',columnsize*nbcol)//'")'
202 
203  do i=1,dim(2)
204  nb=0
205  pos=2
206  do j=1,dim(1)
207  nb=nb+1
208 
209  if (mod(nb,nbcol)==0) then
210  form='(t'//trim(int2str(pos))// &
211  ',"('//trim(int2str(j))//',' &
212  //trim(int2str(i))//')",t' &
213  //trim(int2str(pos+offset)) &
214  //'," ---> ",g22.16,/)'
215  pos=2
216  else
217  form='(t'//trim(int2str(pos))// &
218  ',"('//trim(int2str(j))//',' &
219  //trim(int2str(i))//')",t' &
220  //trim(int2str(pos+offset)) &
221  //'," ---> ",g22.16," | ")'
222  pos=pos+columnsize
223  endif
224  write (id,form,advance='no') field(j,i)
225  enddo
226  if (mod(nb,nbcol)==0) then
227  write (id,spacing)
228  else
229  write (id,'("")')
230  write (id,spacing)
231  endif
232  enddo
233 
234  end subroutine write_field2d
235 
236  subroutine write_field3d(name,Field)
237  implicit none
238 
239  integer, parameter :: maxdim=3
240  character(len=*) :: name
241  real, dimension(:,:,:) :: field
242  real, dimension(:,:,:),allocatable :: new_field
243  integer, dimension(MaxDim) :: dim
244  integer :: i,j,k,nb
245  integer, parameter :: id=10
246  integer, parameter :: nbcol=4
247  integer :: columnsize
248  integer :: pos,offset
249  character(len=255) :: form
250  character(len=255) :: spacing
251 
252  open(unit=id,file=name//'.field',form='formatted',status='replace')
253  write (id,'("----- Field '//name//'"//)')
254 
255  dim=shape(field)
256  offset=len(trim(int2str(dim(1))))+len(trim(int2str(dim(2))))+len(trim(int2str(dim(3))))+4
257  columnsize=22+6+3+offset
258 
259 ! open(unit=id,file=name,form=formatted
260 
261  spacing='(t2,"'//repeat('-',columnsize*nbcol)//'")'
262 
263  do i=1,dim(3)
264 
265  do j=1,dim(2)
266  nb=0
267  pos=2
268 
269  do k=1,dim(1)
270  nb=nb+1
271 
272  if (mod(nb,nbcol)==0) then
273  form='(t'//trim(int2str(pos))// &
274  ',"('//trim(int2str(k))//',' &
275  //trim(int2str(j))//',' &
276  //trim(int2str(i))//')",t' &
277  //trim(int2str(pos+offset)) &
278  //'," ---> ",g22.16,/)'
279  pos=2
280  else
281  form='(t'//trim(int2str(pos))// &
282  ',"('//trim(int2str(k))//',' &
283  //trim(int2str(j))//',' &
284  //trim(int2str(i))//')",t' &
285  //trim(int2str(pos+offset)) &
286  //'," ---> ",g22.16," | ")'
287 ! dépent de l'implémention, sur compaq, c'est necessaire
288 ! Pos=Pos+ColumnSize
289  endif
290  write (id,form,advance='no') field(k,j,i)
291  enddo
292  if (mod(nb,nbcol)==0) then
293  write (id,spacing)
294  else
295  write (id,'("")')
296  write (id,spacing)
297  endif
298  enddo
299  write (id,spacing)
300  enddo
301 
302  close(id)
303 
304  end subroutine write_field3d
305 
306  function int2str(int)
307  implicit none
308  integer, parameter :: maxlen=10
309  integer,intent(in) :: int
310  character(len=MaxLen) :: int2str
311  logical :: flag
312  integer :: i
313  flag=.true.
314 
315  i=int
316 
317  int2str=''
318  do while (flag)
319  int2str=char(mod(i,10)+48)//int2str
320  i=i/10
321  if (i==0) flag=.false.
322  enddo
323  end function int2str
324 
325 end module write_field
326