source: trunk/LMDZ.GENERIC/libf/phystd/writediagsoil.F90 @ 537

Last change on this file since 537 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 8.4 KB
Line 
1subroutine writediagsoil(ngrid,name,title,units,dimpx,px)
2
3! Write variable 'name' to NetCDF file 'diagsoil.nc'.
4! The variable may be 3D (lon,lat,depth) subterranean field,
5! a 2D (lon,lat) surface field, or a simple scalar (0D variable).
6!
7! Calls to 'writediagsoil' can originate from anywhere in the program;
8! An initialisation of variable 'name' is done if it is the first time
9! that this routine is called with given 'name'; otherwise data is appended
10! (yielding the sought time series of the variable)
11
12implicit none
13
14#include"dimensions.h"
15#include"dimphys.h"
16#include"paramet.h"
17#include"control.h"
18#include"comsoil.h"
19#include"netcdf.inc"
20
21! Arguments:
22integer,intent(in) :: ngrid ! number of (horizontal) points of physics grid
23! i.e. ngrid = 2+(jjm-1)*iim - 1/jjm
24character(len=*),intent(in) :: name ! 'name' of the variable
25character(len=*),intent(in) :: title ! 'long_name' attribute of the variable
26character(len=*),intent(in) :: units ! 'units' attribute of the variable
27integer,intent(in) :: dimpx ! dimension of the variable (3,2 or 0)
28real,dimension(ngrid,nsoilmx),intent(in) :: px ! variable
29! Note: nsoilmx is a common parameter set in 'dimphys.h'
30
31! Local variables:
32real,dimension(iip1,jjp1,nsoilmx) :: data3 ! to store 3D data
33! Note iip1,jjp1 known from paramet.h; nsoilmx known from dimphys.h
34real,dimension(iip1,jjp1) :: data2 ! to store 2D data
35real :: data0 ! to store 0D data
36integer :: i,j,l ! for loops
37integer :: ig0
38
39real,save :: date ! time counter (in elapsed days)
40integer,save :: isample ! sample rate at which data is to be written to output
41integer,save :: ntime=0 ! counter to internally store time steps
42character(len=20),save :: firstname="1234567890"
43integer,save :: zitau=0
44
45character(len=30) :: filename="diagsoil.nc"
46
47! NetCDF stuff:
48integer :: nid ! NetCDF output file ID
49integer :: varid ! NetCDF ID of a variable
50integer :: ierr ! NetCDF routines return code
51integer,dimension(4) :: id ! NetCDF IDs of the dimensions of the variable
52integer,dimension(4) :: edges,corners
53
54! 1. Initialization step
55if (firstname.eq."1234567890") then
56  ! Store 'name' as 'firstname'
57  firstname=name
58  ! From now on, if 'name'.eq.'firstname', then it is a new time cycle
59
60  ! just to be sure, check that firstnom is large enough to hold nom
61  if (len_trim(firstname).lt.len_trim(name)) then
62    write(*,*) "writediagsoil: Error !!!"
63    write(*,*) "   firstname string not long enough!!"
64    write(*,*) "   increase its size to at least ",len_trim(name)
65    stop
66  endif
67 
68  ! Set output sample rate
69  isample=int(ecritphy) ! same as for diagfi outputs
70  ! Note ecritphy is known from control.h
71 
72  ! Create output NetCDF file
73  ierr=NF_CREATE(filename,NF_CLOBBER,nid)
74  if (ierr.ne.NF_NOERR) then
75    write(*,*)'writediagsoil: Error, failed creating file '//trim(filename)
76    stop
77  endif
78 
79  ! Define dimensions and axis attributes
80  call iniwritesoil(nid)
81 
82  ! set zitau to -1 to be compatible with zitau incrementation step below
83  zitau=-1
84 
85else
86  ! If not an initialization call, simply open the NetCDF file
87  ierr=NF_OPEN(filename,NF_WRITE,nid)
88endif ! of if (firstname.eq."1234567890")
89
90! 2. Increment local time counter, if necessary
91if (name.eq.firstname) then
92  ! if we run across 'firstname', then it is a new time step
93  zitau=zitau+iphysiq
94  ! Note iphysiq is known from control.h
95endif
96
97! 3. Write data, if the time index matches the sample rate
98if (mod(zitau+1,isample).eq.0) then
99
100! 3.1 If first call at this date, update 'time' variable
101  if (name.eq.firstname) then
102    ntime=ntime+1
103    date=float(zitau+1)/float(day_step)
104    ! Note: day_step is known from control.h
105   
106    ! Get NetCDF ID for "time"
107    ierr=NF_INQ_VARID(nid,"time",varid)
108    ! Add the current value of date to the "time" array
109#ifdef NC_DOUBLE
110    ierr=NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
111#else
112    ierr=NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
113#endif
114    if (ierr.ne.NF_NOERR) then
115      write(*,*)"writediagsoil: Failed writing date to time variable"
116      stop
117    endif
118  endif ! of if (name.eq.firstname)
119
120! 3.2 Write the variable to the NetCDF file
121if (dimpx.eq.3) then ! Case of a 3D variable
122  ! A. Recast data along 'dynamics' grid
123  do l=1,nsoilmx
124    ! handle the poles
125    do i=1,iip1
126      data3(i,1,l)=px(1,l)
127      data3(i,jjp1,l)=px(ngrid,l)
128    enddo
129    ! rest of the grid
130    do j=2,jjm
131      ig0=1+(j-2)*iim
132      do i=1,iim
133        data3(i,j,l)=px(ig0+i,l)
134      enddo
135      data3(iip1,j,l)=data3(1,j,l) ! extra (modulo) longitude
136    enddo
137  enddo
138 
139  ! B. Write (append) the variable to the NetCDF file
140  ! B.1. Get the ID of the variable
141  ierr=NF_INQ_VARID(nid,name,varid)
142  if (ierr.ne.NF_NOERR) then
143    ! If we failed geting the variable's ID, we assume it is because
144    ! the variable doesn't exist yet and must be created.
145    ! Start by obtaining corresponding dimensions IDs
146    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
147    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
148    ierr=NF_INQ_DIMID(nid,"depth",id(3))
149    ierr=NF_INQ_DIMID(nid,"time",id(4))
150    ! Tell the world about it
151    write(*,*) "====================="
152    write(*,*) "writediagsoil: creating variable "//trim(name)
153    call def_var(nid,name,title,units,4,id,varid,ierr)
154  endif ! of if (ierr.ne.NF_NOERR)
155 
156  ! B.2. Prepare things to be able to write/append the variable
157  corners(1)=1
158  corners(2)=1
159  corners(3)=1
160  corners(4)=ntime
161 
162  edges(1)=iip1
163  edges(2)=jjp1
164  edges(3)=nsoilmx
165  edges(4)=1
166 
167  ! B.3. Write the slab of data
168#ifdef NC_DOUBLE
169  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data3)
170#else
171  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data3)
172#endif
173  if (ierr.ne.NF_NOERR) then
174    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
175               " to file "//trim(filename)//" at time",date
176  endif
177
178elseif (dimpx.eq.2) then ! Case of a 2D variable
179  ! A. Recast data along 'dynamics' grid
180  ! handle the poles
181  do i=1,iip1
182    data2(i,1)=px(1,1)
183    data2(i,jjp1)=px(ngrid,1)
184  enddo
185  ! rest of the grid
186  do j=2,jjm
187    ig0=1+(j-2)*iim
188    do i=1,iim
189      data2(i,j)=px(ig0+i,1)
190    enddo
191    data2(iip1,j)=data2(1,j) ! extra (modulo) longitude
192  enddo
193
194  ! B. Write (append) the variable to the NetCDF file
195  ! B.1. Get the ID of the variable
196  ierr=NF_INQ_VARID(nid,name,varid)
197  if (ierr.ne.NF_NOERR) then
198    ! If we failed geting the variable's ID, we assume it is because
199    ! the variable doesn't exist yet and must be created.
200    ! Start by obtaining corresponding dimensions IDs
201    ierr=NF_INQ_DIMID(nid,"longitude",id(1))
202    ierr=NF_INQ_DIMID(nid,"latitude",id(2))
203    ierr=NF_INQ_DIMID(nid,"time",id(3))
204    ! Tell the world about it
205    write(*,*) "====================="
206    write(*,*) "writediagsoil: creating variable "//trim(name)
207    call def_var(nid,name,title,units,3,id,varid,ierr)
208  endif ! of if (ierr.ne.NF_NOERR)
209
210  ! B.2. Prepare things to be able to write/append the variable
211  corners(1)=1
212  corners(2)=1
213  corners(3)=ntime
214 
215  edges(1)=iip1
216  edges(2)=jjp1
217  edges(3)=1
218 
219  ! B.3. Write the slab of data
220#ifdef NC_DOUBLE
221  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data2)
222#else
223  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data2)
224#endif
225  if (ierr.ne.NF_NOERR) then
226    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
227               " to file "//trim(filename)//" at time",date
228  endif
229
230elseif (dimpx.eq.0) then ! Case of a 0D variable
231  ! A. Copy data value
232  data0=px(1,1)
233
234  ! B. Write (append) the variable to the NetCDF file
235  ! B.1. Get the ID of the variable
236  ierr=NF_INQ_VARID(nid,name,varid)
237  if (ierr.ne.NF_NOERR) then
238    ! If we failed geting the variable's ID, we assume it is because
239    ! the variable doesn't exist yet and must be created.
240    ! Start by obtaining corresponding dimensions IDs
241    ierr=NF_INQ_DIMID(nid,"time",id(1))
242    ! Tell the world about it
243    write(*,*) "====================="
244    write(*,*) "writediagsoil: creating variable "//trim(name)
245    call def_var(nid,name,title,units,1,id,varid,ierr)
246  endif ! of if (ierr.ne.NF_NOERR)
247
248  ! B.2. Prepare things to be able to write/append the variable
249  corners(1)=ntime
250 
251  edges(1)=1
252
253  ! B.3. Write the data
254#ifdef NC_DOUBLE
255  ierr=NF_PUT_VARA_DOUBLE(nid,varid,corners,edges,data0)
256#else
257  ierr=NF_PUT_VARA_REAL(nid,varid,corners,edges,data0)
258#endif
259  if (ierr.ne.NF_NOERR) then
260    write(*,*) "writediagsoil: Error: Failed writing "//trim(name)//&
261               " to file "//trim(filename)//" at time",date
262  endif
263
264endif ! of if (dimpx.eq.3) elseif (dimpx.eq.2) ...
265endif ! of if (mod(zitau+1,isample).eq.0)
266
267! 4. Close the NetCDF file
268ierr=NF_CLOSE(nid)
269
270end subroutine writediagsoil
Note: See TracBrowser for help on using the repository browser.