- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90
r5617 r7351 214 214 & cmode=NF90_64BIT_OFFSET,& 215 215 & ncid=td_file%i_id) 216 !NF90_WRITE, &217 216 CALL iom_cdf__check(il_status," IOM CDF CREATE: ") 218 217 … … 222 221 223 222 ELSE 223 224 224 IF( td_file%i_id /= 0 )THEN 225 225 … … 239 239 CALL iom_cdf__check(il_status," IOM CDF OPEN: ") 240 240 241 CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//&242 & TRIM(fct_str(td_file%i_id)))243 241 ELSE 244 242 … … 363 361 ! Argument 364 362 TYPE(TFILE), INTENT(INOUT) :: td_file 363 ! local variable 364 TYPE(TDIM) :: tl_dim 365 365 366 366 ! loop indices 367 367 INTEGER(i4) :: ji 368 INTEGER(i4) :: ii 368 369 !---------------------------------------------------------------- 369 370 … … 374 375 375 376 IF( td_file%i_ndim > 0 )THEN 377 ii=1 376 378 DO ji = 1, td_file%i_ndim 377 379 ! read dimension information 378 td_file%t_dim(ji)=iom_cdf_read_dim( td_file, ji) 380 tl_dim=iom_cdf_read_dim( td_file, ji) 381 IF( .NOT. dim_is_dummy(tl_dim) )THEN 382 IF( ii > ip_maxdim )THEN 383 CALL logger_fatal("IOM CDF OPEN: too much dimension "//& 384 & "to be read. you should remove dummy dimension using "//& 385 & " configuration file") 386 ENDIF 387 td_file%t_dim(ii)=dim_copy(tl_dim) 388 ii=ii+1 389 ENDIF 379 390 ENDDO 380 391 … … 418 429 419 430 ! local variable 431 TYPE(TATT) :: tl_att 432 420 433 ! loop indices 421 434 INTEGER(i4) :: ji 435 INTEGER(i4) :: ii 422 436 !---------------------------------------------------------------- 423 437 … … 429 443 ALLOCATE(td_file%t_att(td_file%i_natt)) 430 444 445 ii=1 431 446 DO ji = 1, td_file%i_natt 432 447 ! read global attribute 433 td_file%t_att(ji)=iom_cdf_read_att( td_file, NF90_GLOBAL, ji) 448 tl_att=iom_cdf_read_att( td_file, NF90_GLOBAL, ji) 449 IF( .NOT. att_is_dummy(tl_att) )THEN 450 td_file%t_att(ii)=att_copy(tl_att) 451 ii=ii+1 452 ENDIF 434 453 435 454 ENDDO … … 450 469 !> @author J.Paul 451 470 !> @date November, 2013 - Initial Version 471 !> @date September, 2015 472 !> - manage useless (dummy) variable 473 !> @date January, 2016 474 !> - increment n3d for 4D variable 452 475 ! 453 476 !> @param[inout] td_file file structure … … 460 483 ! local variable 461 484 INTEGER(i4) :: il_attid 485 INTEGER(i4) :: il_nvar 486 487 TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var 462 488 463 489 ! loop indices 464 490 INTEGER(i4) :: ji 491 INTEGER(i4) :: ii 465 492 !---------------------------------------------------------------- 466 493 467 494 IF( td_file%i_nvar > 0 )THEN 495 468 496 IF(ASSOCIATED(td_file%t_var))THEN 469 497 CALL var_clean(td_file%t_var(:)) 470 498 DEALLOCATE(td_file%t_var) 471 499 ENDIF 500 501 il_nvar=td_file%i_nvar 502 ALLOCATE(tl_var(il_nvar)) 503 ii=0 504 DO ji = 1, il_nvar 505 ! read variable information 506 tl_var(ji)=iom_cdf__read_var_meta( td_file, ji) 507 IF( .NOT. var_is_dummy(tl_var(ji)) )THEN 508 ii=ii+1 509 ENDIF 510 ENDDO 511 512 ! update number of variable used 513 td_file%i_nvar=ii 514 472 515 ALLOCATE(td_file%t_var(td_file%i_nvar)) 473 516 474 DO ji = 1, td_file%i_nvar 475 ! read dimension information 476 td_file%t_var(ji)=iom_cdf__read_var_meta( td_file, ji) 477 SELECT CASE(td_file%t_var(ji)%i_ndim) 478 CASE(0) 479 td_file%i_n0d=td_file%i_n0d+1 480 CASE(1) 481 td_file%i_n1d=td_file%i_n1d+1 482 td_file%i_rhd=td_file%i_rhd+1 483 CASE(2) 484 td_file%i_n2d=td_file%i_n2d+1 485 td_file%i_rhd=td_file%i_rhd+1 486 CASE(3) 487 td_file%i_n3d=td_file%i_n3d+1 488 td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len 489 END SELECT 490 491 ! look for depth id 492 IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'depth')/=0 )THEN 493 IF( td_file%i_depthid == 0 )THEN 494 td_file%i_depthid=ji 495 ELSE 496 IF( td_file%i_depthid /= ji )THEN 497 CALL logger_error("IOM CDF GET FILE VAR: find more"//& 498 & " than one depth variable in file "//& 499 & TRIM(td_file%c_name) ) 517 ii=0 518 DO ji = 1, il_nvar 519 IF( .NOT. var_is_dummy(tl_var(ji)) )THEN 520 ii=ii+1 521 td_file%t_var(ii)=var_copy(tl_var(ji)) 522 SELECT CASE(td_file%t_var(ii)%i_ndim) 523 CASE(0) 524 td_file%i_n0d=td_file%i_n0d+1 525 CASE(1) 526 td_file%i_n1d=td_file%i_n1d+1 527 td_file%i_rhd=td_file%i_rhd+1 528 CASE(2) 529 td_file%i_n2d=td_file%i_n2d+1 530 td_file%i_rhd=td_file%i_rhd+1 531 CASE(3,4) 532 td_file%i_n3d=td_file%i_n3d+1 533 td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len 534 END SELECT 535 536 ! look for depth id 537 IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'depth')/=0 )THEN 538 IF( td_file%i_depthid == 0 )THEN 539 td_file%i_depthid=ji 540 ELSE 541 IF( td_file%i_depthid /= ji )THEN 542 CALL logger_error("IOM CDF GET FILE VAR: find more"//& 543 & " than one depth variable in file "//& 544 & TRIM(td_file%c_name) ) 545 ENDIF 500 546 ENDIF 501 547 ENDIF 502 ENDIF 503 504 ! look for time id 505 IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN 506 IF( td_file%i_timeid == 0 )THEN 507 td_file%i_timeid=ji 508 ELSE 509 il_attid=0 510 IF( ASSOCIATED(td_file%t_var(ji)%t_att) )THEN 511 il_attid=att_get_id(td_file%t_var(ji)%t_att(:),'calendar') 512 ENDIF 513 IF( il_attid /= 0 )THEN 548 549 ! look for time id 550 IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'time')/=0 )THEN 551 IF( td_file%i_timeid == 0 )THEN 514 552 td_file%i_timeid=ji 515 !ELSE 516 ! CALL logger_error("IOM CDF GET FILE VAR: find more "//& 517 ! & "than one time variable in file "//& 518 ! & TRIM(td_file%c_name) ) 553 ELSE 554 il_attid=0 555 IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN 556 il_attid=att_get_id(td_file%t_var(ii)%t_att(:),'calendar') 557 ENDIF 558 IF( il_attid /= 0 )THEN 559 td_file%i_timeid=ji 560 !ELSE 561 ! CALL logger_error("IOM CDF GET FILE VAR: find more "//& 562 ! & "than one time variable in file "//& 563 ! & TRIM(td_file%c_name) ) 564 ENDIF 519 565 ENDIF 520 566 ENDIF 567 521 568 ENDIF 522 523 569 ENDDO 570 571 CALL var_clean(tl_var(:)) 572 DEALLOCATE(tl_var) 524 573 525 574 ELSE … … 605 654 ELSE 606 655 607 iom_cdf__read_dim_id%i_id=id_dimid608 609 656 CALL logger_trace( & 610 657 & " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//& … … 627 674 ENDIF 628 675 676 iom_cdf__read_dim_id%i_id=id_dimid 677 629 678 END FUNCTION iom_cdf__read_dim_id 630 679 !------------------------------------------------------------------- … … 748 797 IF( LEN(cl_value) < il_len )THEN 749 798 750 CALL logger_ error( &799 CALL logger_warn( & 751 800 & " IOM CDF READ ATT: not enough space to put "//& 752 801 & "attribute "//TRIM(cl_name) ) … … 1223 1272 !> @date September, 2014 1224 1273 !> - force to use FillValue=1.e20 if no FillValue for coordinate variable. 1274 !> @date September, 2015 1275 !> - manage useless (dummy) attribute 1225 1276 ! 1226 1277 !> @param[in] td_file file structure … … 1250 1301 1251 1302 ! loop indices 1303 INTEGER(i4) :: ji 1252 1304 !---------------------------------------------------------------- 1253 1305 ! check if file opened … … 1275 1327 & il_natt ) 1276 1328 CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ") 1329 1277 1330 !!! fill variable dimension structure 1278 tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) )1331 tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, cl_name, il_dimid(:) ) 1279 1332 1280 1333 IF( il_natt /= 0 )THEN … … 1353 1406 & tl_att(:), id_id=id_varid ) 1354 1407 1408 !! look for dummy attribute 1409 DO ji=il_natt,1,-1 1410 IF( att_is_dummy(tl_att(ji)) )THEN 1411 CALL var_del_att(iom_cdf__read_var_meta, tl_att(ji)) 1412 ENDIF 1413 ENDDO 1414 1355 1415 ! clean 1356 1416 CALL dim_clean(tl_dim(:)) … … 1373 1433 !> So the array of dimension structure of a variable is always compose of 4 1374 1434 !> dimension (use or not). 1375 ! 1435 !> 1436 !> @warn dummy dimension are not used. 1437 !> 1376 1438 !> @author J.Paul 1377 1439 !> @date November, 2013 - Initial Version 1378 1440 !> @date July, 2015 1379 1441 !> - Bug fix: use order to disorder table (see dim_init) 1442 !> @date September, 2015 1443 !> - check dummy dimension 1380 1444 !> 1381 1445 !> @param[in] td_file file structure 1382 1446 !> @param[in] id_ndim number of dimension 1447 !> @param[in] cd_name variable name 1383 1448 !> @param[in] id_dimid array of dimension id 1384 1449 !> @return array dimension structure 1385 1450 !------------------------------------------------------------------- 1386 FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, id_dimid)1451 FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, cd_name, id_dimid) 1387 1452 IMPLICIT NONE 1388 1453 ! Argument 1389 1454 TYPE(TFILE), INTENT(IN) :: td_file 1390 1455 INTEGER(i4), INTENT(IN) :: id_ndim 1456 CHARACTER(LEN=*) , INTENT(IN) :: cd_name 1391 1457 INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid 1392 1458 … … 1401 1467 ! loop indices 1402 1468 INTEGER(i4) :: ji 1469 INTEGER(i4) :: ii 1403 1470 !---------------------------------------------------------------- 1404 1471 … … 1415 1482 CALL dim_clean(tl_dim(:)) 1416 1483 1417 ELSE IF( id_ndim > 0 .AND. id_ndim <= 4 )THEN 1418 1419 1484 ELSE IF( id_ndim > 0 )THEN 1485 1486 1487 ii=1 1420 1488 DO ji = 1, id_ndim 1421 CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//& 1422 & "dimension "//TRIM(fct_str(ji)) ) 1423 1424 il_xyzt2(ji)=td_file%t_dim(id_dimid(ji))%i_xyzt2 1425 1426 ! read dimension information 1427 tl_dim(ji) = dim_init( td_file%t_dim(il_xyzt2(ji))%c_name, & 1428 & td_file%t_dim(il_xyzt2(ji))%i_len ) 1489 1490 !!! check no dummy dimension to be used 1491 IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN 1492 IF( ii > ip_maxdim )THEN 1493 CALL logger_error(" IOM CDF READ VAR DIM: "//& 1494 & "too much dimensions for variable "//& 1495 & TRIM(cd_name)//". check dummy configuration file.") 1496 ENDIF 1497 1498 CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//& 1499 & "dimension "//TRIM(fct_str(ji)) ) 1500 1501 il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2 1502 1503 ! read dimension information 1504 tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2(ii))%c_name, & 1505 & td_file%t_dim(il_xyzt2(ii))%i_len ) 1506 1507 ii=ii+1 1508 ELSE 1509 CALL logger_debug( " IOM CDF READ VAR DIM: dummy variable "//& 1510 & "dimension "//TRIM(fct_str(ji))//" not used." ) 1511 ENDIF 1429 1512 ENDDO 1430 1513 … … 1436 1519 ! clean 1437 1520 CALL dim_clean(tl_dim(:)) 1438 1439 ELSE1440 1441 CALL logger_error(" IOM CDF READ VAR DIM: can't manage "//&1442 & TRIM(fct_str(id_ndim))//" dimension(s)" )1443 1521 1444 1522 ENDIF … … 1943 2021 !> @author J.Paul 1944 2022 !> @date November, 2013 - Initial Version 2023 !> @date September, 2015 2024 !> - do not force to use zero as FillValue for any meshmask variable 1945 2025 ! 1946 2026 !> @param[inout] td_file file structure … … 1976 2056 ! check if file and variable dimension conform 1977 2057 IF( file_check_var_dim(td_file, td_var) )THEN 1978 1979 ! check variable dimension expected1980 CALL var_check_dim(td_var)1981 2058 1982 2059 ll_chg=.TRUE. … … 1998 2075 CASE('nav_lon','nav_lat', & 1999 2076 & 'glamt','glamu','glamv','glamf', & 2000 & 'gphit','gphiu','gphiv','gphif') 2077 & 'gphit','gphiu','gphiv','gphif', & 2078 & 'e1t','e1u','e1v','e1f', & 2079 & 'e2t','e2u','e2v','e2f','ff', & 2080 & 'gcost','gcosu','gcosv','gcosf', & 2081 & 'gsint','gsinu','gsinv','gsinf', & 2082 & 'mbathy','misf','isf_draft', & 2083 & 'hbatt','hbatu','hbatv','hbatf', & 2084 & 'gsigt','gsigu','gsigv','gsigf', & 2085 & 'e3t_0','e3u_0','e3v_0','e3w_0', & 2086 & 'e3f_0','gdepw_1d','gdept_1d', & 2087 & 'e3tp','e3wp','gdepw_0','rx1', & 2088 & 'gdept_0','gdepu','gdepv', & 2089 & 'hdept','hdepw','e3w_1d','e3t_1d',& 2090 & 'tmask','umask','vmask','fmask' ) 2091 ! do not change for coordinates and meshmask variables 2001 2092 END SELECT 2002 2093 ENDIF … … 2118 2209 ENDIF 2119 2210 2120 IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN 2121 IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN 2122 il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, & 2123 & TRIM(tl_var%t_att(ji)%c_name), & 2124 & TRIM(tl_var%t_att(ji)%c_value) ) 2125 CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 2126 ENDIF 2127 ELSE 2128 SELECT CASE(tl_var%t_att(ji)%i_type) 2129 CASE(NF90_BYTE) 2130 il_status = NF90_PUT_ATT(td_file%i_id, & 2131 & iom_cdf__write_var_def, & 2132 & TRIM(tl_var%t_att(ji)%c_name), & 2133 & INT(tl_var%t_att(ji)%d_value(:),i1)) 2134 CASE(NF90_SHORT) 2135 il_status = NF90_PUT_ATT(td_file%i_id, & 2136 & iom_cdf__write_var_def, & 2137 & TRIM(tl_var%t_att(ji)%c_name), & 2138 & INT(tl_var%t_att(ji)%d_value(:),i2)) 2139 CASE(NF90_INT) 2140 il_status = NF90_PUT_ATT(td_file%i_id, & 2141 & iom_cdf__write_var_def, & 2142 & TRIM(tl_var%t_att(ji)%c_name), & 2143 & INT(tl_var%t_att(ji)%d_value(:),i4)) 2144 CASE(NF90_FLOAT) 2145 il_status = NF90_PUT_ATT(td_file%i_id, & 2146 & iom_cdf__write_var_def, & 2147 & TRIM(tl_var%t_att(ji)%c_name), & 2148 & REAL(tl_var%t_att(ji)%d_value(:),sp)) 2149 CASE(NF90_DOUBLE) 2150 il_status = NF90_PUT_ATT(td_file%i_id, & 2151 & iom_cdf__write_var_def, & 2152 & TRIM(tl_var%t_att(ji)%c_name), & 2153 & REAL(tl_var%t_att(ji)%d_value(:),dp)) 2154 END SELECT 2155 CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 2156 ENDIF 2211 SELECT CASE(tl_var%t_att(ji)%i_type) 2212 CASE(NF90_CHAR) 2213 IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN 2214 il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, & 2215 & TRIM(tl_var%t_att(ji)%c_name), & 2216 & TRIM(tl_var%t_att(ji)%c_value) ) 2217 ENDIF 2218 CASE(NF90_BYTE) 2219 il_status = NF90_PUT_ATT(td_file%i_id, & 2220 & iom_cdf__write_var_def, & 2221 & TRIM(tl_var%t_att(ji)%c_name), & 2222 & INT(tl_var%t_att(ji)%d_value(:),i1)) 2223 CASE(NF90_SHORT) 2224 il_status = NF90_PUT_ATT(td_file%i_id, & 2225 & iom_cdf__write_var_def, & 2226 & TRIM(tl_var%t_att(ji)%c_name), & 2227 & INT(tl_var%t_att(ji)%d_value(:),i2)) 2228 CASE(NF90_INT) 2229 il_status = NF90_PUT_ATT(td_file%i_id, & 2230 & iom_cdf__write_var_def, & 2231 & TRIM(tl_var%t_att(ji)%c_name), & 2232 & INT(tl_var%t_att(ji)%d_value(:),i4)) 2233 CASE(NF90_FLOAT) 2234 il_status = NF90_PUT_ATT(td_file%i_id, & 2235 & iom_cdf__write_var_def, & 2236 & TRIM(tl_var%t_att(ji)%c_name), & 2237 & REAL(tl_var%t_att(ji)%d_value(:),sp)) 2238 CASE(NF90_DOUBLE) 2239 il_status = NF90_PUT_ATT(td_file%i_id, & 2240 & iom_cdf__write_var_def, & 2241 & TRIM(tl_var%t_att(ji)%c_name), & 2242 & REAL(tl_var%t_att(ji)%d_value(:),dp)) 2243 END SELECT 2244 CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 2245 2157 2246 ENDDO 2158 2247 … … 2200 2289 & (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf 2201 2290 END WHERE 2202 2291 2203 2292 jj=0 2204 2293 DO ji = 1, ip_maxdim … … 2226 2315 2227 2316 ! put value 2228 CALL logger_ trace( &2317 CALL logger_debug( & 2229 2318 & "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//& 2230 2319 & "in file "//TRIM(td_file%c_name)) 2231 2320 2232 2321 il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:)) 2233 CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ") 2322 CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE ("//& 2323 & TRIM(td_var%c_name)//") :" ) 2234 2324 2235 2325 DEALLOCATE( dl_value )
Note: See TracChangeset
for help on using the changeset viewer.
