source: dynamico_lmdz/aquaplanet/LMDZ5/libf/misc/write_field.F90 @ 3897

Last change on this file since 3897 was 3814, checked in by ymipsl, 10 years ago

remove all dynamic dependency in LMDZ physics except for the include "dimensions.h"

YM
File size: 8.9 KB
Line 
1!
2! $Id: write_field.F90 2239 2015-03-23 07:27:30Z emillour $
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.