[1895] | 1 | PROGRAM testflio |
---|
| 2 | !- |
---|
[1991] | 3 | !$Id: testflio.f90 887 2010-02-08 09:48:39Z bellier $ |
---|
[1895] | 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', & |
---|
[1991] | 108 | & valid_min=-10.,valid_max=+20.,fillvalue=+50.) |
---|
[1895] | 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 | !------------------- |
---|
| 341 | END PROGRAM testflio |
---|