source: LMDZ6/branches/Amaury_dev/libf/misc/write_field.F90 @ 5088

Last change on this file since 5088 was 5088, checked in by abarral, 2 months ago

Remove all managed netcdf77 usage (excluding external: rrtm, ecrad)
Remove call to netcdf.inc
Replace USE lmdz_netcdf by USE netcdf
Replace lmdz_netcdf.F90 by lmdz_netcdf_format.F90
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.9 KB
Line 
1module write_field
2  USE netcdf, ONLY: nf90_sync, nf90_put_var, nf90_enddef, nf90_def_dim, nf90_unlimited, &
3      nf90_clobber, nf90_create, nf90_def_var
4  USE lmdz_netcdf_format, ONLY: nf90_format
5
6  implicit none
7
8  integer, parameter :: MaxWriteField = 100
9  integer, dimension(MaxWriteField),save :: FieldId
10  integer, dimension(MaxWriteField),save :: FieldVarId
11  integer, dimension(MaxWriteField),save :: FieldIndex
12  character(len=255), dimension(MaxWriteField) ::  FieldName
13   
14  integer,save :: NbField = 0
15 
16  interface WriteField
17    module procedure WriteField3d,WriteField2d,WriteField1d
18  end interface WriteField
19  contains
20 
21    function GetFieldIndex(name)
22    implicit none
23      integer          :: GetFieldindex
24      character(len=*) :: name
25   
26      character(len=255) :: TrueName
27      integer            :: i
28       
29     
30      TrueName=TRIM(ADJUSTL(name))
31   
32      GetFieldIndex=-1
33      do i=1,NbField
34        if (TrueName==FieldName(i)) then
35          GetFieldIndex=i
36          exit
37        endif
38      enddo
39    end function GetFieldIndex
40 
41    subroutine WriteField3d(name,Field)
42    implicit none
43      character(len=*) :: name
44      real, dimension(:,:,:) :: Field
45      integer, dimension(3) :: Dim
46     
47      Dim=shape(Field)
48      call WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3)) 
49 
50    end subroutine WriteField3d
51   
52    subroutine WriteField2d(name,Field)
53    implicit none
54      character(len=*) :: name
55      real, dimension(:,:) :: Field
56      integer, dimension(2) :: Dim
57     
58      Dim=shape(Field)
59      call WriteField_gen(name,Field,Dim(1),Dim(2),1) 
60 
61    end subroutine WriteField2d
62   
63    subroutine WriteField1d(name,Field)
64    implicit none
65      character(len=*) :: name
66      real, dimension(:) :: Field
67      integer, dimension(1) :: Dim
68     
69      Dim=shape(Field)
70      call WriteField_gen(name,Field,Dim(1),1,1) 
71 
72    end subroutine WriteField1d
73       
74    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
75    implicit none
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 = nf90_put_var(FieldId(Index),FieldVarId(Index),Field,start,count)
105      status = nf90_sync(FieldId(Index))
106     
107    end subroutine WriteField_gen
108       
109    subroutine CreateNewField(name,dimx,dimy,dimz)
110    implicit none
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 = nf90_create(TRIM(ADJUSTL(name))//'.nc', nf90_clobber, FieldId(NbField))
123      status = nf90_def_dim(FieldId(NbField),'X',dimx,TabDim(1))
124      status = nf90_def_dim(FieldId(NbField),'Y',dimy,TabDim(2))
125      status = nf90_def_dim(FieldId(NbField),'Z',dimz,TabDim(3))
126      status = nf90_def_dim(FieldId(NbField),'iter',nf90_unlimited,TabDim(4))
127      status = nf90_def_var(FieldId(NbField),FieldName(NbField),nf90_format,TabDim,FieldVarId(NbField))
128      status = nf90_enddef(FieldId(NbField))
129
130    end subroutine CreateNewField
131   
132  subroutine write_field1D(name,Field)
133    implicit none
134 
135    integer, parameter :: MaxDim=1
136    character(len=*)   :: name
137    real, dimension(:) :: Field
138    real, dimension(:),allocatable :: New_Field
139    character(len=20) :: str
140    integer, dimension(MaxDim) :: Dim
141    integer :: i,nb
142    integer, parameter :: id=10
143    integer, parameter :: NbCol=4
144    integer :: ColumnSize
145    integer :: pos
146    character(len=255) :: form
147    character(len=255) :: MaxLen
148   
149   
150    open(unit=id,file=name//'.field',form='formatted',status='replace')
151    write (id,'("----- Field '//name//'",//)')
152    Dim=shape(Field)
153    MaxLen=int2str(len(trim(int2str(Dim(1)))))
154    ColumnSize=20+6+3+len(trim(int2str(Dim(1))))
155    Nb=0
156    Pos=2
157    do i=1,Dim(1)
158      nb=nb+1
159     
160      if (MOD(nb,NbCol)==0) then
161        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16,/)'
162        Pos=2
163      else
164        form='(t'//trim(int2str(pos))// ',i'//trim(MaxLen) //'," ---> ",g22.16," | ",)'
165        Pos=Pos+ColumnSize
166      endif
167      write (id,form,advance='no') i,Field(i)
168    enddo
169     
170    close(id)
171
172  end subroutine write_field1D
173
174  subroutine write_field2D(name,Field)
175    implicit none
176 
177    integer, parameter :: MaxDim=2
178    character(len=*)   :: name
179    real, dimension(:,:) :: Field
180    real, dimension(:,:),allocatable :: New_Field
181    character(len=20) :: str
182    integer, dimension(MaxDim) :: Dim
183    integer :: i,j,nb
184    integer, parameter :: id=10
185    integer, parameter :: NbCol=4
186    integer :: ColumnSize
187    integer :: pos,offset
188    character(len=255) :: form
189    character(len=255) :: spacing
190   
191    open(unit=id,file=name//'.field',form='formatted',status='replace')
192    write (id,'("----- Field '//name//'",//)')
193   
194    Dim=shape(Field)
195    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+3
196    ColumnSize=20+6+3+offset
197
198    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
199   
200    do i=1,Dim(2)
201      nb=0
202      Pos=2
203      do j=1,Dim(1)
204        nb=nb+1
205     
206        if (MOD(nb,NbCol)==0) then
207          form='(t'//trim(int2str(pos))//            &
208               ',"('//trim(int2str(j))//','          &
209                    //trim(int2str(i))//')",t'       &
210                    //trim(int2str(pos+offset))     &   
211                    //'," ---> ",g22.16,/)'
212          Pos=2
213        else
214          form='(t'//trim(int2str(pos))//            &
215               ',"('//trim(int2str(j))//','          &
216                    //trim(int2str(i))//')",t'       &
217                    //trim(int2str(pos+offset))     &   
218                    //'," ---> ",g22.16," | ")'
219          Pos=Pos+ColumnSize
220        endif
221        write (id,form,advance='no') Field(j,i)
222      enddo
223      if (MOD(nb,NbCol)==0) then
224        write (id,spacing)
225      else
226        write (id,'("")')
227        write (id,spacing)
228      endif
229    enddo
230     
231  end subroutine write_field2D
232 
233  subroutine write_field3D(name,Field)
234    implicit none
235 
236    integer, parameter :: MaxDim=3
237    character(len=*)   :: name
238    real, dimension(:,:,:) :: Field
239    real, dimension(:,:,:),allocatable :: New_Field
240    integer, dimension(MaxDim) :: Dim
241    integer :: i,j,k,nb
242    integer, parameter :: id=10
243    integer, parameter :: NbCol=4
244    integer :: ColumnSize
245    integer :: pos,offset
246    character(len=255) :: form
247    character(len=255) :: spacing
248
249    open(unit=id,file=name//'.field',form='formatted',status='replace')
250    write (id,'("----- Field '//name//'"//)')
251   
252    Dim=shape(Field)
253    offset=len(trim(int2str(Dim(1))))+len(trim(int2str(Dim(2))))+len(trim(int2str(Dim(3))))+4
254    ColumnSize=22+6+3+offset
255
256!    open(unit=id,file=name,form=formatted
257   
258    spacing='(t2,"'//repeat('-',ColumnSize*NbCol)//'")'
259   
260    do i=1,Dim(3)
261   
262      do j=1,Dim(2)
263        nb=0
264        Pos=2
265       
266        do k=1,Dim(1)
267        nb=nb+1
268     
269          if (MOD(nb,NbCol)==0) then
270            form='(t'//trim(int2str(pos))//            &
271                 ',"('//trim(int2str(k))//','          &
272                      //trim(int2str(j))//','          &
273                      //trim(int2str(i))//')",t'       &
274                      //trim(int2str(pos+offset))      &   
275                      //'," ---> ",g22.16,/)'
276           Pos=2
277          else
278            form='(t'//trim(int2str(pos))//            &
279                 ',"('//trim(int2str(k))//','          &
280                      //trim(int2str(j))//','          &
281                      //trim(int2str(i))//')",t'       &
282                      //trim(int2str(pos+offset))      &   
283                      //'," ---> ",g22.16," | ")'
284! d�pent de l'impl�mention, sur compaq, c'est necessaire
285!            Pos=Pos+ColumnSize
286          endif
287          write (id,form,advance='no') Field(k,j,i)
288        enddo
289        if (MOD(nb,NbCol)==0) then
290          write (id,spacing)
291        else
292          write (id,'("")')
293          write (id,spacing)
294        endif
295      enddo
296      write (id,spacing)
297    enddo
298   
299    close(id)
300 
301  end subroutine write_field3D 
302 
303  function int2str(int)
304    implicit none
305    integer, parameter :: MaxLen=10
306    integer,intent(in) :: int
307    character(len=MaxLen) :: int2str
308    logical :: flag
309    integer :: i
310    flag=.true.
311   
312    i=int
313   
314    int2str=''
315    do while (flag)
316      int2str=CHAR(MOD(i,10)+48)//int2str
317      i=i/10
318      if (i==0) flag=.false.
319    enddo
320  end function int2str
321
322end module write_field
323 
Note: See TracBrowser for help on using the repository browser.