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

Last change on this file since 5259 was 5257, checked in by abarral, 8 hours ago

Use int2str from strings_mod in write_field.F90. Only expose WriteField?.
  • 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.5 KB
Line 
1!
2! $Id: write_field.F90 5257 2024-10-22 14:17:07Z abarral $
3!
4module write_field
5  USE strings_mod, ONLY: int2str
6  IMPLICIT NONE; PRIVATE
7  PUBLIC WriteField
8
9  integer, parameter :: MaxWriteField = 100
10  integer, dimension(MaxWriteField),save :: FieldId
11  integer, dimension(MaxWriteField),save :: FieldVarId
12  integer, dimension(MaxWriteField),save :: FieldIndex
13  character(len=255), dimension(MaxWriteField) ::  FieldName
14   
15  integer,save :: NbField = 0
16 
17  interface WriteField
18    module procedure WriteField3d,WriteField2d,WriteField1d
19  end interface WriteField
20  contains
21 
22    function GetFieldIndex(name)
23    implicit none
24      integer          :: GetFieldindex
25      character(len=*) :: name
26   
27      character(len=255) :: TrueName
28      integer            :: i
29       
30     
31      TrueName=TRIM(ADJUSTL(name))
32   
33      GetFieldIndex=-1
34      do i=1,NbField
35        if (TrueName==FieldName(i)) then
36          GetFieldIndex=i
37          exit
38        endif
39      enddo
40    end function GetFieldIndex
41 
42    subroutine WriteField3d(name,Field)
43    implicit none
44      character(len=*) :: name
45      real, dimension(:,:,:) :: Field
46      integer, dimension(3) :: Dim
47     
48      Dim=shape(Field)
49      call WriteField_gen(name,Field,Dim(1),Dim(2),Dim(3)) 
50 
51    end subroutine WriteField3d
52   
53    subroutine WriteField2d(name,Field)
54    implicit none
55      character(len=*) :: name
56      real, dimension(:,:) :: Field
57      integer, dimension(2) :: Dim
58     
59      Dim=shape(Field)
60      call WriteField_gen(name,Field,Dim(1),Dim(2),1) 
61 
62    end subroutine WriteField2d
63   
64    subroutine WriteField1d(name,Field)
65    implicit none
66      character(len=*) :: name
67      real, dimension(:) :: Field
68      integer, dimension(1) :: Dim
69     
70      Dim=shape(Field)
71      call WriteField_gen(name,Field,Dim(1),1,1) 
72 
73    end subroutine WriteField1d
74       
75    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
76    implicit none
77    include 'netcdf.inc'
78      character(len=*) :: name
79      integer :: dimx,dimy,dimz
80      real,dimension(dimx,dimy,dimz) :: Field
81      integer,dimension(dimx*dimy*dimz) :: ndex
82      integer :: status
83      integer :: index
84      integer :: start(4)
85      integer :: count(4)
86     
87           
88      Index=GetFieldIndex(name)
89      if (Index==-1) then
90        call CreateNewField(name,dimx,dimy,dimz)
91        Index=GetFieldIndex(name)
92      else
93        FieldIndex(Index)=FieldIndex(Index)+1.
94      endif
95     
96      start(1)=1
97      start(2)=1
98      start(3)=1
99      start(4)=FieldIndex(Index)
100
101      count(1)=dimx
102      count(2)=dimy
103      count(3)=dimz
104      count(4)=1
105
106      status = NF_PUT_VARA_DOUBLE(FieldId(Index),FieldVarId(Index),start,count,Field)
107      status = NF_SYNC(FieldId(Index))
108     
109    end subroutine WriteField_gen
110       
111    subroutine CreateNewField(name,dimx,dimy,dimz)
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
308end module write_field
309 
Note: See TracBrowser for help on using the repository browser.