Changeset 555 for BOL/trunk/IPCC
- Timestamp:
- Oct 26, 2004, 11:18:06 AM (20 years ago)
- File:
-
- 1 edited
-
BOL/trunk/IPCC/ts2IPCC.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
BOL/trunk/IPCC/ts2IPCC.F90
r551 r555 1 1 ! 2 ! $Header$ 3 ! 2 4 PROGRAM ts2IPCC 3 5 … … 18 20 19 21 use cmor_users_functions 20 22 use netcdf 23 21 24 implicit none 22 25 … … 32 35 CHARACTER (len=20), DIMENSION(100) :: ipsl_name, ipsl_units 33 36 CHARACTER (len=20), DIMENSION(100) :: ipcc_name, ipcc_table 34 CHARACTER (len=80) :: varname, units 37 CHARACTER (len=80) :: varname, units, namedim 35 38 36 39 INTEGER :: orig_file_id, nvars, ndims 37 40 INTEGER :: verbos, exit_ctl, realis, indice,index_table 38 41 INTEGER :: iargc, iostat, ierr 39 INTEGER :: i 42 INTEGER :: i,idim 43 INTEGER, ALLOCATABLE, DIMENSION(:) :: dimids,axis_ids,lendim 40 44 INTEGER :: latid, lonid, vertid, timeid 41 45 INTEGER :: varid, cmorvarid 42 46 INTEGER :: ilat, ilon, ivert, itime 43 47 INTEGER :: lunout ! device de sortie 48 44 49 logical :: found = .false. 45 50 46 51 REAL, ALLOCATABLE, DIMENSION(:) :: lon, lat, vert, time 47 52 REAL, ALLOCATABLE, DIMENSION(:) :: lon_bounds, lat_bounds 48 REAL, ALLOCATABLE, DIMENSION(:,:,: ) :: donnees53 REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: donnees 49 54 DOUBLE PRECISION, DIMENSION(1) :: rdate 50 55 real :: missing_value … … 244 249 ! Definition des axes 245 250 246 ! lecture de la latitude: 247 ierr = nf_inq_dimid(orig_file_id,'lat',latid) 248 ierr = nf_inq_dimlen(orig_file_id, latid, ilat) 249 allocate(lat(ilat)) 250 ierr = nf_inq_varid(orig_file_id,'lat',latid) 251 ierr = nf_get_var_real(orig_file_id, latid, lat) 252 ierr = nf_get_att_text(orig_file_id, latid, 'units', units) 253 ALLOCATE(lat_bounds(ilat+1)) 254 DO i = 2, ilat 255 lat_bounds(i) = lat(i-1) - (lat(i-1) - lat(i))/2 256 enddo 257 lat_bounds(1) = lat(1) 258 lat_bounds(ilat+1) = lat(ilat) 259 ! definition de la latitude 260 latid = cmor_axis( & 261 table=trim(ipcc_table(index_table)), & 262 table_entry='latitude', & 263 units=units, & 264 length=ilat, & 265 coord_vals=lat, & 266 cell_bounds=lat_bounds) 267 268 ! lecture de la longitude: 269 units=' ' 270 ierr = nf_inq_dimid(orig_file_id,'lon',lonid) 271 ierr = nf_inq_dimlen(orig_file_id, lonid, ilon) 272 allocate(lon(ilon)) 273 ierr = nf_inq_varid(orig_file_id,'lon',lonid) 274 ierr = nf_get_var_real(orig_file_id, lonid, lon) 275 ierr = nf_get_att_text(orig_file_id, lonid, 'units', units) 276 ALLOCATE(lon_bounds(ilon+1)) 277 DO i = 2, ilon 278 lon_bounds(i) = lon(i-1) - (lon(i-1) - lon(i))/2 279 enddo 280 lon_bounds(1) = lon(1) - (lon_bounds(3) -lon_bounds(2))/2. 281 lon_bounds(ilon+1) = lon(ilon) + (lon_bounds(ilon)-lon_bounds(ilon-1))/2. 282 283 ! definition de la longitude 284 lonid = cmor_axis( & 285 table=trim(ipcc_table(index_table)), & 286 table_entry='longitude', & 287 units=units, & 288 length=ilon, & 289 coord_vals=lon, & 290 cell_bounds=lon_bounds) 291 292 ! definition du temps 293 units=' ' 294 ierr = nf_inq_dimid(orig_file_id,'time_counter',timeid) 295 ierr = nf_inq_dimlen(orig_file_id,timeid,itime) 296 allocate(time(itime)) 297 ierr = nf_inq_varid(orig_file_id,'time_counter',timeid) 298 ierr = nf_get_var_real(orig_file_id, timeid, time) 299 ierr = nf_get_att_text(orig_file_id,timeid, 'units', units) 300 timeid = cmor_axis( & 301 table=trim(ipcc_table(index_table)), & 302 table_entry='time', & 303 units=units, & 304 length=itime, & 305 interval='30 minutes') 251 ierr = nf90_inq_varid(orig_file_id,TRIM(varname), varid) 252 if (ierr /= 0) call handle_err(ierr) 253 ierr = nf90_Inquire_Variable(orig_file_id, varid, ndims = ndims) 254 if (ierr /= 0) call handle_err(ierr) 255 allocate (dimids(ndims)) 256 allocate (axis_ids(ndims)) 257 allocate (lendim(ndims)) 258 ierr = nf90_Inquire_Variable(orig_file_id, varid, dimids = dimids) 259 if (ierr /= 0) call handle_err(ierr) 260 261 do idim = 1, ndims 262 ierr = nf90_Inquire_Dimension(orig_file_id, dimids(idim), & 263 name = namedim, len = lendim(idim)) 264 if (ierr /= 0) call handle_err(ierr) 265 units=' ' 266 selectcase(trim(namedim)) 267 case('lat') 268 ! lecture de la latitude: 269 allocate(lat(lendim(idim))) 270 ierr = nf_inq_varid(orig_file_id, namedim, latid) 271 if (ierr /= 0) call handle_err(ierr) 272 ierr = nf_get_var_real(orig_file_id, latid, lat) 273 if (ierr /= 0) call handle_err(ierr) 274 ierr = nf_get_att_text(orig_file_id, latid, 'units', units) 275 if (ierr /= 0) call handle_err(ierr) 276 allocate(lat_bounds(lendim(idim)+1)) 277 DO i = 2, lendim(idim) 278 lat_bounds(i) = lat(i-1) - (lat(i-1) - lat(i))/2 279 enddo 280 lat_bounds(1) = lat(1) 281 lat_bounds(lendim(idim)+1) = lat(lendim(idim)) 282 ! definition de la latitude 283 axis_ids(idim) = cmor_axis( & 284 table=trim(ipcc_table(index_table)), & 285 table_entry='latitude', & 286 units=units, & 287 length=lendim(idim), & 288 coord_vals=lat, & 289 cell_bounds=lat_bounds) 290 ! 291 ! 292 case('lon') 293 ! lecture de la longitude: 294 allocate(lon(lendim(idim))) 295 ierr = nf_inq_varid(orig_file_id, namedim, lonid) 296 if (ierr /= 0) call handle_err(ierr) 297 ierr = nf_get_var_real(orig_file_id, lonid, lon) 298 if (ierr /= 0) call handle_err(ierr) 299 ierr = nf_get_att_text(orig_file_id, lonid, 'units', units) 300 if (ierr /= 0) call handle_err(ierr) 301 ALLOCATE(lon_bounds(lendim(idim)+1)) 302 DO i = 2, lendim(idim) 303 lon_bounds(i) = lon(i-1) - (lon(i-1) - lon(i))/2 304 enddo 305 lon_bounds(1) = lon(1) - (lon_bounds(3) -lon_bounds(2))/2. 306 lon_bounds(lendim(idim)+1) = lon(lendim(idim)) + (lon_bounds(lendim(idim))-lon_bounds(lendim(idim)-1))/2. 307 308 ! definition de la longitude 309 axis_ids(idim) = cmor_axis( & 310 table=trim(ipcc_table(index_table)), & 311 table_entry='longitude', & 312 units=units, & 313 length=lendim(idim), & 314 coord_vals=lon, & 315 cell_bounds=lon_bounds) 316 ! 317 ! 318 case('presnivs') 319 ! lecture de la verticale: 320 allocate(vert(lendim(idim))) 321 ierr = nf_inq_varid(orig_file_id, namedim, vertid) 322 if (ierr /= 0) call handle_err(ierr) 323 ierr = nf_get_var_real(orig_file_id, vertid, vert) 324 if (ierr /= 0) call handle_err(ierr) 325 ierr = nf_get_att_text(orig_file_id, vertid, 'units', units) 326 if (ierr /= 0) call handle_err(ierr) 327 ! 328 ! definition de la verticale 329 if (units == 'mb') units='Pa' 330 axis_ids(idim) = cmor_axis( & 331 table=trim(ipcc_table(index_table)), & 332 table_entry='pressure', & 333 units=units, & 334 length=lendim(idim), & 335 coord_vals=vert) 336 ! 337 ! 338 case('time_counter') 339 ! definition du temps 340 if (idim /= ndims) then 341 write(lunout,*)'la dimension temps doit etre la derniere dimension' 342 stop 343 endif 344 allocate(time(lendim(idim))) 345 ierr = nf_inq_varid(orig_file_id,namedim,timeid) 346 if (ierr /=0) call handle_err(ierr) 347 ierr = nf_get_var_real(orig_file_id, timeid, time) 348 if (ierr /=0) call handle_err(ierr) 349 ierr = nf_get_att_text(orig_file_id,timeid, 'units', units) 350 if (ierr /=0) call handle_err(ierr) 351 axis_ids(idim) = cmor_axis( & 352 table=trim(ipcc_table(index_table)), & 353 table_entry='time', & 354 units=units, & 355 length=lendim(idim), & 356 interval='30 minutes') 357 itime= lendim(idim) 358 case default 359 write(lunout,*)'Dimension: ', trim(namedim),' non reconnue' 360 stop 361 endselect 362 enddo 306 363 307 364 ! … … 309 366 units=' ' 310 367 ierr = nf_inq_varid(orig_file_id,TRIM(varname), varid) 368 if (ierr /= 0) call handle_err(ierr) 311 369 ierr = nf_get_att_text(orig_file_id, varid, 'units', units) 370 if (ierr /= 0) call handle_err(ierr) 312 371 ierr = nf_get_att_real(orig_file_id, varid, 'missing_value', missing_value) 372 if (ierr /= 0) call handle_err(ierr) 313 373 cmorvarid = cmor_variable( & 314 374 table=trim(ipcc_table(index_table)), & 315 375 table_entry=trim(ipcc_name(index_table)), & 316 376 units=units, & 317 axis_ids= (/ lonid, latid, timeid /),&377 axis_ids= axis_ids, & 318 378 missing_value=real(missing_value), & 319 379 original_name=varname) 320 380 ! 321 381 ! Lecture de la variable 322 ALLOCATE (donnees(ilon, ilat, itime)) 382 if (ndims == 3) then 383 ALLOCATE (donnees(lendim(1), lendim(2), 1, lendim(3) )) 384 else if (ndims ==4) then 385 allocate (donnees(lendim(1), lendim(2), lendim(3), lendim(4) )) 386 endif 323 387 ierr = nf_get_var_real(orig_file_id, varid, donnees) 324 388 ! … … 329 393 ierr = cmor_write( & 330 394 var_id = cmorvarid, & 331 data = real(donnees(:,:,i)),&395 DATA = REAL(donnees(:,:,:,i)), & 332 396 ntimes_passed = 1, & 333 397 time_vals = rdate) … … 347 411 stop 348 412 endif 413 414 contains 415 416 subroutine handle_err(status) 417 use netcdf 418 419 implicit none 420 integer, intent(in) :: status 421 422 write(lunout,*)nf90_strerror(status) 423 stop 424 425 end subroutine handle_err 349 426 350 END 427 END PROGRAM ts2IPCC 428
Note: See TracChangeset
for help on using the changeset viewer.
