source: LMDZ4/branches/LMDZ4_V3_patches/libf/bibio/write_field.F90 @ 1168

Last change on this file since 1168 was 772, checked in by Laurent Fairhead, 17 years ago

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