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

Last change on this file since 363 was 363, checked in by bellier, 16 years ago

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