source: IOIPSL/tags/v2_1_3/example/testflio.f90 @ 369

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

JB: add Id (ommited !)
  • Property svn:keywords set to Id
File size: 11.0 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 /),units='_',v_t=flio_r4)
100  CALL flioputa (fid,'forcing','vecteur_3',(/3.,5.,7./))
101  CALL flioputa (fid,'forcing','text_n',"Text attribute")
102  CALL fliodefv (fid,'my_var_1',(/ 5 /), &
103 &               v_t=flio_r4,units='_',valid_min=-10.,valid_max=+20.)
104  CALL fliodefv (fid,'Var_vr4',v_t=flio_r4,units='_')
105  CALL flioputa (fid,'Var_vr4','att_1',735)
106  CALL flioputa (fid,'?','Param_a4',REAL(parf,KIND=4))
107  CALL fliodefv (fid,'Var_vr8',v_t=flio_r8,units='_')
108  CALL fliocpya (fid,'Var_vr4','att_1',fid,'Var_vr8')
109  CALL flioputa (fid,'?','Param_a8',REAL(parf,KIND=8))
110  CALL fliodefv (fid,'Var_vi2',v_t=flio_i2,units='_')
111  CALL flioputv (fid,'forcing',forcing)
112  CALL flioputv (fid,'my_var_1',(/3.,4.,5./),start=(/3/))
113  CALL flioputv (fid,'Var_vr4',parf)
114  CALL flioputv (fid,'Var_vr8',parf)
115  CALL flioputv (fid,'Var_vi2',INT(parf,KIND=i_2))
116!-
117  WRITE (*,'(/," --> flioclo")')
118  CALL flioclo (fid)
119!-
120! Inspect the file
121!-
122  WRITE (*,'(/," ----------------------------------")')
123!-
124  WRITE (*,'(/," --> fliodmpf")')
125  CALL fliodmpf (TRIM(f_n_c))
126!-
127! Open the file and obtain information about the file
128!-
129  WRITE (*,'(/," ----------------------------------")')
130!-
131  WRITE (*,'(/," --> flioopfd")')
132  i = 0; j = 0; l = 0;
133  CALL flioopfd (TRIM(f_n_c),fid,nb_dim=i,nb_var=j,nb_gat=l)
134  WRITE (*,'(" Number of dimensions        in the file : ",I2)') i
135  WRITE (*,'(" Number of variables         in the file : ",I2)') j
136  WRITE (*,'(" Number of global attributes in the file : ",I2)') l
137!-
138  WRITE (*,'(/," --> flioinqf")')
139  CALL flioinqf &
140 & (fid,id_dim=f_i_d,ln_dim=f_l_d)
141  IF (i > 0) THEN
142    WRITE (*,'(" Identifiers of the dimensions :",/,(5(1X,I7),:))') &
143 &    f_i_d(1:MIN(i,SIZE(f_i_d)))
144    WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
145 &    f_l_d(1:MIN(i,SIZE(f_l_d)))
146  ENDIF
147!-
148  WRITE (*,'(/," --> flioinqn")')
149  ALLOCATE(cn_d(i),cn_v(j),cn_a(l))
150  CALL flioinqn (fid,cn_dim=cn_d,cn_var=cn_v,cn_gat=cn_a,cn_uld=cn_u)
151  WRITE (*,'(" Names of the dimensions in the file : ")')
152  DO it=1,i
153    WRITE (*,'("   """,A,"""")') TRIM(cn_d(it))
154  ENDDO
155  WRITE (*,'(" Names of the variables in the file : ")')
156  DO it=1,j
157    WRITE (*,'("   """,A,"""")') TRIM(cn_v(it))
158  ENDDO
159  WRITE (*,'(" Names of the global attributes in the file : ")')
160  DO it=1,l
161    WRITE (*,'("   """,A,"""")') TRIM(cn_a(it))
162  ENDDO
163  WRITE (*,'(" Name of the unlimited dimension : ")')
164  WRITE (*,'("   """,A,"""")') TRIM(cn_u)
165  DEALLOCATE(cn_d,cn_v,cn_a)
166!-
167  WRITE (*,'(/," --> flioqstc")')
168  c_n = "x"
169  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
170  IF (exv) THEN
171    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
172 &   TRIM(c_n),TRIM(v_n)
173    CALL flioinqv &
174 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
175    IF (n_d_w > 0) THEN
176      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
177      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
178 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
179      iim=l_d_w(1)
180    ENDIF
181    IF (n_a_w > 0) THEN
182      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
183    ENDIF
184  ELSE
185    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
186  ENDIF
187!-
188  WRITE (*,'(/," --> flioqstc")')
189  c_n = "y"
190  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
191  IF (exv) THEN
192    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
193 &   TRIM(c_n),TRIM(v_n)
194    CALL flioinqv &
195 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
196    IF (n_d_w > 0) THEN
197      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
198      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
199 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
200      jjm=l_d_w(n_d_w)
201    ENDIF
202    IF (n_a_w > 0) THEN
203      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
204    ENDIF
205  ELSE
206    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
207  ENDIF
208!-
209  WRITE (*,'(/," --> flioqstc")')
210  c_n = "z"
211  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
212  IF (exv) THEN
213    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
214 &   TRIM(c_n),TRIM(v_n)
215    CALL flioinqv &
216 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
217    IF (n_d_w > 0) THEN
218      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
219      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
220 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
221      llm=l_d_w(1)
222    ENDIF
223    IF (n_a_w > 0) THEN
224      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
225    ENDIF
226  ELSE
227    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
228  ENDIF
229!-
230  WRITE (*,'(/," --> flioqstc")')
231  c_n = "t"
232  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
233  IF (exv) THEN
234    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
235 &   TRIM(c_n),TRIM(v_n)
236    CALL flioinqv &
237 &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
238    IF (n_d_w > 0) THEN
239      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
240      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
241 &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
242      ttm=l_d_w(1)
243    ENDIF
244    IF (n_a_w > 0) THEN
245      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
246    ENDIF
247  ELSE
248    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
249  ENDIF
250!-
251  WRITE (*,'(/," --> fliogstc")')
252  CALL fliogstc (fid, &
253 &  x_axis=lonw,y_axis=latw,z_axis=levw, &
254 &  t_axis=itauw(:),t_init=datew,t_step=dtw,t_calendar=c_tmp, &
255 &  t_count=3)
256  WRITE (*,'(" x_axis :",/,(5(1X,1PE11.3),:))') lonw(1:iim)
257  WRITE (*,'(" y_axis :",/,(5(1X,1PE11.3),:))') latw(1:jjm)
258  WRITE (*,'(" z_axis :",/,(5(1X,1PE11.3),:))') levw(1:llm)
259  WRITE (*,'(" t_axis(1:3) :",/,(5(1X,I5),:))') itauw(1:3)
260  WRITE (*,'(" t_calendar  : ",A)') '"'//TRIM(c_tmp)//'"'
261  WRITE (*,'(" t_init,t_step :",(2(1X,1PE15.7),:))') datew,dtw
262!-
263  v_n = 'forcing'
264  WRITE (*,'(/," Variable : """,A,"""")') TRIM(v_n)
265  WRITE (*,'(" --> flioinqv(...,""",A,""",...)")') TRIM(v_n)
266  CALL flioinqv &
267 & (fid,TRIM(v_n),exv,v_t=i_t_w, &
268 &  nb_dims=n_d_w,len_dims=l_d_w,id_dims=i_d_w,nb_atts=n_a_w)
269  IF (exv) THEN
270    WRITE (*,'(" External type        : ",I2)') i_t_w
271    WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
272    WRITE (*,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:n_d_w)
273    WRITE (*,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:n_d_w)
274    WRITE (*,'(" Number of attributes : ",I2)') n_a_w
275!---
276    IF (n_a_w > 0) THEN
277      ALLOCATE(cn_a(5))
278      CALL flioinqv (fid,TRIM(v_n),exv,cn_atts=cn_a)
279      WRITE (*,'(" Names of the attributes : ")')
280      DO it=1,n_a_w
281        WRITE (*,'("   """,A,"""")') TRIM(cn_a(it))
282      ENDDO
283      DEALLOCATE(cn_a)
284    ENDIF
285!---
286    WRITE (*, &
287 &   '(" --> flioinqa(...,""",A,""",""text_n"",...)")') TRIM(v_n)
288    CALL flioinqa (fid,TRIM(v_n),"text_n",exa,a_l=l)
289    IF (exa) THEN
290      WRITE (*,'("  len(text_n) : ",I3)') l
291!-----
292      WRITE (*,'(" --> fliogeta(...,""",A,""",""text_n"",...)")') &
293 &     TRIM(v_n)
294      CALL fliogeta (fid,TRIM(v_n),"text_n",c_tmp)
295      WRITE (*,'("  ""text_n"" : """,A,"""")') TRIM(c_tmp)
296    ELSE
297      WRITE (*,'(" Attribute not found")')
298    ENDIF
299  ELSE
300    WRITE (*,'(" Variable not found")')
301  ENDIF
302!-
303  v_n = 'my_var_1'
304  WRITE (*,'(/," Variable : """,A,"""")') TRIM(v_n)
305  WRITE (*,'(" --> flioinqv(...,""",A,""",...)")') TRIM(v_n)
306  CALL flioinqv &
307 & (fid,TRIM(v_n),exv, &
308 &  nb_dims=n_d_w,len_dims=l_d_w,id_dims=i_d_w,nb_atts=n_a_w)
309  IF (exv) THEN
310    WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
311    WRITE (*,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:n_d_w)
312    WRITE (*,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:n_d_w)
313    WRITE (*,'(" Number of attributes : ",I2)') n_a_w
314    WRITE (*,'(" --> fliogetv(...,""",A,""",...)")') TRIM(v_n)
315    CALL fliogetv (fid,TRIM(v_n),r_w)
316    WRITE (*, &
317 &   '("  Values :",/,(5(1X,1PE11.3),:))') r_w
318    i = 2; j = 5;
319    WRITE (*,'(" --> fliogetv(...,",A, &
320 &             ",start=(/",I2,"/),count=(/",I2,"/))")') &
321 &   '"'//TRIM(v_n)//'"',i,j
322    CALL fliogetv (fid,TRIM(v_n),r_w,start=(/i/),count=(/j/))
323    WRITE (*, &
324 &   '("  Values(",I2,":",I2,") :",/,(5(1X,1PE11.3),:))') &
325 &   i,i+j-1,r_w(1:j)
326  ENDIF
327!-
328  WRITE (*,'(/," --> flioclo")')
329  CALL flioclo (fid)
330!-
331  WRITE (*,'(/," ----------------------------------")')
332!-------------------
333END PROGRAM testflio
Note: See TracBrowser for help on using the repository browser.