source: LMDZ6/trunk/libf/misc/write_field.F90 @ 5208

Last change on this file since 5208 was 5084, checked in by Laurent Fairhead, 5 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF
  • 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.8 KB
Line 
1!
2! $Id: write_field.F90 5084 2024-07-19 16:40:44Z fairhead $
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    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
325end module write_field
326 
Note: See TracBrowser for help on using the repository browser.