source: IOIPSL/trunk/example/testflio.f90 @ 887

Last change on this file since 887 was 887, checked in by bellier, 14 years ago

using new fillvalue argument in fliodefv
  • Property svn:keywords set to Id
File size: 11.3 KB
Line 
1PROGRAM testflio
2!-
3!$Id$
4!-
5! This software is governed by the CeCILL license
6! See IOIPSL/IOIPSL_License_CeCILL.txt
7!---------------------------------------------------------------------
8!- This program is an example of how to use "fliocom".
9!---------------------------------------------------------------------
10  USE ioipsl
11  USE defprec
12!-
13  IMPLICIT NONE
14!-
15  INTEGER,PARAMETER :: iimf=3, jjmf=2, llmf=3, itmf=5
16!-
17  REAL,DIMENSION(iimf,jjmf,llmf,itmf) :: forcing
18  REAL,DIMENSION(iimf,jjmf)           :: lonf,latf
19  REAL,DIMENSION(llmf)                :: levf
20  INTEGER,DIMENSION(itmf)             :: itauf
21  REAL :: parf=7.
22!-
23! REAL,DIMENSION(iimf,jjmf,llmf,itmf) :: forcingw
24  REAL,DIMENSION(iimf)                :: lonw
25  REAL,DIMENSION(jjmf)                :: latw
26  REAL,DIMENSION(llmf)                :: levw
27  INTEGER,DIMENSION(itmf)             :: itauw
28! REAL :: parw
29!-
30  CHARACTER(LEN=10),DIMENSION(flio_max_dims) :: f_n_d
31  INTEGER,DIMENSION(flio_max_dims) :: f_l_d,f_i_d
32  INTEGER :: i_t_w,n_d_w,n_a_w
33  INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w,i_d_w
34  LOGICAL :: exv,exa
35  INTEGER :: iim,jjm,llm,ttm
36  INTEGER :: i,j,l,it,fid,id_dom
37  CHARACTER(LEN=25) :: f_n,v_n,c_n,c_tmp=' '
38  INTEGER :: year,month,day
39  REAL :: date,datew,dt,dtw,sec
40  REAL,DIMENSION(10) :: r_w
41  CHARACTER(LEN=30),DIMENSION(:),ALLOCATABLE :: cn_d,cn_v,cn_a
42  CHARACTER(LEN=30) :: cn_u,f_n_c
43!---------------------------------------------------------------------
44!-
45! Create a file for the lateral forcing
46!-
47  DO i=1,iimf
48    DO j=1,jjmf
49      lonf(i,j) = (REAL(i-1)/REAL(MAX(iimf-1,1)))*180.
50      latf(i,j) = (REAL(j-1)/REAL(MAX(jjmf-1,1)))*90.
51    ENDDO
52  ENDDO
53!-
54  levf(1:3) = (/ 0.7, 0.5, 0.3 /)
55!-
56  DO it = 1,itmf
57    itauf(it) = it+10
58    DO i=1,iimf
59      DO j=1,jjmf
60        DO l=1,llmf
61          forcing(i,j,l,it) = 10.*(10.*((10.*it)+l)+j)+i
62        ENDDO
63      ENDDO
64    ENDDO
65  ENDDO
66!-
67  WRITE (*,'(" -----------------------------")')
68  WRITE (*,'(" ------- Using fliocom -------")')
69  WRITE (*,'(" -----------------------------")')
70  WRITE(*,'(/," ",A,3(1X,I5))') &
71 &  'flio_max_files,flio_max_dims,flio_max_var_dims : ', &
72 &   flio_max_files,flio_max_dims,flio_max_var_dims
73!-
74  year = 1997; month = 5; day = 10; sec = 0.;
75  CALL ymds2ju (year,month,day,sec,date)
76  dt = 86400./2.
77  WRITE (*,'(/," ----------------------------------")')
78  WRITE (*,'(/," t_init : ",F11.3)') date
79!-
80! Create a file and add variables and attributes
81!-
82  WRITE (*,'(/," ----------------------------------")')
83!-
84  f_n = 'testflio.nc'
85  f_l_d(1:5) = (/  iimf,  jjmf,  llmf,    -1,   10   /)
86  f_n_d(1:5) = (/ "lon ","lat ","lev ","time","ud1 " /)
87!-
88  CALL flio_dom_set &
89 & (1,1,(/1,2/),(/iimf,jjmf/),(/iimf,jjmf/), &
90 &  (/1,1/),(/iimf,jjmf/),(/0,0/),(/0,0/),"orange",id_dom)
91  WRITE (*,'(/," --> fliocrfd (",A,",...)")') TRIM(f_n)
92  CALL fliocrfd (TRIM(f_n),f_n_d(1:5),f_l_d(1:5),fid, &
93 &               id_dom=id_dom,c_f_n=f_n_c)
94  WRITE (*,'(/,"   created file name : ",A)') TRIM(f_n_c)
95  CALL flio_dom_unset (id_dom)
96!-
97  WRITE (*,'(/," --> fliopstc")')
98  CALL fliopstc (fid, &
99 &  x_axis_2d=lonf(:,:),y_axis_2d=latf(:,:),z_axis=levf(:), &
100 &  t_axis=itauf(:),t_init=date,t_step=dt,t_calendar="gregorian")
101!-
102  CALL fliodefv (fid,'forcing',(/ 1,2,3,4 /), &
103 &               v_t=flio_r4,units='1',long_name='Forcing field')
104  CALL flioputa (fid,'forcing','vecteur_3',(/3.,5.,7./))
105  CALL flioputa (fid,'forcing','text_n',"Text attribute")
106  CALL fliodefv (fid,'my_var_1',(/ 5 /), &
107 &               v_t=flio_r4,units='1',long_name='my_var_1', &
108 &               valid_min=-10.,valid_max=+20.,fillvalue=+50.)
109  CALL fliodefv (fid,'Var_vr4', &
110 &               v_t=flio_r4,units='1',long_name='Var_vr4')
111  CALL flioputa (fid,'Var_vr4','att_1',735)
112  CALL flioputa (fid,'?','Param_a4',REAL(parf,KIND=4))
113  CALL fliodefv (fid,'Var_vr8', &
114 &               v_t=flio_r8,units='1',long_name='Var_vr8')
115  CALL fliocpya (fid,'Var_vr4','att_1',fid,'Var_vr8')
116  CALL flioputa (fid,'?','Param_a8',REAL(parf,KIND=8))
117  CALL fliodefv (fid,'Var_vi2', &
118 &               v_t=flio_i2,units='1',long_name='Var_vi2')
119  CALL flioputv (fid,'forcing',forcing)
120  CALL flioputv (fid,'my_var_1',(/3.,4.,5./),start=(/3/))
121  CALL flioputv (fid,'Var_vr4',parf)
122  CALL flioputv (fid,'Var_vr8',parf)
123  CALL flioputv (fid,'Var_vi2',INT(parf,KIND=i_2))
124!-
125  WRITE (*,'(/," --> flioclo")')
126  CALL flioclo (fid)
127!-
128! Inspect the file
129!-
130  WRITE (*,'(/," ----------------------------------")')
131!-
132  WRITE (*,'(/," --> fliodmpf")')
133  CALL fliodmpf (TRIM(f_n_c))
134!-
135! Open the file and obtain information about the file
136!-
137  WRITE (*,'(/," ----------------------------------")')
138!-
139  WRITE (*,'(/," --> flioopfd")')
140  i = 0; j = 0; l = 0;
141  CALL flioopfd (TRIM(f_n_c),fid,nb_dim=i,nb_var=j,nb_gat=l)
142  WRITE (*,'(" Number of dimensions        in the file : ",I2)') i
143  WRITE (*,'(" Number of variables         in the file : ",I2)') j
144  WRITE (*,'(" Number of global attributes in the file : ",I2)') l
145!-
146  WRITE (*,'(/," --> flioinqf")')
147  CALL flioinqf &
148 & (fid,id_dim=f_i_d,ln_dim=f_l_d)
149  IF (i > 0) THEN
150    WRITE (*,'(" Identifiers of the dimensions :",/,(5(1X,I7),:))') &
151 &    f_i_d(1:MIN(i,SIZE(f_i_d)))
152    WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
153 &    f_l_d(1:MIN(i,SIZE(f_l_d)))
154  ENDIF
155!-
156  WRITE (*,'(/," --> flioinqn")')
157  ALLOCATE(cn_d(i),cn_v(j),cn_a(l))
158  CALL flioinqn (fid,cn_dim=cn_d,cn_var=cn_v,cn_gat=cn_a,cn_uld=cn_u)
159  WRITE (*,'(" Names of the dimensions in the file : ")')
160  DO it=1,i
161    WRITE (*,'("   """,A,"""")') TRIM(cn_d(it))
162  ENDDO
163  WRITE (*,'(" Names of the variables in the file : ")')
164  DO it=1,j
165    WRITE (*,'("   """,A,"""")') TRIM(cn_v(it))
166  ENDDO
167  WRITE (*,'(" Names of the global attributes in the file : ")')
168  DO it=1,l
169    WRITE (*,'("   """,A,"""")') TRIM(cn_a(it))
170  ENDDO
171  WRITE (*,'(" Name of the unlimited dimension : ")')
172  WRITE (*,'("   """,A,"""")') TRIM(cn_u)
173  DEALLOCATE(cn_d,cn_v,cn_a)
174!-
175  WRITE (*,'(/," --> flioqstc")')
176  c_n = "x"
177  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
178  IF (exv) THEN
179    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
180 &   TRIM(c_n),TRIM(v_n)
181    CALL flioinqv &
182 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
183    IF (n_d_w > 0) THEN
184      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
185      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
186 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
187      iim=l_d_w(1)
188    ENDIF
189    IF (n_a_w > 0) THEN
190      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
191    ENDIF
192  ELSE
193    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
194  ENDIF
195!-
196  WRITE (*,'(/," --> flioqstc")')
197  c_n = "y"
198  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
199  IF (exv) THEN
200    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
201 &   TRIM(c_n),TRIM(v_n)
202    CALL flioinqv &
203 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
204    IF (n_d_w > 0) THEN
205      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
206      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
207 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
208      jjm=l_d_w(n_d_w)
209    ENDIF
210    IF (n_a_w > 0) THEN
211      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
212    ENDIF
213  ELSE
214    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
215  ENDIF
216!-
217  WRITE (*,'(/," --> flioqstc")')
218  c_n = "z"
219  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
220  IF (exv) THEN
221    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
222 &   TRIM(c_n),TRIM(v_n)
223    CALL flioinqv &
224 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
225    IF (n_d_w > 0) THEN
226      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
227      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
228 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
229      llm=l_d_w(1)
230    ENDIF
231    IF (n_a_w > 0) THEN
232      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
233    ENDIF
234  ELSE
235    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
236  ENDIF
237!-
238  WRITE (*,'(/," --> flioqstc")')
239  c_n = "t"
240  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
241  IF (exv) THEN
242    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
243 &   TRIM(c_n),TRIM(v_n)
244    CALL flioinqv &
245 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
246    IF (n_d_w > 0) THEN
247      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
248      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
249 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
250      ttm=l_d_w(1)
251    ENDIF
252    IF (n_a_w > 0) THEN
253      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
254    ENDIF
255  ELSE
256    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
257  ENDIF
258!-
259  WRITE (*,'(/," --> fliogstc")')
260  CALL fliogstc (fid, &
261 &  x_axis=lonw,y_axis=latw,z_axis=levw, &
262 &  t_axis=itauw(:),t_init=datew,t_step=dtw,t_calendar=c_tmp, &
263 &  t_count=3)
264  WRITE (*,'(" x_axis :",/,(5(1X,1PE11.3),:))') lonw(1:iim)
265  WRITE (*,'(" y_axis :",/,(5(1X,1PE11.3),:))') latw(1:jjm)
266  WRITE (*,'(" z_axis :",/,(5(1X,1PE11.3),:))') levw(1:llm)
267  WRITE (*,'(" t_axis(1:3) :",/,(5(1X,I5),:))') itauw(1:3)
268  WRITE (*,'(" t_calendar  : ",A)') '"'//TRIM(c_tmp)//'"'
269  WRITE (*,'(" t_init,t_step :",(2(1X,1PE15.7),:))') datew,dtw
270!-
271  v_n = 'forcing'
272  WRITE (*,'(/," Variable : """,A,"""")') TRIM(v_n)
273  WRITE (*,'(" --> flioinqv(...,""",A,""",...)")') TRIM(v_n)
274  CALL flioinqv &
275 & (fid,TRIM(v_n),exv,v_t=i_t_w, &
276 &  nb_dims=n_d_w,len_dims=l_d_w,id_dims=i_d_w,nb_atts=n_a_w)
277  IF (exv) THEN
278    WRITE (*,'(" External type        : ",I2)') i_t_w
279    WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
280    WRITE (*,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:n_d_w)
281    WRITE (*,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:n_d_w)
282    WRITE (*,'(" Number of attributes : ",I2)') n_a_w
283!---
284    IF (n_a_w > 0) THEN
285      ALLOCATE(cn_a(5))
286      CALL flioinqv (fid,TRIM(v_n),exv,cn_atts=cn_a)
287      WRITE (*,'(" Names of the attributes : ")')
288      DO it=1,n_a_w
289        WRITE (*,'("   """,A,"""")') TRIM(cn_a(it))
290      ENDDO
291      DEALLOCATE(cn_a)
292    ENDIF
293!---
294    WRITE (*, &
295 &   '(" --> flioinqa(...,""",A,""",""text_n"",...)")') TRIM(v_n)
296    CALL flioinqa (fid,TRIM(v_n),"text_n",exa,a_l=l)
297    IF (exa) THEN
298      WRITE (*,'("  len(text_n) : ",I3)') l
299!-----
300      WRITE (*,'(" --> fliogeta(...,""",A,""",""text_n"",...)")') &
301 &     TRIM(v_n)
302      CALL fliogeta (fid,TRIM(v_n),"text_n",c_tmp)
303      WRITE (*,'("  ""text_n"" : """,A,"""")') TRIM(c_tmp)
304    ELSE
305      WRITE (*,'(" Attribute not found")')
306    ENDIF
307  ELSE
308    WRITE (*,'(" Variable not found")')
309  ENDIF
310!-
311  v_n = 'my_var_1'
312  WRITE (*,'(/," Variable : """,A,"""")') TRIM(v_n)
313  WRITE (*,'(" --> flioinqv(...,""",A,""",...)")') TRIM(v_n)
314  CALL flioinqv &
315 & (fid,TRIM(v_n),exv, &
316 &  nb_dims=n_d_w,len_dims=l_d_w,id_dims=i_d_w,nb_atts=n_a_w)
317  IF (exv) THEN
318    WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
319    WRITE (*,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:n_d_w)
320    WRITE (*,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:n_d_w)
321    WRITE (*,'(" Number of attributes : ",I2)') n_a_w
322    WRITE (*,'(" --> fliogetv(...,""",A,""",...)")') TRIM(v_n)
323    CALL fliogetv (fid,TRIM(v_n),r_w)
324    WRITE (*, &
325 &   '("  Values :",/,(5(1X,1PE11.3),:))') r_w
326    i = 2; j = 5;
327    WRITE (*,'(" --> fliogetv(...,",A, &
328 &             ",start=(/",I2,"/),count=(/",I2,"/))")') &
329 &   '"'//TRIM(v_n)//'"',i,j
330    CALL fliogetv (fid,TRIM(v_n),r_w,start=(/i/),count=(/j/))
331    WRITE (*, &
332 &   '("  Values(",I2,":",I2,") :",/,(5(1X,1PE11.3),:))') &
333 &   i,i+j-1,r_w(1:j)
334  ENDIF
335!-
336  WRITE (*,'(/," --> flioclo")')
337  CALL flioclo (fid)
338!-
339  WRITE (*,'(/," ----------------------------------")')
340!-------------------
341END PROGRAM testflio
Note: See TracBrowser for help on using the repository browser.