source: LMDZ4/trunk/libf/bibio/write_field.F90 @ 677

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

Differentes corrections pour g95
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.2 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
15
16  contains
17 
18    function GetFieldIndex(name)
19    implicit none
20      integer          :: GetFieldindex
21      character(len=*) :: name
22   
23      character(len=255) :: TrueName
24      integer            :: i
25       
26     
27      TrueName=TRIM(ADJUSTL(name))
28   
29      GetFieldIndex=-1
30      do i=1,NbField
31        if (TrueName==FieldName(i)) then
32          GetFieldIndex=i
33          exit
34        endif
35      enddo
36    end function GetFieldIndex
37 
38    subroutine WriteField3d(name,Field)
39    implicit none
40      character(len=*) :: name
41      real, dimension(:,:,:) :: Field
42      integer, dimension(3) :: Dim
43     
44      Dim=shape(Field)
45      call WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3)) 
46 
47    end subroutine WriteField3d
48   
49    subroutine WriteField2d(name,Field)
50    implicit none
51      character(len=*) :: name
52      real, dimension(:,:) :: Field
53      integer, dimension(2) :: Dim
54     
55      Dim=shape(Field)
56      call WriteField_gen(name,Field,Dim(1),Dim(2),1) 
57 
58    end subroutine WriteField2d
59   
60    subroutine WriteField1d(name,Field)
61    implicit none
62      character(len=*) :: name
63      real, dimension(:) :: Field
64      integer, dimension(1) :: Dim
65     
66      Dim=shape(Field)
67      call WriteField_gen(name,Field,Dim(1),1,1) 
68 
69    end subroutine WriteField1d
70       
71    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
72    USE ioipsl
73    implicit none
74    include 'netcdf.inc'
75      character(len=*) :: name
76      integer :: dimx,dimy,dimz
77      real,dimension(dimx,dimy,dimz) :: Field
78      integer,dimension(dimx*dimy*dimz) :: ndex
79      integer :: status
80      integer :: index
81      integer :: start(4)
82      integer :: count(4)
83     
84           
85      Index=GetFieldIndex(name)
86      if (Index==-1) then
87        call CreateNewField(name,dimx,dimy,dimz)
88        Index=GetFieldIndex(name)
89      else
90        FieldIndex(Index)=FieldIndex(Index)+1.
91      endif
92     
93      start(1)=1
94      start(2)=1
95      start(3)=1
96      start(4)=FieldIndex(Index)
97
98      count(1)=dimx
99      count(2)=dimy
100      count(3)=dimz
101      count(4)=1
102
103      status = NF_PUT_VARA_DOUBLE(FieldId(Index),FieldVarId(Index),start,count,Field)
104      status = NF_SYNC(FieldId(Index))
105     
106    end subroutine WriteField_gen
107       
108    subroutine CreateNewField(name,dimx,dimy,dimz)
109    USE ioipsl
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  subroutine WriteField_phy(name,Field,ll)
307    USE dimphy
308    implicit none
309    include 'dimensions90.h'
310    include 'paramet90.h'
311    character(len=*)   :: name
312    integer :: ll
313    real, dimension(klon2,ll) :: Field
314    real, dimension(iim,jjp1,ll):: New_Field
315   
316   
317    CALL gr_fi_ecrit(ll, klon2,iim,jjp1, Field, New_Field)
318    CALL WriteField(name,New_Field)
319  end subroutine WriteField_phy 
320     
321  function int2str(int)
322    implicit none
323    integer, parameter :: MaxLen=10
324    integer,intent(in) :: int
325    character(len=MaxLen) :: int2str
326    logical :: flag
327    integer :: i
328    flag=.true.
329   
330    i=int
331   
332    int2str=''
333    do while (flag)
334      int2str=CHAR(MOD(i,10)+48)//int2str
335      i=i/10
336      if (i==0) flag=.false.
337    enddo
338  end function int2str
339
340end module write_field
341 
Note: See TracBrowser for help on using the repository browser.