source: LMDZ4/branches/V3_test/libf/bibio/write_field.F90 @ 1417

Last change on this file since 1417 was 704, checked in by Laurent Fairhead, 18 years ago

Inclusion des modifs de Y. Meurdesoif pour la version V3
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.8 KB
Line 
1module write_field
2implicit none
3
4  integer, parameter :: MaxWriteField = 100
5  integer, dimension(MaxWriteField),save :: FieldId
6  integer, dimension(MaxWriteField),save :: FieldVarId
7  integer, dimension(MaxWriteField),save :: FieldIndex
8  character(len=255), dimension(MaxWriteField) ::  FieldName
9   
10  integer,save :: NbField = 0
11 
12  interface WriteField
13    module procedure WriteField3d,WriteField2d,WriteField1d
14  end interface WriteField
15  contains
16 
17    function GetFieldIndex(name)
18    implicit none
19      integer          :: GetFieldindex
20      character(len=*) :: name
21   
22      character(len=255) :: TrueName
23      integer            :: i
24       
25     
26      TrueName=TRIM(ADJUSTL(name))
27   
28      GetFieldIndex=-1
29      do i=1,NbField
30        if (TrueName==FieldName(i)) then
31          GetFieldIndex=i
32          exit
33        endif
34      enddo
35    end function GetFieldIndex
36 
37    subroutine WriteField3d(name,Field)
38    implicit none
39      character(len=*) :: name
40      real, dimension(:,:,:) :: Field
41      integer, dimension(3) :: Dim
42     
43      Dim=shape(Field)
44      call WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3)) 
45 
46    end subroutine WriteField3d
47   
48    subroutine WriteField2d(name,Field)
49    implicit none
50      character(len=*) :: name
51      real, dimension(:,:) :: Field
52      integer, dimension(2) :: Dim
53     
54      Dim=shape(Field)
55      call WriteField_gen(name,Field,Dim(1),Dim(2),1) 
56 
57    end subroutine WriteField2d
58   
59    subroutine WriteField1d(name,Field)
60    implicit none
61      character(len=*) :: name
62      real, dimension(:) :: Field
63      integer, dimension(1) :: Dim
64     
65      Dim=shape(Field)
66      call WriteField_gen(name,Field,Dim(1),1,1) 
67 
68    end subroutine WriteField1d
69       
70    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
71    USE ioipsl
72    implicit none
73    include 'netcdf.inc'
74      character(len=*) :: name
75      integer :: dimx,dimy,dimz
76      real,dimension(dimx,dimy,dimz) :: Field
77      integer,dimension(dimx*dimy*dimz) :: ndex
78      integer :: status
79      integer :: index
80      integer :: start(4)
81      integer :: count(4)
82     
83           
84      Index=GetFieldIndex(name)
85      if (Index==-1) then
86        call CreateNewField(name,dimx,dimy,dimz)
87        Index=GetFieldIndex(name)
88      else
89        FieldIndex(Index)=FieldIndex(Index)+1.
90      endif
91     
92      start(1)=1
93      start(2)=1
94      start(3)=1
95      start(4)=FieldIndex(Index)
96
97      count(1)=dimx
98      count(2)=dimy
99      count(3)=dimz
100      count(4)=1
101
102      status = NF_PUT_VARA_DOUBLE(FieldId(Index),FieldVarId(Index),start,count,Field)
103      status = NF_SYNC(FieldId(Index))
104     
105    end subroutine WriteField_gen
106       
107    subroutine CreateNewField(name,dimx,dimy,dimz)
108    USE ioipsl
109    implicit none
110    include 'netcdf.inc' 
111      character(len=*) :: name
112      integer :: dimx,dimy,dimz
113      integer :: TabDim(4)
114      integer :: status
115     
116     
117      NbField=NbField+1
118      FieldName(NbField)=TRIM(ADJUSTL(name))
119      FieldIndex(NbField)=1
120     
121     
122      status = NF_CREATE(TRIM(ADJUSTL(name))//'.nc', NF_CLOBBER, FieldId(NbField))
123      status = NF_DEF_DIM(FieldId(NbField),'X',dimx,TabDim(1))
124      status = NF_DEF_DIM(FieldId(NbField),'Y',dimy,TabDim(2))
125      status = NF_DEF_DIM(FieldId(NbField),'Z',dimz,TabDim(3))
126      status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(4))
127      status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,4,TabDim,FieldVarId(NbField))
128      status = NF_ENDDEF(FieldId(NbField))
129
130    end subroutine CreateNewField
131   
132   
133   
134  subroutine write_field1D(name,Field)
135    implicit none
136 
137    integer, parameter :: MaxDim=1
138    character(len=*)   :: name
139    real, dimension(:) :: Field
140    real, dimension(:),allocatable :: New_Field
141    character(len=20) :: str
142    integer, dimension(MaxDim) :: Dim
143    integer :: i,nb
144    integer, parameter :: id=10
145    integer, parameter :: NbCol=4
146    integer :: ColumnSize
147    integer :: pos
148    character(len=255) :: form
149    character(len=255) :: MaxLen
150   
151   
152    open(unit=id,file=name//'.field',form='formatted',status='replace')
153    write (id,'("----- Field '//name//'",//)')
154    Dim=shape(Field)
155    MaxLen=int2str(len(trim(int2str(Dim(1)))))
156    ColumnSize=20+6+3+len(trim(int2str(Dim(1))))
157    Nb=0
158    Pos=2
159    do i=1,Dim(1)
160      nb=nb+1
161     
162      if (MOD(nb,NbCol)==0) then
163        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16,/)'
164        Pos=2
165      else
166        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16," | ",)'
167        Pos=Pos+ColumnSize
168      endif
169      write (id,form,advance='no') i,Field(i)
170    enddo
171     
172    close(id)
173
174  end subroutine write_field1D
175
176  subroutine write_field2D(name,Field)
177    implicit none
178 
179    integer, parameter :: MaxDim=2
180    character(len=*)   :: name
181    real, dimension(:,:) :: Field
182    real, dimension(:,:),allocatable :: New_Field
183    character(len=20) :: str
184    integer, dimension(MaxDim) :: Dim
185    integer :: i,j,nb
186    integer, parameter :: id=10
187    integer, parameter :: NbCol=4
188    integer :: ColumnSize
189    integer :: pos,offset
190    character(len=255) :: form
191    character(len=255) :: spacing
192   
193    open(unit=id,file=name//'.field',form='formatted',status='replace')
194    write (id,'("----- Field '//name//'",//)')
195   
196    Dim=shape(Field)
197    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+3
198    ColumnSize=20+6+3+offset
199
200    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
201   
202    do i=1,Dim(2)
203      nb=0
204      Pos=2
205      do j=1,Dim(1)
206        nb=nb+1
207     
208        if (MOD(nb,NbCol)==0) then
209          form='(t'//trim(int2str(pos))//            &
210               ',"('//trim(int2str(j))//','          &
211                    //trim(int2str(i))//')",t'       &
212                    //trim(int2str(pos+offset))     &   
213                    //'," ---> ",g22.16,/)'
214          Pos=2
215        else
216          form='(t'//trim(int2str(pos))//            &
217               ',"('//trim(int2str(j))//','          &
218                    //trim(int2str(i))//')",t'       &
219                    //trim(int2str(pos+offset))     &   
220                    //'," ---> ",g22.16," | ")'
221          Pos=Pos+ColumnSize
222        endif
223        write (id,form,advance='no') Field(j,i)
224      enddo
225      if (MOD(nb,NbCol)==0) then
226        write (id,spacing)
227      else
228        write (id,'')
229        write (id,spacing)
230      endif
231    enddo
232     
233  end subroutine write_field2D
234 
235  subroutine write_field3D(name,Field)
236    implicit none
237 
238    integer, parameter :: MaxDim=3
239    character(len=*)   :: name
240    real, dimension(:,:,:) :: Field
241    real, dimension(:,:,:),allocatable :: New_Field
242    integer, dimension(MaxDim) :: Dim
243    integer :: i,j,k,nb
244    integer, parameter :: id=10
245    integer, parameter :: NbCol=4
246    integer :: ColumnSize
247    integer :: pos,offset
248    character(len=255) :: form
249    character(len=255) :: spacing
250
251    open(unit=id,file=name//'.field',form='formatted',status='replace')
252    write (id,'("----- Field '//name//'"//)')
253   
254    Dim=shape(Field)
255    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+len(trim(int2str(Dim(3))))+4
256    ColumnSize=22+6+3+offset
257
258!    open(unit=id,file=name,form=formatted
259   
260    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
261   
262    do i=1,Dim(3)
263   
264      do j=1,Dim(2)
265        nb=0
266        Pos=2
267       
268        do k=1,Dim(1)
269        nb=nb+1
270     
271          if (MOD(nb,NbCol)==0) then
272            form='(t'//trim(int2str(pos))//            &
273                 ',"('//trim(int2str(k))//','          &
274                      //trim(int2str(j))//','          &
275                      //trim(int2str(i))//')",t'       &
276                      //trim(int2str(pos+offset))      &   
277                      //'," ---> ",g22.16,/)'
278           Pos=2
279          else
280            form='(t'//trim(int2str(pos))//            &
281                 ',"('//trim(int2str(k))//','          &
282                      //trim(int2str(j))//','          &
283                      //trim(int2str(i))//')",t'       &
284                      //trim(int2str(pos+offset))      &   
285                      //'," ---> ",g22.16," | ")'
286! dépent de l'implémention, sur compaq, c'est necessaire
287!            Pos=Pos+ColumnSize
288          endif
289          write (id,form,advance='no') Field(k,j,i)
290        enddo
291        if (MOD(nb,NbCol)==0) then
292          write (id,spacing)
293        else
294          write (id,'("")')
295          write (id,spacing)
296        endif
297      enddo
298      write (id,spacing)
299    enddo
300   
301    close(id)
302 
303  end subroutine write_field3D 
304 
305  function int2str(int)
306    implicit none
307    integer, parameter :: MaxLen=10
308    integer,intent(in) :: int
309    character(len=MaxLen) :: int2str
310    logical :: flag
311    integer :: i
312    flag=.true.
313   
314    i=int
315   
316    int2str=''
317    do while (flag)
318      int2str=CHAR(MOD(i,10)+48)//int2str
319      i=i/10
320      if (i==0) flag=.false.
321    enddo
322  end function int2str
323
324end module write_field
325 
Note: See TracBrowser for help on using the repository browser.