- Timestamp:
- 2016-11-18T09:34:22+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/variable.f90
r5602 r7261 281 281 !> @date November, 2014 282 282 !> - Fix memory leaks bug 283 !> @date June, 2015 284 !> - change way to get variable information in namelist 285 !> @date July, 2015 286 !> - add subroutine var_chg_unit to change unit of output variable 287 !> @date Spetember, 2015 288 !> - manage useless (dummy) variable 283 289 ! 284 290 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 293 299 USE att ! attribute manager 294 300 USE dim ! dimension manager 301 USE math ! mathematical function 295 302 IMPLICIT NONE 296 303 ! NOTE_avoid_public_variables_if_possible … … 300 307 301 308 PUBLIC :: tg_varextra !< array of variable structure with extra information. 309 310 PRIVATE :: cm_dumvar !< dummy variable array 302 311 303 312 ! function and subroutine … … 318 327 PUBLIC :: var_concat !< concatenate two variables 319 328 PUBLIC :: var_limit_value !< forced min and max value 329 PUBLIC :: var_chg_unit !< change variable unit and value 320 330 PUBLIC :: var_max_dim !< get array of maximum dimension use 321 331 PUBLIC :: var_reorder !< reorder table of value in variable structure … … 328 338 PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information. 329 339 PUBLIC :: var_check_dim !< check variable dimension expected 340 PUBLIC :: var_get_dummy !< fill dummy variable array 341 PUBLIC :: var_is_dummy !< check if variable is defined as dummy variable 330 342 331 343 PRIVATE :: var__init ! initialize variable structure without array of value … … 382 394 PRIVATE :: var__get_max ! get maximum value from namelist 383 395 PRIVATE :: var__get_min ! get minimum value from namelist 396 PRIVATE :: var__get_unf ! get scale factor value from namelist 397 PRIVATE :: var__get_unt ! get unit from namelist 384 398 PRIVATE :: var__get_interp ! get interpolation method from namelist 385 399 PRIVATE :: var__get_extrap ! get extrapolation method from namelist … … 401 415 TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes 402 416 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< variable dimension 403 417 404 418 LOGICAL :: l_file = .FALSE. !< variable read in a file 405 419 … … 414 428 REAL(dp) :: d_min = dp_fill !< minimum value 415 429 REAL(dp) :: d_max = dp_fill !< maximum value 416 430 431 CHARACTER(LEN=lc) :: c_unt = '' !< new variables units (linked to units factor) 432 REAL(dp) :: d_unf = 1._dp !< units factor 433 417 434 !!! netcdf4 418 435 LOGICAL :: l_contiguous = .FALSE. !< use contiguous storage or not … … 433 450 TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< array of variable structure with extra information. 434 451 !< fill when running var_def_extra() 452 453 CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumvar !< dummy variable 435 454 436 455 INTERFACE var_init … … 518 537 !> 519 538 !> @author J.Paul 520 !> - November, 2013- Initial Version539 !> @date November, 2013 - Initial Version 521 540 !> @date November, 2014 522 541 !> - use function instead of overload assignment operator (to avoid memory leak) … … 548 567 var__copy_unit%d_min = td_var%d_min 549 568 var__copy_unit%d_max = td_var%d_max 569 570 var__copy_unit%c_unt = TRIM(td_var%c_unt) 571 var__copy_unit%d_unf = td_var%d_unf 550 572 551 573 var__copy_unit%i_type = td_var%i_type … … 577 599 var__copy_unit%c_units = TRIM(td_var%c_units) 578 600 var__copy_unit%c_axis = TRIM(td_var%c_axis) 601 var__copy_unit%d_unf = td_var%d_unf 579 602 var__copy_unit%d_scf = td_var%d_scf 580 603 var__copy_unit%d_ofs = td_var%d_ofs … … 627 650 !> 628 651 !> @author J.Paul 629 !> - November, 2013- Initial Version652 !> @date November, 2013 - Initial Version 630 653 !> @date November, 2014 631 654 !> - use function instead of overload assignment operator … … 656 679 !> 657 680 !> @author J.Paul 658 !> - November, 2013- Initial Version681 !> @date November, 2013 - Initial Version 659 682 !> 660 683 !> @param[inout] td_var variable strucutre … … 695 718 ! 696 719 !> @author J.Paul 697 !> - September, 2014- Initial Version720 !> @date September, 2014 - Initial Version 698 721 ! 699 722 !> @param[inout] td_var array of variable strucutre … … 718 741 ! 719 742 !> @author J.Paul 720 !> - September, 2014- Initial Version743 !> @date September, 2014 - Initial Version 721 744 ! 722 745 !> @param[inout] td_var array of variable strucutre … … 744 767 ! 745 768 !> @author J.Paul 746 !> - September, 2014- Initial Version769 !> @date September, 2014 - Initial Version 747 770 ! 748 771 !> @param[inout] td_var array of variable strucutre … … 788 811 !> - id_id : variable id (read from a file). 789 812 !> - id_ew : number of point composing east west wrap band. 813 !> - dd_unf : real(8) value for units factor attribute. 790 814 !> - dd_scf : real(8) value for scale factor attribute. 791 815 !> - dd_ofs : real(8) value for add offset attribute. … … 801 825 !> - cd_extrap : a array of character defining extrapolation method. 802 826 !> - cd_filter : a array of character defining filtering method. 827 !> - cd_unt : a string character to define output unit 828 !> - dd_unf : real(8) factor applied to change unit 803 829 !> 804 830 !> @note most of these optionals arguments will be inform automatically, … … 806 832 !> 807 833 !> @author J.Paul 808 !> - November, 2013- Initial Version 834 !> @date November, 2013 - Initial Version 835 !> @date February, 2015 836 !> - Bug fix: conversion of the FillValue type (float case) 837 !> @date June, 2015 838 !> - add unit factor (to change unit) 809 839 !> 810 840 !> @param[in] cd_name variable name … … 833 863 !> @param[in] cd_extrap extrapolation method 834 864 !> @param[in] cd_filter filter method 865 !> @param[in] cd_unt new units (linked to units factor) 866 !> @param[in] dd_unf units factor 835 867 !> @return variable structure 836 868 !------------------------------------------------------------------- … … 843 875 & ld_contiguous, ld_shuffle,& 844 876 & ld_fletcher32, id_deflvl, id_chunksz, & 845 & cd_interp, cd_extrap, cd_filter ) 877 & cd_interp, cd_extrap, cd_filter, & 878 & cd_unt, dd_unf ) 846 879 IMPLICIT NONE 847 880 ! Argument … … 871 904 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 872 905 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 906 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 907 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 873 908 874 909 … … 933 968 tl_att=att_init('_FillValue', INT(dd_fill,i4) ) 934 969 CASE(NF90_FLOAT) 935 tl_att=att_init('_FillValue', INT(dd_fill,sp) )970 tl_att=att_init('_FillValue', REAL(dd_fill,sp) ) 936 971 CASE DEFAULT ! NF90_DOUBLE 937 972 tl_att=att_init('_FillValue', dd_fill ) 938 973 END SELECT 939 974 CALL var_move_att(var__init, tl_att) … … 1038 1073 ENDIF 1039 1074 1075 ! units factor 1076 IF( PRESENT(dd_unf) )THEN 1077 tl_att=att_init('units_factor',dd_unf) 1078 CALL var_move_att(var__init, tl_att) 1079 ENDIF 1080 1081 ! new units (linked to units factor) 1082 IF( PRESENT(cd_unt) )THEN 1083 tl_att=att_init('new_units',cd_units) 1084 CALL var_move_att(var__init, tl_att) 1085 ENDIF 1086 1040 1087 ! add extra information 1041 1088 CALL var__get_extra(var__init) … … 1047 1094 CALL var_del_att(var__init, 'filter') 1048 1095 CALL var_del_att(var__init, 'src_file') 1096 CALL var_del_att(var__init, 'src_i_indices') 1097 CALL var_del_att(var__init, 'src_j_indices') 1049 1098 CALL var_del_att(var__init, 'valid_min') 1050 1099 CALL var_del_att(var__init, 'valid_max') … … 1072 1121 ! 1073 1122 !> @author J.Paul 1074 !> - November, 2013- Initial Version 1075 ! 1123 !> @date November, 2013 - Initial Version 1124 !> @date June, 2015 1125 !> - add interp, extrap, and filter argument 1126 !> @date July, 2015 1127 !> - add unit factor (to change unit) 1128 !> 1076 1129 !> @param[in] cd_name variable name 1077 1130 !> @param[in] dd_value 1D array of real(8) value … … 1100 1153 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 1101 1154 !> @param[in] id_chunksz chunk size 1155 !> @param[in] cd_interp interpolation method 1156 !> @param[in] cd_extrap extrapolation method 1157 !> @param[in] cd_filter filter method 1158 !> @param[in] cd_unt new units (linked to units factor) 1159 !> @param[in] dd_unf units factor 1102 1160 !> @return variable structure 1103 1161 !------------------------------------------------------------------- … … 1110 1168 & dd_min, dd_max, & 1111 1169 & ld_contiguous, ld_shuffle,& 1112 & ld_fletcher32, id_deflvl, id_chunksz) 1170 & ld_fletcher32, id_deflvl, id_chunksz, & 1171 & cd_interp, cd_extrap, cd_filter, & 1172 & cd_unt, dd_unf) 1113 1173 IMPLICIT NONE 1114 1174 ! Argument … … 1138 1198 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1139 1199 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1200 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1201 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1202 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1203 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1204 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1140 1205 1141 1206 ! local variable … … 1193 1258 & ld_fletcher32=ld_fletcher32, & 1194 1259 & id_deflvl=id_deflvl, & 1195 & id_chunksz=id_chunksz(:)) 1260 & id_chunksz=id_chunksz(:), & 1261 & cd_interp=cd_interp(:), & 1262 & cd_extrap=cd_extrap(:), & 1263 & cd_filter=cd_filter(:), & 1264 & cd_unt=cd_unt, dd_unf=dd_unf ) 1196 1265 1197 1266 ! add value … … 1239 1308 ! 1240 1309 !> @author J.Paul 1241 !> - November, 2013- Initial Version 1310 !> @date November, 2013 - Initial Version 1311 !> @date February, 2015 1312 !> - bug fix: array initialise with dimension 1313 !> array not only one value 1314 !> @date June, 2015 1315 !> - add interp, extrap, and filter argument 1316 !> - Bux fix: dimension array initialise not only one value 1317 !> @date July, 2015 1318 !> - add unit factor (to change unit) 1242 1319 ! 1243 1320 !> @param[in] cd_name variable name … … 1269 1346 !> no deflation is in use 1270 1347 !> @param[in] id_chunksz chunk size 1348 !> @param[in] cd_interp interpolation method 1349 !> @param[in] cd_extrap extrapolation method 1350 !> @param[in] cd_filter filter method 1351 !> @param[in] cd_unt new units (linked to units factor) 1352 !> @param[in] dd_unf units factor 1271 1353 !> @return variable structure 1272 1354 !------------------------------------------------------------------- … … 1279 1361 & dd_min, dd_max, & 1280 1362 & ld_contiguous, ld_shuffle,& 1281 & ld_fletcher32, id_deflvl, id_chunksz) 1363 & ld_fletcher32, id_deflvl, id_chunksz, & 1364 & cd_interp, cd_extrap, cd_filter, & 1365 & cd_unt, dd_unf) 1282 1366 IMPLICIT NONE 1283 1367 ! Argument … … 1307 1391 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1308 1392 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1393 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1394 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1395 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1396 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1397 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1309 1398 1310 1399 ! local variable … … 1350 1439 ENDIF 1351 1440 1352 il_count(:)=tl_dim( 1)%i_len1441 il_count(:)=tl_dim(:)%i_len 1353 1442 IF( PRESENT(id_count) )THEN 1354 1443 IF( SIZE(id_count(:)) /= 2 )THEN … … 1381 1470 & ld_fletcher32=ld_fletcher32, & 1382 1471 & id_deflvl=id_deflvl, & 1383 & id_chunksz=id_chunksz(:)) 1472 & id_chunksz=id_chunksz(:), & 1473 & cd_interp=cd_interp(:), & 1474 & cd_extrap=cd_extrap(:), & 1475 & cd_filter=cd_filter(:), & 1476 & cd_unt=cd_unt, dd_unf=dd_unf ) 1384 1477 1385 1478 ! add value … … 1431 1524 ! 1432 1525 !> @author J.Paul 1433 !> - November, 2013- Initial Version 1434 ! 1526 !> @date November, 2013 - Initial Version 1527 !> @date June, 2015 1528 !> - add interp, extrap, and filter argument 1529 !> @date July, 2015 1530 !> - add unit factor (to change unit) 1531 !> 1435 1532 !> @param[in] cd_name variable name 1436 1533 !> @param[in] dd_value 1D array of real(8) value … … 1461 1558 !> deflation is in use 1462 1559 !> @param[in] id_chunksz chunk size 1560 !> @param[in] cd_interp interpolation method 1561 !> @param[in] cd_extrap extrapolation method 1562 !> @param[in] cd_filter filter method 1563 !> @param[in] cd_unt new units (linked to units factor) 1564 !> @param[in] dd_unf units factor 1463 1565 !> @return variable structure 1464 1566 !------------------------------------------------------------------- … … 1471 1573 & dd_min, dd_max, & 1472 1574 & ld_contiguous, ld_shuffle,& 1473 & ld_fletcher32, id_deflvl, id_chunksz) 1575 & ld_fletcher32, id_deflvl, id_chunksz, & 1576 & cd_interp, cd_extrap, cd_filter, & 1577 & cd_unt, dd_unf) 1474 1578 IMPLICIT NONE 1475 1579 ! Argument … … 1499 1603 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1500 1604 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1605 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1606 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1607 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1608 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1609 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1501 1610 1502 1611 ! local variable … … 1577 1686 & ld_fletcher32=ld_fletcher32, & 1578 1687 & id_deflvl=id_deflvl, & 1579 & id_chunksz=id_chunksz(:)) 1688 & id_chunksz=id_chunksz(:), & 1689 & cd_interp=cd_interp(:), & 1690 & cd_extrap=cd_extrap(:), & 1691 & cd_filter=cd_filter(:), & 1692 & cd_unt=cd_unt, dd_unf=dd_unf ) 1580 1693 1581 1694 ! add value … … 1623 1736 ! 1624 1737 !> @author J.Paul 1625 !> - November, 2013- Initial Version 1626 ! 1738 !> @date November, 2013 - Initial Version 1739 !> @date June, 2015 1740 !> - add interp, extrap, and filter argument 1741 !> @date July, 2015 1742 !> - add unit factor (to change unit) 1743 !> 1627 1744 !> @param[in] cd_name variable name 1628 1745 !> @param[in] dd_value 4D array of real(8) value … … 1653 1770 !> deflation is in use 1654 1771 !> @param[in] id_chunksz chunk size 1772 !> @param[in] cd_interp interpolation method 1773 !> @param[in] cd_extrap extrapolation method 1774 !> @param[in] cd_filter filter method 1775 !> @param[in] cd_unt new units (linked to units factor) 1776 !> @param[in] dd_unf units factor 1655 1777 !> @return variable structure 1656 1778 !------------------------------------------------------------------- … … 1663 1785 & dd_min, dd_max, & 1664 1786 & ld_contiguous, ld_shuffle,& 1665 & ld_fletcher32, id_deflvl, id_chunksz) 1787 & ld_fletcher32, id_deflvl, id_chunksz, & 1788 & cd_interp, cd_extrap, cd_filter, & 1789 & cd_unt, dd_unf ) 1666 1790 IMPLICIT NONE 1667 1791 ! Argument … … 1691 1815 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1692 1816 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1817 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1818 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1819 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1820 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1821 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1693 1822 1694 1823 ! local variable … … 1723 1852 & ld_fletcher32=ld_fletcher32, & 1724 1853 & id_deflvl=id_deflvl, & 1725 & id_chunksz=id_chunksz(:)) 1854 & id_chunksz=id_chunksz(:), & 1855 & cd_interp=cd_interp(:), & 1856 & cd_extrap=cd_extrap(:), & 1857 & cd_filter=cd_filter(:), & 1858 & cd_unt=cd_unt, dd_unf=dd_unf ) 1726 1859 1727 1860 ! add value … … 1758 1891 ! 1759 1892 !> @author J.Paul 1760 !> - November, 2013- Initial Version 1893 !> @date November, 2013 - Initial Version 1894 !> @date June, 2015 1895 !> - add interp, extrap, and filter argument 1896 !> @date July, 2015 1897 !> - add unit factor (to change unit) 1761 1898 ! 1762 1899 !> @param[in] cd_name variable name … … 1788 1925 !> deflation is in use 1789 1926 !> @param[in] id_chunksz chunk size 1927 !> @param[in] cd_interp interpolation method 1928 !> @param[in] cd_extrap extrapolation method 1929 !> @param[in] cd_filter filter method 1930 !> @param[in] cd_unt new units (linked to units factor) 1931 !> @param[in] dd_unf units factor 1790 1932 !> @return variable structure 1791 1933 !------------------------------------------------------------------- … … 1798 1940 & dd_min, dd_max, & 1799 1941 & ld_contiguous, ld_shuffle,& 1800 & ld_fletcher32, id_deflvl, id_chunksz) 1942 & ld_fletcher32, id_deflvl, id_chunksz, & 1943 & cd_interp, cd_extrap, cd_filter, & 1944 & cd_unt, dd_unf) 1801 1945 1802 1946 IMPLICIT NONE … … 1827 1971 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1828 1972 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1973 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1974 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1975 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1976 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1977 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1978 1829 1979 1830 1980 ! local variable … … 1870 2020 & ld_fletcher32=ld_fletcher32, & 1871 2021 & id_deflvl=id_deflvl, & 1872 & id_chunksz=id_chunksz(:)) 2022 & id_chunksz=id_chunksz(:), & 2023 & cd_interp=cd_interp(:), & 2024 & cd_extrap=cd_extrap(:), & 2025 & cd_filter=cd_filter(:), & 2026 & cd_unt=cd_unt, dd_unf=dd_unf ) 1873 2027 1874 2028 DEALLOCATE( dl_value ) … … 1892 2046 ! 1893 2047 !> @author J.Paul 1894 !> - November, 2013- Initial Version 2048 !> @date November, 2013 - Initial Version 2049 !> @date June, 2015 2050 !> - add interp, extrap, and filter argument 2051 !> @date July, 2015 2052 !> - add unit factor (to change unit) 1895 2053 ! 1896 2054 !> @param[in] cd_name : variable name … … 1922 2080 !> deflation is in use 1923 2081 !> @param[in] id_chunksz : chunk size 2082 !> @param[in] cd_interp interpolation method 2083 !> @param[in] cd_extrap extrapolation method 2084 !> @param[in] cd_filter filter method 2085 !> @param[in] cd_unt new units (linked to units factor) 2086 !> @param[in] dd_unf units factor 1924 2087 !> @return variable structure 1925 2088 !------------------------------------------------------------------- … … 1932 2095 & dd_min, dd_max, & 1933 2096 & ld_contiguous, ld_shuffle,& 1934 & ld_fletcher32, id_deflvl, id_chunksz) 2097 & ld_fletcher32, id_deflvl, id_chunksz, & 2098 & cd_interp, cd_extrap, cd_filter, & 2099 & cd_unt, dd_unf) 1935 2100 1936 2101 IMPLICIT NONE … … 1961 2126 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1962 2127 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2128 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2129 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2130 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2131 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2132 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1963 2133 1964 2134 ! local variable … … 2006 2176 & ld_fletcher32=ld_fletcher32, & 2007 2177 & id_deflvl=id_deflvl, & 2008 & id_chunksz=id_chunksz(:)) 2178 & id_chunksz=id_chunksz(:), & 2179 & cd_interp=cd_interp(:), & 2180 & cd_extrap=cd_extrap(:), & 2181 & cd_filter=cd_filter(:), & 2182 & cd_unt=cd_unt, dd_unf=dd_unf ) 2009 2183 2010 2184 DEALLOCATE( dl_value ) … … 2028 2202 ! 2029 2203 !> @author J.Paul 2030 !> - November, 2013- Initial Version 2204 !> @date November, 2013 - Initial Version 2205 !> @date June, 2015 2206 !> - add interp, extrap, and filter argument 2207 !> @date July, 2015 2208 !> - add unit factor (to change unit) 2031 2209 ! 2032 2210 !> @param[in] cd_name : variable name … … 2058 2236 !> deflation is in use 2059 2237 !> @param[in] id_chunksz : chunk size 2238 !> @param[in] cd_interp interpolation method 2239 !> @param[in] cd_extrap extrapolation method 2240 !> @param[in] cd_filter filter method 2241 !> @param[in] cd_unt new units (linked to units factor) 2242 !> @param[in] dd_unf units factor 2060 2243 !> @return variable structure 2061 2244 !------------------------------------------------------------------- … … 2068 2251 & dd_min, dd_max, & 2069 2252 & ld_contiguous, ld_shuffle,& 2070 & ld_fletcher32, id_deflvl, id_chunksz) 2253 & ld_fletcher32, id_deflvl, id_chunksz, & 2254 & cd_interp, cd_extrap, cd_filter, & 2255 & cd_unt, dd_unf) 2071 2256 2072 2257 IMPLICIT NONE … … 2097 2282 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2098 2283 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2284 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2285 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2286 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2287 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2288 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2099 2289 2100 2290 ! local variable … … 2143 2333 & ld_fletcher32=ld_fletcher32, & 2144 2334 & id_deflvl=id_deflvl, & 2145 & id_chunksz=id_chunksz(:)) 2335 & id_chunksz=id_chunksz(:), & 2336 & cd_interp=cd_interp(:), & 2337 & cd_extrap=cd_extrap(:), & 2338 & cd_filter=cd_filter(:), & 2339 & cd_unt=cd_unt, dd_unf=dd_unf) 2146 2340 2147 2341 DEALLOCATE( dl_value ) … … 2165 2359 ! 2166 2360 !> @author J.Paul 2167 !> - November, 2013- Initial Version 2361 !> @date November, 2013 - Initial Version 2362 !> @date June, 2015 2363 !> - add interp, extrap, and filter argument 2364 !> @date July, 2015 2365 !> - add unit factor (to change unit) 2168 2366 ! 2169 2367 !> @param[in] cd_name variable name … … 2195 2393 !> deflation is in use 2196 2394 !> @param[in] id_chunksz chunk size 2395 !> @param[in] cd_interp interpolation method 2396 !> @param[in] cd_extrap extrapolation method 2397 !> @param[in] cd_filter filter method 2398 !> @param[in] cd_unt new units (linked to units factor) 2399 !> @param[in] dd_unf units factor 2197 2400 !> @return variable structure 2198 2401 !------------------------------------------------------------------- … … 2205 2408 & dd_min, dd_max, & 2206 2409 & ld_contiguous, ld_shuffle,& 2207 & ld_fletcher32, id_deflvl, id_chunksz) 2410 & ld_fletcher32, id_deflvl, id_chunksz, & 2411 & cd_interp, cd_extrap, cd_filter, & 2412 & cd_unt, dd_unf) 2208 2413 2209 2414 IMPLICIT NONE … … 2234 2439 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2235 2440 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2441 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2442 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2443 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2444 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2445 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2236 2446 2237 2447 ! local variable … … 2281 2491 & ld_fletcher32=ld_fletcher32, & 2282 2492 & id_deflvl=id_deflvl, & 2283 & id_chunksz=id_chunksz(:)) 2493 & id_chunksz=id_chunksz(:), & 2494 & cd_interp=cd_interp(:), & 2495 & cd_extrap=cd_extrap(:), & 2496 & cd_filter=cd_filter(:), & 2497 & cd_unt=cd_unt, dd_unf=dd_unf) 2284 2498 2285 2499 DEALLOCATE( dl_value ) … … 2303 2517 ! 2304 2518 !> @author J.Paul 2305 !> - November, 2013- Initial Version 2519 !> @date November, 2013 - Initial Version 2520 !> @date June, 2015 2521 !> - add interp, extrap, and filter argument 2522 !> @date July, 2015 2523 !> - add unit factor (to change unit) 2306 2524 ! 2307 2525 !> @param[in] cd_name : variable name … … 2333 2551 !> deflation is in use 2334 2552 !> @param[in] id_chunksz : chunk size 2553 !> @param[in] cd_interp interpolation method 2554 !> @param[in] cd_extrap extrapolation method 2555 !> @param[in] cd_filter filter method 2556 !> @param[in] cd_unt new units (linked to units factor) 2557 !> @param[in] dd_unf units factor 2335 2558 !> @return variable structure 2336 2559 !------------------------------------------------------------------- … … 2343 2566 & dd_min, dd_max, & 2344 2567 & ld_contiguous, ld_shuffle,& 2345 & ld_fletcher32, id_deflvl, id_chunksz) 2568 & ld_fletcher32, id_deflvl, id_chunksz, & 2569 & cd_interp, cd_extrap, cd_filter, & 2570 & cd_unt, dd_unf) 2346 2571 2347 2572 IMPLICIT NONE … … 2372 2597 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2373 2598 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2599 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2600 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2601 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2602 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2603 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2374 2604 2375 2605 ! local variable … … 2415 2645 & ld_fletcher32=ld_fletcher32, & 2416 2646 & id_deflvl=id_deflvl, & 2417 & id_chunksz=id_chunksz(:)) 2647 & id_chunksz=id_chunksz(:), & 2648 & cd_interp=cd_interp(:), & 2649 & cd_extrap=cd_extrap(:), & 2650 & cd_filter=cd_filter(:), & 2651 & cd_unt=cd_unt, dd_unf=dd_unf) 2418 2652 2419 2653 DEALLOCATE( dl_value ) … … 2437 2671 ! 2438 2672 !> @author J.Paul 2439 !> - November, 2013- Initial Version 2673 !> @date November, 2013 - Initial Version 2674 !> @date June, 2015 2675 !> - add interp, extrap, and filter argument 2676 !> @date July, 2015 2677 !> - add unit factor (to change unit) 2440 2678 ! 2441 2679 !> @param[in] cd_name variable name … … 2465 2703 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 2466 2704 !> @param[in] id_chunksz chunk size 2705 !> @param[in] cd_interp interpolation method 2706 !> @param[in] cd_extrap extrapolation method 2707 !> @param[in] cd_filter filter method 2708 !> @param[in] cd_unt new units (linked to units factor) 2709 !> @param[in] dd_unf units factor 2467 2710 !> @return variable structure 2468 2711 !------------------------------------------------------------------- … … 2475 2718 & dd_min, dd_max, & 2476 2719 & ld_contiguous, ld_shuffle,& 2477 & ld_fletcher32, id_deflvl, id_chunksz) 2720 & ld_fletcher32, id_deflvl, id_chunksz, & 2721 & cd_interp, cd_extrap, cd_filter, & 2722 & cd_unt, dd_unf) 2478 2723 2479 2724 IMPLICIT NONE … … 2504 2749 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2505 2750 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2751 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2752 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2753 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2754 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2755 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2506 2756 2507 2757 ! local variable … … 2549 2799 & ld_fletcher32=ld_fletcher32, & 2550 2800 & id_deflvl=id_deflvl, & 2551 & id_chunksz=id_chunksz(:)) 2801 & id_chunksz=id_chunksz(:), & 2802 & cd_interp=cd_interp(:), & 2803 & cd_extrap=cd_extrap(:), & 2804 & cd_filter=cd_filter(:), & 2805 & cd_unt=cd_unt, dd_unf=dd_unf) 2552 2806 2553 2807 DEALLOCATE( dl_value ) … … 2571 2825 ! 2572 2826 !> @author J.Paul 2573 !> - November, 2013- Initial Version 2827 !> @date November, 2013 - Initial Version 2828 !> @date June, 2015 2829 !> - add interp, extrap, and filter argument 2830 !> @date July, 2015 2831 !> - add unit factor (to change unit) 2574 2832 ! 2575 2833 !> @param[in] cd_name variable name … … 2601 2859 !> deflation is in use 2602 2860 !> @param[in] id_chunksz chunk size 2861 !> @param[in] cd_interp interpolation method 2862 !> @param[in] cd_extrap extrapolation method 2863 !> @param[in] cd_filter filter method 2864 !> @param[in] cd_unt new units (linked to units factor) 2865 !> @param[in] dd_unf units factor 2603 2866 !> @return variable structure 2604 2867 !------------------------------------------------------------------- … … 2611 2874 & dd_min, dd_max, & 2612 2875 & ld_contiguous, ld_shuffle,& 2613 & ld_fletcher32, id_deflvl, id_chunksz) 2876 & ld_fletcher32, id_deflvl, id_chunksz, & 2877 & cd_interp, cd_extrap, cd_filter, & 2878 & cd_unt, dd_unf) 2614 2879 2615 2880 IMPLICIT NONE … … 2640 2905 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2641 2906 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2907 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2908 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2909 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2910 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2911 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2642 2912 2643 2913 ! local variable … … 2686 2956 & ld_fletcher32=ld_fletcher32, & 2687 2957 & id_deflvl=id_deflvl, & 2688 & id_chunksz=id_chunksz(:)) 2958 & id_chunksz=id_chunksz(:), & 2959 & cd_interp=cd_interp(:), & 2960 & cd_extrap=cd_extrap(:), & 2961 & cd_filter=cd_filter(:), & 2962 & cd_unt=cd_unt, dd_unf=dd_unf) 2689 2963 2690 2964 DEALLOCATE( dl_value ) … … 2708 2982 ! 2709 2983 !> @author J.Paul 2710 !> - November, 2013- Initial Version 2984 !> @date November, 2013 - Initial Version 2985 !> @date June, 2015 2986 !> - add interp, extrap, and filter argument 2987 !> @date July, 2015 2988 !> - add unit factor (to change unit) 2711 2989 ! 2712 2990 !> @param[in] cd_name variable name … … 2738 3016 !> deflation is in use 2739 3017 !> @param[in] id_chunksz chunk size 3018 !> @param[in] cd_interp interpolation method 3019 !> @param[in] cd_extrap extrapolation method 3020 !> @param[in] cd_filter filter method 3021 !> @param[in] cd_unt new units (linked to units factor) 3022 !> @param[in] dd_unf units factor 2740 3023 !> @return variable structure 2741 3024 !------------------------------------------------------------------- … … 2748 3031 & dd_min, dd_max, & 2749 3032 & ld_contiguous, ld_shuffle,& 2750 & ld_fletcher32, id_deflvl, id_chunksz) 3033 & ld_fletcher32, id_deflvl, id_chunksz, & 3034 & cd_interp, cd_extrap, cd_filter, & 3035 & cd_unt, dd_unf) 2751 3036 2752 3037 IMPLICIT NONE … … 2777 3062 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2778 3063 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3064 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3065 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3066 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3067 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3068 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3069 2779 3070 2780 3071 ! local variable … … 2824 3115 & ld_fletcher32=ld_fletcher32, & 2825 3116 & id_deflvl=id_deflvl, & 2826 & id_chunksz=id_chunksz(:)) 3117 & id_chunksz=id_chunksz(:), & 3118 & cd_interp=cd_interp(:), & 3119 & cd_extrap=cd_extrap(:), & 3120 & cd_filter=cd_filter(:), & 3121 & cd_unt=cd_unt, dd_unf=dd_unf) 2827 3122 2828 3123 DEALLOCATE( dl_value ) … … 2846 3141 ! 2847 3142 !> @author J.Paul 2848 !> - November, 2013- Initial Version 3143 !> @date November, 2013 - Initial Version 3144 !> @date June, 2015 3145 !> - add interp, extrap, and filter argument 3146 !> @date July, 2015 3147 !> - add unit factor (to change unit) 2849 3148 ! 2850 3149 !> @param[in] cd_name variable name … … 2876 3175 !> deflation is in use 2877 3176 !> @param[in] id_chunksz chunk size 3177 !> @param[in] cd_interp interpolation method 3178 !> @param[in] cd_extrap extrapolation method 3179 !> @param[in] cd_filter filter method 3180 !> @param[in] cd_unt new units (linked to units factor) 3181 !> @param[in] dd_unf units factor 2878 3182 !> @return variable structure 2879 3183 !------------------------------------------------------------------- … … 2886 3190 & dd_min, dd_max, & 2887 3191 & ld_contiguous, ld_shuffle,& 2888 & ld_fletcher32, id_deflvl, id_chunksz) 3192 & ld_fletcher32, id_deflvl, id_chunksz, & 3193 & cd_interp, cd_extrap, cd_filter, & 3194 & cd_unt, dd_unf) 2889 3195 2890 3196 IMPLICIT NONE … … 2915 3221 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2916 3222 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3223 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3224 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3225 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3226 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3227 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2917 3228 2918 3229 ! local variable … … 2958 3269 & ld_fletcher32=ld_fletcher32, & 2959 3270 & id_deflvl=id_deflvl, & 2960 & id_chunksz=id_chunksz(:)) 3271 & id_chunksz=id_chunksz(:), & 3272 & cd_interp=cd_interp(:), & 3273 & cd_extrap=cd_extrap(:), & 3274 & cd_filter=cd_filter(:), & 3275 & cd_unt=cd_unt, dd_unf=dd_unf) 2961 3276 2962 3277 DEALLOCATE( dl_value ) … … 2980 3295 ! 2981 3296 !> @author J.Paul 2982 !> - November, 2013- Initial Version 3297 !> @date November, 2013 - Initial Version 3298 !> @date June, 2015 3299 !> - add interp, extrap, and filter argument 3300 !> @date July, 2015 3301 !> - add unit factor (to change unit) 2983 3302 ! 2984 3303 !> @param[in] cd_name variable name … … 3010 3329 !> deflation is in use 3011 3330 !> @param[in] id_chunksz chunk size 3331 !> @param[in] cd_interp interpolation method 3332 !> @param[in] cd_extrap extrapolation method 3333 !> @param[in] cd_filter filter method 3334 !> @param[in] cd_unt new units (linked to units factor) 3335 !> @param[in] dd_unf units factor 3012 3336 !> @return variable structure 3013 3337 !------------------------------------------------------------------- … … 3020 3344 & dd_min, dd_max, & 3021 3345 & ld_contiguous, ld_shuffle,& 3022 & ld_fletcher32, id_deflvl, id_chunksz) 3346 & ld_fletcher32, id_deflvl, id_chunksz, & 3347 & cd_interp, cd_extrap, cd_filter, & 3348 & cd_unt, dd_unf) 3023 3349 3024 3350 IMPLICIT NONE … … 3049 3375 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3050 3376 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3377 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3378 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3379 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3380 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3381 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3051 3382 3052 3383 ! local variable … … 3094 3425 & ld_fletcher32=ld_fletcher32, & 3095 3426 & id_deflvl=id_deflvl, & 3096 & id_chunksz=id_chunksz(:)) 3427 & id_chunksz=id_chunksz(:), & 3428 & cd_interp=cd_interp(:), & 3429 & cd_extrap=cd_extrap(:), & 3430 & cd_filter=cd_filter(:), & 3431 & cd_unt=cd_unt, dd_unf=dd_unf) 3097 3432 3098 3433 DEALLOCATE( dl_value ) … … 3116 3451 ! 3117 3452 !> @author J.Paul 3118 !> - November, 2013- Initial Version 3453 !> @date November, 2013 - Initial Version 3454 !> @date June, 2015 3455 !> - add interp, extrap, and filter argument 3456 !> @date July, 2015 3457 !> - add unit factor (to change unit) 3119 3458 ! 3120 3459 !> @param[in] cd_name variable name … … 3146 3485 !> deflation is in use 3147 3486 !> @param[in] id_chunksz chunk size 3487 !> @param[in] cd_interp interpolation method 3488 !> @param[in] cd_extrap extrapolation method 3489 !> @param[in] cd_filter filter method 3490 !> @param[in] cd_unt new units (linked to units factor) 3491 !> @param[in] dd_unf units factor 3148 3492 !> @return variable structure 3149 3493 !------------------------------------------------------------------- … … 3156 3500 & dd_min, dd_max, & 3157 3501 & ld_contiguous, ld_shuffle,& 3158 & ld_fletcher32, id_deflvl, id_chunksz) 3502 & ld_fletcher32, id_deflvl, id_chunksz, & 3503 & cd_interp, cd_extrap, cd_filter, & 3504 & cd_unt, dd_unf) 3159 3505 3160 3506 IMPLICIT NONE … … 3185 3531 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3186 3532 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3533 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3534 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3535 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3536 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3537 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3187 3538 3188 3539 ! local variable … … 3231 3582 & ld_fletcher32=ld_fletcher32, & 3232 3583 & id_deflvl=id_deflvl, & 3233 & id_chunksz=id_chunksz(:)) 3584 & id_chunksz=id_chunksz(:), & 3585 & cd_interp=cd_interp(:), & 3586 & cd_extrap=cd_extrap(:), & 3587 & cd_filter=cd_filter(:), & 3588 & cd_unt=cd_unt, dd_unf=dd_unf) 3234 3589 3235 3590 DEALLOCATE( dl_value ) … … 3253 3608 ! 3254 3609 !> @author J.Paul 3255 !> - November, 2013- Initial Version 3610 !> @date November, 2013 - Initial Version 3611 !> @date June, 2015 3612 !> - add interp, extrap, and filter argument 3613 !> @date July, 2015 3614 !> - add unit factor (to change unit) 3256 3615 ! 3257 3616 !> @param[in] cd_name variable name … … 3283 3642 !> deflation is in use 3284 3643 !> @param[in] id_chunksz chunk size 3644 !> @param[in] cd_interp interpolation method 3645 !> @param[in] cd_extrap extrapolation method 3646 !> @param[in] cd_filter filter method 3647 !> @param[in] cd_unt new units (linked to units factor) 3648 !> @param[in] dd_unf units factor 3649 3285 3650 !> @return variable structure 3286 3651 !------------------------------------------------------------------- … … 3293 3658 & dd_min, dd_max, & 3294 3659 & ld_contiguous, ld_shuffle,& 3295 & ld_fletcher32, id_deflvl, id_chunksz) 3660 & ld_fletcher32, id_deflvl, id_chunksz, & 3661 & cd_interp, cd_extrap, cd_filter, & 3662 & cd_unt, dd_unf) 3296 3663 3297 3664 IMPLICIT NONE … … 3322 3689 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3323 3690 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3691 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3692 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3693 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3694 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3695 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3324 3696 3325 3697 ! local variable … … 3369 3741 & ld_fletcher32=ld_fletcher32, & 3370 3742 & id_deflvl=id_deflvl, & 3371 & id_chunksz=id_chunksz(:)) 3743 & id_chunksz=id_chunksz(:), & 3744 & cd_interp=cd_interp(:), & 3745 & cd_extrap=cd_extrap(:), & 3746 & cd_filter=cd_filter(:), & 3747 & cd_unt=cd_unt, dd_unf=dd_unf) 3372 3748 3373 3749 DEALLOCATE( dl_value ) … … 3391 3767 ! 3392 3768 !> @author J.Paul 3393 !> - November, 2013- Initial Version 3769 !> @date November, 2013 - Initial Version 3770 !> @date June, 2015 3771 !> - add interp, extrap, and filter argument 3772 !> @date July, 2015 3773 !> - add unit factor (to change unit) 3394 3774 ! 3395 3775 !> @param[in] cd_name variable name … … 3421 3801 !> deflation is in use 3422 3802 !> @param[in] id_chunksz chunk size 3803 !> @param[in] cd_interp interpolation method 3804 !> @param[in] cd_extrap extrapolation method 3805 !> @param[in] cd_filter filter method 3806 !> @param[in] cd_unt new units (linked to units factor) 3807 !> @param[in] dd_unf units factor 3423 3808 !> @return variable structure 3424 3809 !------------------------------------------------------------------- … … 3431 3816 & dd_min, dd_max, & 3432 3817 & ld_contiguous, ld_shuffle,& 3433 & ld_fletcher32, id_deflvl, id_chunksz) 3818 & ld_fletcher32, id_deflvl, id_chunksz, & 3819 & cd_interp, cd_extrap, cd_filter, & 3820 & cd_unt, dd_unf) 3434 3821 3435 3822 IMPLICIT NONE … … 3460 3847 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3461 3848 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3849 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3850 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3851 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3852 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3853 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3854 3462 3855 3463 3856 ! local variable … … 3503 3896 & ld_fletcher32=ld_fletcher32, & 3504 3897 & id_deflvl=id_deflvl, & 3505 & id_chunksz=id_chunksz(:)) 3898 & id_chunksz=id_chunksz(:), & 3899 & cd_interp=cd_interp(:), & 3900 & cd_extrap=cd_extrap(:), & 3901 & cd_filter=cd_filter(:), & 3902 & cd_unt=cd_unt, dd_unf=dd_unf) 3506 3903 3507 3904 DEALLOCATE( dl_value ) … … 3525 3922 ! 3526 3923 !> @author J.Paul 3527 !> - November, 2013- Initial Version 3924 !> @date November, 2013 - Initial Version 3925 !> @date June, 2015 3926 !> - add interp, extrap, and filter argument 3927 !> @date July, 2015 3928 !> - add unit factor (to change unit) 3528 3929 ! 3529 3930 !> @param[in] cd_name variable name … … 3555 3956 !> deflation is in use 3556 3957 !> @param[in] id_chunksz chunk size 3958 !> @param[in] cd_interp interpolation method 3959 !> @param[in] cd_extrap extrapolation method 3960 !> @param[in] cd_filter filter method 3961 !> @param[in] cd_unt new units (linked to units factor) 3962 !> @param[in] dd_unf units factor 3557 3963 !> @return variable structure 3558 3964 !------------------------------------------------------------------- … … 3565 3971 & dd_min, dd_max, & 3566 3972 & ld_contiguous, ld_shuffle,& 3567 & ld_fletcher32, id_deflvl, id_chunksz) 3973 & ld_fletcher32, id_deflvl, id_chunksz, & 3974 & cd_interp, cd_extrap, cd_filter, & 3975 & cd_unt, dd_unf) 3568 3976 3569 3977 IMPLICIT NONE … … 3594 4002 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3595 4003 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4004 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4005 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4006 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4007 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4008 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4009 3596 4010 3597 4011 ! local variable … … 3639 4053 & ld_fletcher32=ld_fletcher32, & 3640 4054 & id_deflvl=id_deflvl, & 3641 & id_chunksz=id_chunksz(:)) 4055 & id_chunksz=id_chunksz(:), & 4056 & cd_interp=cd_interp(:), & 4057 & cd_extrap=cd_extrap(:), & 4058 & cd_filter=cd_filter(:), & 4059 & cd_unt=cd_unt, dd_unf=dd_unf) 3642 4060 3643 4061 DEALLOCATE( dl_value ) … … 3661 4079 ! 3662 4080 !> @author J.Paul 3663 !> - November, 2013- Initial Version 4081 !> @date November, 2013 - Initial Version 4082 !> @date June, 2015 4083 !> - add interp, extrap, and filter argument 4084 !> @date July, 2015 4085 !> - add unit factor (to change unit) 3664 4086 ! 3665 4087 !> @param[in] cd_name variable name … … 3691 4113 !> deflation is in use 3692 4114 !> @param[in] id_chunksz chunk size 4115 !> @param[in] cd_interp interpolation method 4116 !> @param[in] cd_extrap extrapolation method 4117 !> @param[in] cd_filter filter method 4118 !> @param[in] cd_unt new units (linked to units factor) 4119 !> @param[in] dd_unf units factor 3693 4120 !> @return variable structure 3694 4121 !------------------------------------------------------------------- … … 3701 4128 & dd_min, dd_max, & 3702 4129 & ld_contiguous, ld_shuffle,& 3703 & ld_fletcher32, id_deflvl, id_chunksz) 4130 & ld_fletcher32, id_deflvl, id_chunksz, & 4131 & cd_interp, cd_extrap, cd_filter, & 4132 & cd_unt, dd_unf) 3704 4133 3705 4134 IMPLICIT NONE … … 3730 4159 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3731 4160 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4161 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4162 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4163 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4164 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4165 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3732 4166 3733 4167 ! local variable … … 3776 4210 & ld_fletcher32=ld_fletcher32, & 3777 4211 & id_deflvl=id_deflvl, & 3778 & id_chunksz=id_chunksz(:)) 4212 & id_chunksz=id_chunksz(:), & 4213 & cd_interp=cd_interp(:), & 4214 & cd_extrap=cd_extrap(:), & 4215 & cd_filter=cd_filter(:), & 4216 & cd_unt=cd_unt, dd_unf=dd_unf) 3779 4217 3780 4218 DEALLOCATE( dl_value ) … … 3798 4236 ! 3799 4237 !> @author J.Paul 3800 !> - November, 2013- Initial Version 4238 !> @date November, 2013 - Initial Version 4239 !> @date June, 2015 4240 !> - add interp, extrap, and filter argument 4241 !> @date July, 2015 4242 !> - add unit factor (to change unit) 3801 4243 ! 3802 4244 !> @param[in] cd_name variable name … … 3828 4270 !> deflation is in use 3829 4271 !> @param[in] id_chunksz chunk size 4272 !> @param[in] cd_interp interpolation method 4273 !> @param[in] cd_extrap extrapolation method 4274 !> @param[in] cd_filter filter method 4275 !> @param[in] cd_unt new units (linked to units factor) 4276 !> @param[in] dd_unf units factor 3830 4277 !> @return variable structure 3831 4278 !------------------------------------------------------------------- … … 3838 4285 & dd_min, dd_max, & 3839 4286 & ld_contiguous, ld_shuffle,& 3840 & ld_fletcher32, id_deflvl, id_chunksz) 4287 & ld_fletcher32, id_deflvl, id_chunksz, & 4288 & cd_interp, cd_extrap, cd_filter, & 4289 & cd_unt, dd_unf) 3841 4290 3842 4291 IMPLICIT NONE … … 3867 4316 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3868 4317 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4318 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4319 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4320 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4321 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4322 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3869 4323 3870 4324 ! local variable … … 3914 4368 & ld_fletcher32=ld_fletcher32, & 3915 4369 & id_deflvl=id_deflvl, & 3916 & id_chunksz=id_chunksz(:)) 4370 & id_chunksz=id_chunksz(:), & 4371 & cd_interp=cd_interp(:), & 4372 & cd_extrap=cd_extrap(:), & 4373 & cd_filter=cd_filter(:), & 4374 & cd_unt=cd_unt, dd_unf=dd_unf) 3917 4375 3918 4376 DEALLOCATE( dl_value ) … … 3936 4394 ! 3937 4395 !> @author J.Paul 3938 !> - November, 2013- Initial Version 4396 !> @date November, 2013 - Initial Version 4397 !> @date June, 2015 4398 !> - add interp, extrap, and filter argument 4399 !> @date July, 2015 4400 !> - add unit factor (to change unit) 3939 4401 ! 3940 4402 !> @param[in] cd_name variable name … … 3966 4428 !> deflation is in use 3967 4429 !> @param[in] id_chunksz chunk size 4430 !> @param[in] cd_interp interpolation method 4431 !> @param[in] cd_extrap extrapolation method 4432 !> @param[in] cd_filter filter method 4433 !> @param[in] cd_unt new units (linked to units factor) 4434 !> @param[in] dd_unf units factor 3968 4435 !> @return variable structure 3969 4436 !------------------------------------------------------------------- … … 3976 4443 & dd_min, dd_max, & 3977 4444 & ld_contiguous, ld_shuffle,& 3978 & ld_fletcher32, id_deflvl, id_chunksz) 4445 & ld_fletcher32, id_deflvl, id_chunksz, & 4446 & cd_interp, cd_extrap, cd_filter, & 4447 & cd_unt, dd_unf) 3979 4448 3980 4449 IMPLICIT NONE … … 4005 4474 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4006 4475 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4476 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4477 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4478 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4479 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4480 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4007 4481 4008 4482 ! local variable … … 4048 4522 & ld_fletcher32=ld_fletcher32, & 4049 4523 & id_deflvl=id_deflvl, & 4050 & id_chunksz=id_chunksz(:)) 4524 & id_chunksz=id_chunksz(:), & 4525 & cd_interp=cd_interp(:), & 4526 & cd_extrap=cd_extrap(:), & 4527 & cd_filter=cd_filter(:), & 4528 & cd_unt=cd_unt, dd_unf=dd_unf) 4051 4529 4052 4530 DEALLOCATE( dl_value ) … … 4070 4548 ! 4071 4549 !> @author J.Paul 4072 !> - November, 2013- Initial Version 4550 !> @date November, 2013 - Initial Version 4551 !> @date June, 2015 4552 !> - add interp, extrap, and filter argument 4553 !> @date July, 2015 4554 !> - add unit factor (to change unit) 4073 4555 ! 4074 4556 !> @param[in] cd_name variable name … … 4100 4582 !> deflation is in use 4101 4583 !> @param[in] id_chunksz chunk size 4584 !> @param[in] cd_interp interpolation method 4585 !> @param[in] cd_extrap extrapolation method 4586 !> @param[in] cd_filter filter method 4587 !> @param[in] cd_unt new units (linked to units factor) 4588 !> @param[in] dd_unf units factor 4102 4589 !> @return variable structure 4103 4590 !------------------------------------------------------------------- … … 4110 4597 & dd_min, dd_max, & 4111 4598 & ld_contiguous, ld_shuffle,& 4112 & ld_fletcher32, id_deflvl, id_chunksz) 4599 & ld_fletcher32, id_deflvl, id_chunksz, & 4600 & cd_interp, cd_extrap, cd_filter, & 4601 & cd_unt, dd_unf) 4113 4602 4114 4603 IMPLICIT NONE … … 4139 4628 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4140 4629 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4630 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4631 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4632 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4633 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4634 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4141 4635 4142 4636 ! local variable … … 4184 4678 & ld_fletcher32=ld_fletcher32, & 4185 4679 & id_deflvl=id_deflvl, & 4186 & id_chunksz=id_chunksz(:)) 4680 & id_chunksz=id_chunksz(:), & 4681 & cd_interp=cd_interp(:), & 4682 & cd_extrap=cd_extrap(:), & 4683 & cd_filter=cd_filter(:), & 4684 & cd_unt=cd_unt, dd_unf=dd_unf) 4187 4685 4188 4686 DEALLOCATE( dl_value ) … … 4206 4704 ! 4207 4705 !> @author J.Paul 4208 !> - November, 2013- Initial Version 4706 !> @date November, 2013 - Initial Version 4707 !> @date June, 2015 4708 !> - add interp, extrap, and filter argument 4709 !> @date July, 2015 4710 !> - add unit factor (to change unit) 4209 4711 ! 4210 4712 !> @param[in] cd_name variable name … … 4236 4738 !> deflation is in use 4237 4739 !> @param[in] id_chunksz chunk size 4740 !> @param[in] cd_interp interpolation method 4741 !> @param[in] cd_extrap extrapolation method 4742 !> @param[in] cd_filter filter method 4743 !> @param[in] cd_unt new units (linked to units factor) 4744 !> @param[in] dd_unf units factor 4238 4745 !> @return variable structure 4239 4746 !------------------------------------------------------------------- … … 4246 4753 & dd_min, dd_max, & 4247 4754 & ld_contiguous, ld_shuffle,& 4248 & ld_fletcher32, id_deflvl, id_chunksz) 4755 & ld_fletcher32, id_deflvl, id_chunksz, & 4756 & cd_interp, cd_extrap, cd_filter, & 4757 & cd_unt, dd_unf) 4249 4758 4250 4759 IMPLICIT NONE … … 4275 4784 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4276 4785 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4786 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4787 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4788 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4789 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4790 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4277 4791 4278 4792 ! local variable … … 4321 4835 & ld_fletcher32=ld_fletcher32, & 4322 4836 & id_deflvl=id_deflvl, & 4323 & id_chunksz=id_chunksz(:)) 4837 & id_chunksz=id_chunksz(:), & 4838 & cd_interp=cd_interp(:), & 4839 & cd_extrap=cd_extrap(:), & 4840 & cd_filter=cd_filter(:), & 4841 & cd_unt=cd_unt, dd_unf=dd_unf) 4324 4842 4325 4843 DEALLOCATE( dl_value ) … … 4343 4861 ! 4344 4862 !> @author J.Paul 4345 !> - November, 2013- Initial Version 4863 !> @date November, 2013 - Initial Version 4864 !> @date June, 2015 4865 !> - add interp, extrap, and filter argument 4866 !> @date July, 2015 4867 !> - add unit factor (to change unit) 4346 4868 ! 4347 4869 !> @param[in] cd_name variable name … … 4373 4895 !> deflation is in use 4374 4896 !> @param[in] id_chunksz chunk size 4897 !> @param[in] cd_interp interpolation method 4898 !> @param[in] cd_extrap extrapolation method 4899 !> @param[in] cd_filter filter method 4900 !> @param[in] cd_unt new units (linked to units factor) 4901 !> @param[in] dd_unf units factor 4375 4902 !> @return variable structure 4376 4903 !------------------------------------------------------------------- … … 4383 4910 & dd_min, dd_max, & 4384 4911 & ld_contiguous, ld_shuffle,& 4385 & ld_fletcher32, id_deflvl, id_chunksz) 4912 & ld_fletcher32, id_deflvl, id_chunksz, & 4913 & cd_interp, cd_extrap, cd_filter, & 4914 & cd_unt, dd_unf) 4386 4915 4387 4916 IMPLICIT NONE … … 4412 4941 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4413 4942 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4943 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4944 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4945 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4946 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4947 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4414 4948 4415 4949 ! local variable … … 4459 4993 & ld_fletcher32=ld_fletcher32, & 4460 4994 & id_deflvl=id_deflvl, & 4461 & id_chunksz=id_chunksz(:)) 4995 & id_chunksz=id_chunksz(:), & 4996 & cd_interp=cd_interp(:), & 4997 & cd_extrap=cd_extrap(:), & 4998 & cd_filter=cd_filter(:), & 4999 & cd_unt=cd_unt, dd_unf=dd_unf) 4462 5000 4463 5001 DEALLOCATE( dl_value ) … … 4473 5011 !> 4474 5012 !> @author J.Paul 4475 !> - November, 2013- Initial Version5013 !> @date November, 2013 - Initial Version 4476 5014 ! 4477 5015 !> @param[in] td_var1 variable structure … … 4523 5061 !> 4524 5062 !> @author J.Paul 4525 !> - November, 2013- Initial Version5063 !> @date November, 2013 - Initial Version 4526 5064 ! 4527 5065 !> @param[in] td_var1 variable structure … … 4595 5133 !> 4596 5134 !> @author J.Paul 4597 !> - November, 2013- Initial Version5135 !> @date November, 2013 - Initial Version 4598 5136 ! 4599 5137 !> @param[in] td_var1 variable structure … … 4670 5208 !> 4671 5209 !> @author J.Paul 4672 !> - November, 2013- Initial Version5210 !> @date November, 2013 - Initial Version 4673 5211 ! 4674 5212 !> @param[in] td_var1 variable structure … … 4745 5283 !> 4746 5284 !> @author J.Paul 4747 !> - November, 2013- Initial Version5285 !> @date November, 2013 - Initial Version 4748 5286 ! 4749 5287 !> @param[in] td_var1 variable structure … … 4820 5358 !> 4821 5359 !> @author J.Paul 4822 !> - November, 2013- Initial Version 5360 !> @date November, 2013 - Initial Version 5361 !> @date June, 2015 5362 !> - add all element of the array in the same time 4823 5363 !> 4824 5364 !> @param[inout] td_var variable structure … … 4833 5373 ! local variable 4834 5374 INTEGER(i4) :: il_natt 5375 INTEGER(i4) :: il_status 5376 INTEGER(i4) :: il_ind 5377 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 4835 5378 4836 5379 ! loop indices … … 4840 5383 il_natt=SIZE(td_att(:)) 4841 5384 5385 IF( td_var%i_natt > 0 )THEN 5386 ! already other attribute in variable structure 5387 ALLOCATE( tl_att(td_var%i_natt), stat=il_status ) 5388 IF(il_status /= 0 )THEN 5389 5390 CALL logger_error( & 5391 & " VAR ADD ATT: not enough space to put attributes from "//& 5392 & TRIM(td_var%c_name)//" in temporary attribute structure") 5393 5394 ELSE 5395 5396 ! save temporary global attribute's variable structure 5397 tl_att(:)=att_copy(td_var%t_att(:)) 5398 5399 CALL att_clean(td_var%t_att(:)) 5400 DEALLOCATE( td_var%t_att ) 5401 ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 5402 IF(il_status /= 0 )THEN 5403 5404 CALL logger_error( & 5405 & " VAR ADD ATT: not enough space to put attributes "//& 5406 & "in variable structure "//TRIM(td_var%c_name) ) 5407 5408 ENDIF 5409 5410 ! copy attribute in variable before 5411 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 5412 5413 ! clean 5414 CALL att_clean(tl_att(:)) 5415 DEALLOCATE(tl_att) 5416 5417 ENDIF 5418 ELSE 5419 ! no attribute in variable structure 5420 IF( ASSOCIATED(td_var%t_att) )THEN 5421 CALL att_clean(td_var%t_att(:)) 5422 DEALLOCATE(td_var%t_att) 5423 ENDIF 5424 ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 5425 IF(il_status /= 0 )THEN 5426 5427 CALL logger_error( & 5428 & " VAR ADD ATT: not enough space to put attributes "//& 5429 & "in variable structure "//TRIM(td_var%c_name) ) 5430 5431 ENDIF 5432 ENDIF 5433 5434 ALLOCATE( tl_att(il_natt) ) 5435 tl_att(:)=att_copy(td_att(:)) 5436 5437 ! check if attribute already in variable structure 4842 5438 DO ji=1,il_natt 4843 CALL var_add_att(td_var, td_att(ji)) 5439 il_ind=0 5440 il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name ) 5441 IF( il_ind /= 0 )THEN 5442 CALL logger_error( & 5443 & " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//& 5444 & ", already in variable "//TRIM(td_var%c_name) ) 5445 CALL att_clean(tl_att(ji)) 5446 ENDIF 4844 5447 ENDDO 5448 5449 ! add new attributes 5450 td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:)) 5451 5452 DEALLOCATE(tl_att) 5453 5454 DO ji=1,il_natt 5455 ! highlight some attribute 5456 IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. & 5457 & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN 5458 SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name)) 5459 5460 CASE("add_offset") 5461 td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1) 5462 CASE("scale_factor") 5463 td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1) 5464 CASE("_FillValue") 5465 td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1) 5466 CASE("ew_overlap") 5467 td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4) 5468 CASE("standard_name") 5469 td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5470 CASE("long_name") 5471 td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5472 CASE("units") 5473 td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5474 CASE("grid_point") 5475 td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5476 5477 END SELECT 5478 ENDIF 5479 ENDDO 5480 5481 ! update number of attribute 5482 td_var%i_natt=td_var%i_natt+il_natt 5483 4845 5484 4846 5485 END SUBROUTINE var__add_att_arr … … 4850 5489 ! 4851 5490 !> @author J.Paul 4852 !> - November, 2013- Initial Version 5491 !> @date November, 2013 - Initial Version 5492 !> @date June, 2015 5493 !> - use var__add_att_arr subroutine 4853 5494 ! 4854 5495 !> @param[inout] td_var variable structure … … 4862 5503 4863 5504 ! local variable 4864 INTEGER(i4) :: il_status 4865 INTEGER(i4) :: il_ind 4866 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 5505 TYPE(TATT), DIMENSION(1) :: tl_att 4867 5506 4868 5507 ! loop indices 4869 INTEGER(i4) :: ji4870 5508 !---------------------------------------------------------------- 4871 5509 4872 ! check if attribute already in variable structure 4873 il_ind=0 4874 IF( ASSOCIATED(td_var%t_att) )THEN 4875 il_ind=att_get_index( td_var%t_att(:), td_att%c_name ) 4876 ENDIF 4877 4878 IF( il_ind /= 0 )THEN 4879 4880 CALL logger_error( & 4881 & " VAR ADD ATT: attribute "//TRIM(td_att%c_name)//& 4882 & ", already in variable "//TRIM(td_var%c_name) ) 4883 4884 DO ji=1,td_var%i_natt 4885 CALL logger_debug( & 4886 & " VAR ADD ATT: in variable "//TRIM(td_var%t_att(ji)%c_name) ) 4887 ENDDO 4888 4889 ELSE 4890 4891 CALL logger_trace( & 4892 & " VAR ADD ATT: add attribute "//TRIM(td_att%c_name)//& 4893 & ", in variable "//TRIM(td_var%c_name) ) 4894 4895 IF( td_var%i_natt > 0 )THEN 4896 ! already other attribute in variable structure 4897 ALLOCATE( tl_att(td_var%i_natt), stat=il_status ) 4898 IF(il_status /= 0 )THEN 4899 4900 CALL logger_error( & 4901 & " VAR ADD ATT: not enough space to put attributes from "//& 4902 & TRIM(td_var%c_name)//" in temporary attribute structure") 4903 4904 ELSE 4905 4906 ! save temporary global attribute's variable structure 4907 tl_att(:)=att_copy(td_var%t_att(:)) 4908 4909 CALL att_clean(td_var%t_att(:)) 4910 DEALLOCATE( td_var%t_att ) 4911 ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status ) 4912 IF(il_status /= 0 )THEN 4913 4914 CALL logger_error( & 4915 & " VAR ADD ATT: not enough space to put attributes "//& 4916 & "in variable structure "//TRIM(td_var%c_name) ) 4917 4918 ENDIF 4919 4920 ! copy attribute in variable before 4921 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 4922 4923 ! clean 4924 CALL att_clean(tl_att(:)) 4925 DEALLOCATE(tl_att) 4926 4927 ENDIF 4928 ELSE 4929 ! no attribute in variable structure 4930 IF( ASSOCIATED(td_var%t_att) )THEN 4931 CALL att_clean(td_var%t_att(:)) 4932 DEALLOCATE(td_var%t_att) 4933 ENDIF 4934 ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status ) 4935 IF(il_status /= 0 )THEN 4936 4937 CALL logger_error( & 4938 & " VAR ADD ATT: not enough space to put attributes "//& 4939 & "in variable structure "//TRIM(td_var%c_name) ) 4940 4941 ENDIF 4942 ENDIF 4943 ! update number of attribute 4944 td_var%i_natt=td_var%i_natt+1 4945 4946 ! add new attribute 4947 td_var%t_att(td_var%i_natt)=att_copy(td_att) 4948 4949 !! add new attribute id 4950 !td_var%t_att(td_var%i_natt)%i_id=att_get_unit(td_var%t_att(:)) 4951 4952 ! highlight some attribute 4953 IF( ASSOCIATED(td_var%t_att(td_var%i_natt)%d_value) .OR. & 4954 & td_var%t_att(td_var%i_natt)%c_value /= "none" )THEN 4955 SELECT CASE(TRIM(td_var%t_att(td_var%i_natt)%c_name)) 4956 4957 CASE("add_offset") 4958 td_var%d_ofs = td_var%t_att(td_var%i_natt)%d_value(1) 4959 CASE("scale_factor") 4960 td_var%d_scf = td_var%t_att(td_var%i_natt)%d_value(1) 4961 CASE("_FillValue") 4962 td_var%d_fill = td_var%t_att(td_var%i_natt)%d_value(1) 4963 CASE("ew_overlap") 4964 td_var%i_ew = INT(td_var%t_att(td_var%i_natt)%d_value(1),i4) 4965 CASE("standard_name") 4966 td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4967 CASE("long_name") 4968 td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4969 CASE("units") 4970 td_var%c_units = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4971 CASE("grid_point") 4972 td_var%c_point = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4973 4974 END SELECT 4975 ENDIF 4976 ENDIF 5510 ! copy structure in an array 5511 tl_att(1)=att_copy(td_att) 5512 5513 ! 5514 CALL var_add_att( td_var, tl_att(:) ) 4977 5515 4978 5516 END SUBROUTINE var__add_att_unit … … 4982 5520 ! 4983 5521 !> @author J.Paul 4984 !> - November, 2013- Initial Version 5522 !> @date November, 2013 - Initial Version 5523 !> @date February, 2015 5524 !> - define local attribute structure to avoid mistake 5525 !> with pointer 4985 5526 ! 4986 5527 !> @param[inout] td_var variable structure … … 4996 5537 INTEGER(i4) :: il_ind 4997 5538 5539 TYPE(TATT) :: tl_att 4998 5540 ! loop indices 4999 5541 !---------------------------------------------------------------- … … 5007 5549 IF( il_ind == 0 )THEN 5008 5550 5009 CALL logger_ warn( &5551 CALL logger_debug( & 5010 5552 & " VAR DEL ATT: no attribute "//TRIM(cd_name)//& 5011 5553 & ", in variable "//TRIM(td_var%c_name) ) … … 5013 5555 ELSE 5014 5556 5015 CALL var_del_att(td_var, td_var%t_att(il_ind)) 5557 tl_att=att_copy(td_var%t_att(il_ind)) 5558 CALL var_del_att(td_var, tl_att) 5016 5559 5017 5560 ENDIF … … 5023 5566 ! 5024 5567 !> @author J.Paul 5025 !> - November, 2013- Initial Version 5568 !> @date November, 2013- Initial Version 5569 !> @date February, 2015 5570 !> - delete highlight attribute too, when attribute 5571 !> is deleted 5026 5572 ! 5027 5573 !> @param[inout] td_var variable structure … … 5040 5586 5041 5587 ! loop indices 5042 !INTEGER(i4) :: ji5043 5588 !---------------------------------------------------------------- 5044 5589 … … 5051 5596 IF( il_ind == 0 )THEN 5052 5597 5053 CALL logger_ warn( &5598 CALL logger_debug( & 5054 5599 & " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//& 5055 5600 & ", in variable "//TRIM(td_var%c_name) ) … … 5103 5648 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 5104 5649 5105 !! change attribute id5106 !DO ji=1,td_var%i_natt5107 ! td_var%t_att(ji)%i_id=ji5108 !ENDDO5109 5110 5650 ! clean 5111 5651 CALL att_clean(tl_att(:)) … … 5113 5653 ENDIF 5114 5654 ENDIF 5655 5656 ! highlight attribute 5657 SELECT CASE( TRIM(td_att%c_name) ) 5658 5659 CASE("add_offset") 5660 td_var%d_ofs = 0._dp 5661 CASE("scale_factor") 5662 td_var%d_scf = 1._dp 5663 CASE("_FillValue") 5664 td_var%d_fill = 0._dp 5665 CASE("ew_overlap") 5666 td_var%i_ew = -1 5667 CASE("standard_name") 5668 td_var%c_stdname = '' 5669 CASE("long_name") 5670 td_var%c_longname = '' 5671 CASE("units") 5672 td_var%c_units = '' 5673 CASE("grid_point") 5674 td_var%c_point = '' 5675 5676 END SELECT 5677 5115 5678 ENDIF 5116 5679 … … 5121 5684 ! 5122 5685 !> @author J.Paul 5123 !> - November, 2013- Initial Version5686 !> @date November, 2013 - Initial Version 5124 5687 ! 5125 5688 !> @param[inout] td_var variable structure … … 5156 5719 ! 5157 5720 !> @author J.Paul 5158 !> - November, 2013- Initial Version5721 !> @date November, 2013 - Initial Version 5159 5722 ! 5160 5723 !> @param[inout] td_var variable structure … … 5195 5758 ! 5196 5759 !> @author J.Paul 5197 !> - November, 2013- Initial Version5760 !> @date November, 2013 - Initial Version 5198 5761 ! 5199 5762 !> @param[inout] td_var variable structure … … 5211 5774 !---------------------------------------------------------------- 5212 5775 5213 IF( td_var%i_ndim <= 4)THEN5776 IF( td_var%i_ndim <= ip_maxdim )THEN 5214 5777 5215 5778 ! check if dimension already used in variable structure … … 5227 5790 ELSE 5228 5791 5229 ! back to unorder dimension array 5230 CALL dim_unorder(td_var%t_dim(:)) 5792 ! back to disorder dimension array 5793 CALL dim_disorder(td_var%t_dim(:)) 5794 5231 5795 ! add new dimension 5232 5796 td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim) … … 5253 5817 ! 5254 5818 !> @author J.Paul 5255 !> - November, 2013- Initial Version5819 !> @date November, 2013 - Initial Version 5256 5820 ! 5257 5821 !> @param[inout] td_var variable structure … … 5272 5836 !---------------------------------------------------------------- 5273 5837 5274 IF( td_var%i_ndim <= 4)THEN5838 IF( td_var%i_ndim <= ip_maxdim )THEN 5275 5839 5276 5840 CALL logger_trace( & … … 5317 5881 ! 5318 5882 !> @author J.Paul 5319 !> - November, 2013- Initial Version5883 !> @date November, 2013 - Initial Version 5320 5884 ! 5321 5885 !> @param[inout] td_var variable structure … … 5360 5924 !> 5361 5925 !> @author J.Paul 5362 !> - June, 2014- Initial Version5926 !> @date June, 2014 - Initial Version 5363 5927 ! 5364 5928 !> @param[in] td_var array of variables structure … … 5386 5950 !> 5387 5951 !> @author J.Paul 5388 !> - November, 2013- Initial Version5952 !> @date November, 2013 - Initial Version 5389 5953 ! 5390 5954 !> @param[in] td_var variable structure … … 5493 6057 !> 5494 6058 !> @author J.Paul 5495 !> - November, 2013- Initial Version6059 !> @date November, 2013 - Initial Version 5496 6060 !> 5497 6061 !> @param[inout] td_var variable structure … … 5631 6195 !> 5632 6196 !> @author J.Paul 5633 !> - November, 2013- Initial Version6197 !> @date November, 2013 - Initial Version 5634 6198 !> 5635 6199 !> @param[inout] td_var variable structure … … 5685 6249 !> 5686 6250 !> @author J.Paul 5687 !> - November, 2013- Initial Version6251 !> @date November, 2013 - Initial Version 5688 6252 ! 5689 6253 !> @param[inout] td_var variable structure … … 5761 6325 ! 5762 6326 !> @author J.Paul 5763 !> - November, 2013- Initial Version6327 !> @date November, 2013 - Initial Version 5764 6328 ! 5765 6329 !> @param[inout] td_var variabele structure … … 5837 6401 ! 5838 6402 !> @author J.Paul 5839 !> - November, 2013- Initial Version6403 !> @date November, 2013 - Initial Version 5840 6404 ! 5841 6405 !> @param[inout] td_var variabele structure … … 5913 6477 ! 5914 6478 !> @author J.Paul 5915 !> - November, 2013- Initial Version6479 !> @date November, 2013 - Initial Version 5916 6480 ! 5917 6481 !> @param[inout] td_var variabele structure … … 5987 6551 !> 5988 6552 !> @author J.Paul 5989 !> - November, 2013- Initial Version6553 !> @date November, 2013 - Initial Version 5990 6554 ! 5991 6555 !> @param[inout] td_var variable structure … … 6057 6621 !> 6058 6622 !> @author J.Paul 6059 !> - November, 2013- Initial Version6623 !> @date November, 2013 - Initial Version 6060 6624 !> 6061 6625 !> @param[inout] td_var variable structure … … 6080 6644 !> 6081 6645 !> @author J.Paul 6082 !> - September, 2014- Initial Version6646 !> @date September, 2014 - Initial Version 6083 6647 !> 6084 6648 !> @param[in] td_var array of variable structure … … 6142 6706 !> given variable name or standard name. 6143 6707 !> 6144 !> @warning only variable read from file, have an id.6145 !>6146 6708 !> @author J.Paul 6147 !> - November, 2013- Initial Version 6709 !> @date November, 2013 - Initial Version 6710 !> @date July, 2015 6711 !> - check long name 6148 6712 ! 6149 6713 !> @param[in] td_var array of variable structure … … 6179 6743 ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.& 6180 6744 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 6745 6746 var_get_id=td_var(ji)%i_id 6747 EXIT 6748 6749 ! look for variable long name 6750 ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6751 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6181 6752 6182 6753 var_get_id=td_var(ji)%i_id … … 6200 6771 !> 6201 6772 !> @author J.Paul 6202 !> - November, 2013- Initial Version6773 !> @date November, 2013 - Initial Version 6203 6774 ! 6204 6775 !> @param[in] td_var array of variable structure … … 6219 6790 IF( ASSOCIATED(td_var%d_value) )THEN 6220 6791 6221 CALL logger_trace( "VAR GET MASK: create mask from variable "//& 6222 & TRIM(td_var%c_name) ) 6792 CALL logger_debug( "VAR GET MASK: create mask from variable "//& 6793 & TRIM(td_var%c_name)//", FillValue ="//& 6794 & TRIM(fct_str(td_var%d_fill))) 6223 6795 var_get_mask(:,:,:)=1 6224 6796 WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill ) … … 6239 6811 !> 6240 6812 !> @author J.Paul 6241 !> - November, 2013- Initial Version6813 !> @date November, 2013 - Initial Version 6242 6814 ! 6243 6815 !> @param[inout] td_var array of variable structure … … 6322 6894 !> 6323 6895 !> @author J.Paul 6324 !> - November, 2013- Initial Version 6896 !> @date November, 2013 - Initial Version 6897 !> @date June, 2015 6898 !> - new namelist format to get extra information (interpolation,...) 6325 6899 ! 6326 6900 !> @param[in] cd_file configuration file of variable … … 6357 6931 6358 6932 il_fileid=fct_getunit() 6359 CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file))6360 6933 OPEN( il_fileid, FILE=TRIM(cd_file), & 6361 6934 & FORM='FORMATTED', & … … 6366 6939 CALL fct_err(il_status) 6367 6940 IF( il_status /= 0 )THEN 6368 CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file)) 6941 CALL logger_fatal("VAR DEF EXTRA: can not open file "//& 6942 & TRIM(cd_file)) 6369 6943 ENDIF 6370 6944 … … 6375 6949 DO WHILE( il_status == 0 ) 6376 6950 6377 ! search line donot beginning with comment character6951 ! search line not beginning with comment character 6378 6952 IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 6379 6953 il_nvar=il_nvar+1 … … 6419 6993 tg_varextra(ji)%c_axis =TRIM(fct_split(cl_line,3)) 6420 6994 tg_varextra(ji)%c_point =TRIM(fct_split(cl_line,4)) 6421 tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,5)) 6422 tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6)) 6423 6424 cl_interp=TRIM(fct_split(cl_line,7)) 6995 6996 cl_interp='int='//TRIM(fct_split(cl_line,5)) 6425 6997 tg_varextra(ji)%c_interp(:) = & 6426 6998 & var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp) 6427 6999 CALL logger_debug("VAR DEF EXTRA: "//& 6428 7000 & TRIM(tg_varextra(ji)%c_name)//& 6429 & " "//TRIM(cl_interp)) 7001 & " "//TRIM(tg_varextra(ji)%c_interp(1))) 7002 7003 tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6)) 7004 tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7)) 6430 7005 ELSE 6431 7006 ji=ji-1 … … 6458 7033 !> @details 6459 7034 !> string character format must be : <br/> 6460 !> "varname:int erp; filter; extrap; > min; <max"<br/>7035 !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/> 6461 7036 !> you could specify only interpolation, filter or extrapolation method, 6462 7037 !> whatever the order. you could find more … … 6464 7039 !> \ref extrap module.<br/> 6465 7040 !> Examples: 6466 !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.' 6467 !> cn_varinfo='votemper:cubic; dist_weight; <40.' 7041 !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.' 7042 !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.' 7043 !> 7044 !> 7045 !> @warning variable should be define in tg_varextra (ie in configuration 7046 !> file, to be able to add information from namelist 6468 7047 !> 6469 7048 !> @note If you do not specify a method which is required, default one is … … 6471 7050 !> 6472 7051 !> @author J.Paul 6473 !> - November, 2013- Initial Version 7052 !> @date November, 2013 - Initial Version 7053 !> @date July, 2015 7054 !> - get unit and unit factor (to change unit) 6474 7055 ! 6475 7056 !> @param[in] cd_varinfo variable information from namelist … … 6486 7067 CHARACTER(LEN=lc), DIMENSION(1) :: cl_extrap 6487 7068 CHARACTER(LEN=lc), DIMENSION(5) :: cl_filter 7069 CHARACTER(LEN=lc) :: cl_unt 6488 7070 6489 7071 INTEGER(i4) :: il_ind … … 6492 7074 REAL(dp) :: dl_min 6493 7075 REAL(dp) :: dl_max 7076 REAL(dp) :: dl_unf 6494 7077 6495 7078 TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_varextra … … 6508 7091 dl_min=var__get_min(cl_name, cl_method) 6509 7092 dl_max=var__get_max(cl_name, cl_method) 7093 dl_unf=var__get_unf(cl_name, cl_method) 6510 7094 cl_interp(:)=var__get_interp(cl_name, cl_method) 6511 7095 cl_extrap(:)=var__get_extrap(cl_name, cl_method) 6512 7096 cl_filter(:)=var__get_filter(cl_name, cl_method) 7097 cl_unt=var__get_unt(cl_name, cl_method) 7098 6513 7099 6514 7100 il_ind=var_get_index(tg_varextra(:), TRIM(cl_name)) … … 6516 7102 IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min 6517 7103 IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max 7104 IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf 7105 IF(cl_unt /='') tg_varextra(il_ind)%c_unt =cl_unt 6518 7106 IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:) 6519 7107 IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:) … … 6551 7139 & cd_filter=cl_filter(:), & 6552 7140 & dd_min = dl_min, & 6553 & dd_max = dl_max ) 7141 & dd_max = dl_max, & 7142 & cd_unt = cl_unt, & 7143 & dd_unf = dl_unf ) 6554 7144 6555 7145 ENDIF 6556 7146 6557 7147 ji=ji+1 6558 CALL logger_ trace( "VAR CHG EXTRA: name "//&7148 CALL logger_debug( "VAR CHG EXTRA: name "//& 6559 7149 & TRIM(tg_varextra(il_ind)%c_name) ) 6560 CALL logger_ trace( "VAR CHG EXTRA: interp "//&7150 CALL logger_debug( "VAR CHG EXTRA: interp "//& 6561 7151 & TRIM(tg_varextra(il_ind)%c_interp(1)) ) 6562 CALL logger_ trace( "VAR CHG EXTRA: filter "//&7152 CALL logger_debug( "VAR CHG EXTRA: filter "//& 6563 7153 & TRIM(tg_varextra(il_ind)%c_filter(1)) ) 6564 CALL logger_ trace( "VAR CHG EXTRA: extrap "//&7154 CALL logger_debug( "VAR CHG EXTRA: extrap "//& 6565 7155 & TRIM(tg_varextra(il_ind)%c_extrap(1)) ) 6566 7156 IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN 6567 CALL logger_ trace( "VAR CHG EXTRA: min value "//&7157 CALL logger_debug( "VAR CHG EXTRA: min value "//& 6568 7158 & TRIM(fct_str(tg_varextra(il_ind)%d_min)) ) 6569 7159 ENDIF 6570 7160 IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN 6571 CALL logger_ trace( "VAR CHG EXTRA: max value "//&7161 CALL logger_debug( "VAR CHG EXTRA: max value "//& 6572 7162 & TRIM(fct_str(tg_varextra(il_ind)%d_max)) ) 7163 ENDIF 7164 IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 7165 CALL logger_debug( "VAR CHG EXTRA: new unit "//& 7166 & TRIM(tg_varextra(il_ind)%c_unt) ) 7167 ENDIF 7168 IF( tg_varextra(il_ind)%d_unf /= 1. )THEN 7169 CALL logger_debug( "VAR CHG EXTRA: new unit factor "//& 7170 & TRIM(fct_str(tg_varextra(il_ind)%d_unf)) ) 6573 7171 ENDIF 6574 7172 ENDDO … … 6593 7191 !> 6594 7192 !> @author J.Paul 6595 !> - November, 2013- Initial Version7193 !> @date November, 2013 - Initial Version 6596 7194 ! 6597 7195 !> @param[inout] td_var variable structure … … 6687 7285 !> 6688 7286 !> @author J.Paul 6689 !> - November, 2013- Initial Version7287 !> @date November, 2013 - Initial Version 6690 7288 !> 6691 7289 !> @param[inout] td_var variable structure … … 6697 7295 6698 7296 ! local variable 7297 CHARACTER(LEN=lc) :: cl_tmp 7298 6699 7299 INTEGER(i4) :: il_ind 7300 6700 7301 TYPE(TATT) :: tl_att 6701 7302 6702 7303 ! loop indices 7304 INTEGER(i4) :: ji 6703 7305 !---------------------------------------------------------------- 6704 7306 … … 6753 7355 td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis) 6754 7356 ! create attibute 6755 tl_att=att_init('axis',TRIM(td_var%c_axis)) 6756 CALL var_move_att(td_var, tl_att) 7357 IF( TRIM(fct_upper(td_var%c_name)) == TRIM(td_var%c_axis) )THEN 7358 tl_att=att_init('axis',TRIM(td_var%c_axis)) 7359 ELSE 7360 cl_tmp="" 7361 DO ji=LEN(TRIM(td_var%c_axis)),1,-1 7362 cl_tmp=TRIM(cl_tmp)//" "//TRIM(td_var%c_axis(ji:ji)) 7363 ENDDO 7364 tl_att=att_init('associate',TRIM(ADJUSTL(cl_tmp))) 7365 ENDIF 7366 CALL var_move_att(td_var, tl_att) 6757 7367 ENDIF 6758 7368 … … 6808 7418 ENDIF 6809 7419 6810 CALL logger_trace("VAR GET EXTRA: name "//TRIM(td_var%c_name)) 6811 CALL logger_trace("VAR GET EXTRA: stdname "//TRIM(td_var%c_stdname)) 6812 CALL logger_trace("VAR GET EXTRA: longname "//TRIM(td_var%c_longname)) 6813 CALL logger_trace("VAR GET EXTRA: units "//TRIM(td_var%c_units)) 6814 CALL logger_trace("VAR GET EXTRA: point "//TRIM(td_var%c_point)) 6815 CALL logger_trace("VAR GET EXTRA: interp "//TRIM(td_var%c_interp(1))) 6816 CALL logger_trace("VAR GET EXTRA: filter "//TRIM(td_var%c_filter(1))) 6817 CALL logger_trace("VAR GET EXTRA: min value "//TRIM(fct_str(td_var%d_min))) 6818 CALL logger_trace("VAR GET EXTRA: max value "//TRIM(fct_str(td_var%d_max))) 7420 ! unt 7421 IF( TRIM(td_var%c_unt) == '' .AND. & 7422 & TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 7423 td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt) 7424 ENDIF 7425 7426 ! units factor 7427 IF( td_var%d_unf == 1._dp .AND. & 7428 & tg_varextra(il_ind)%d_unf /= 1._dp )THEN 7429 td_var%d_unf=tg_varextra(il_ind)%d_unf 7430 ENDIF 7431 7432 ELSE 7433 CALL logger_warn("VAR GET EXTRA: no extra information on "//& 7434 & "variable "//TRIM(td_var%c_name)//". you should define it"//& 7435 & " (see variable.cfg).") 6819 7436 ENDIF 6820 7437 … … 6833 7450 !> 6834 7451 !> @details 6835 !> minimum value is assume to follow s ign '>'7452 !> minimum value is assume to follow string "min =" 6836 7453 !> 6837 7454 !> @author J.Paul 6838 !> - November, 2013- Initial Version 7455 !> @date November, 2013 - Initial Version 7456 !> @date June, 2015 7457 !> - change way to get information in namelist, 7458 !> value follows string "min =" 7459 !> @date Feb, 2016 7460 !> - check character just after keyword 6839 7461 ! 6840 7462 !> @param[in] cd_name variable name … … 6859 7481 ! loop indices 6860 7482 INTEGER(i4) :: ji 7483 INTEGER(i4) :: jj 6861 7484 !---------------------------------------------------------------- 6862 7485 ! init … … 6867 7490 cl_tmp=fct_split(cd_varinfo,ji,';') 6868 7491 DO WHILE( TRIM(cl_tmp) /= '' ) 6869 il_ind= SCAN(TRIM(cl_tmp),'>')7492 il_ind=INDEX(TRIM(cl_tmp),'min') 6870 7493 IF( il_ind /= 0 )THEN 6871 cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 6872 EXIT 7494 ! check character just after 7495 jj=il_ind+LEN('min') 7496 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7497 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7498 cl_min=fct_split(cl_tmp,2,'=') 7499 EXIT 7500 ENDIF 6873 7501 ENDIF 6874 7502 ji=ji+1 … … 6877 7505 6878 7506 IF( TRIM(cl_min) /= '' )THEN 6879 IF( fct_is_ num(cl_min) )THEN7507 IF( fct_is_real(cl_min) )THEN 6880 7508 READ(cl_min,*) var__get_min 6881 7509 CALL logger_debug("VAR GET MIN: will use minimum value of "//& 6882 7510 & TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) ) 6883 7511 ELSE 6884 CALL logger_error("VAR GET MIN: invalid minimum value for "//& 6885 & "variable "//TRIM(cd_name)//". check namelist." ) 7512 CALL logger_error("VAR GET MIN: invalid minimum value ("//& 7513 & TRIM(cl_min)//") for variable "//TRIM(cd_name)//& 7514 & ". check namelist." ) 6886 7515 ENDIF 6887 7516 ENDIF … … 6894 7523 !> 6895 7524 !> @details 6896 !> maximum value is assume to follow s ign '<'7525 !> maximum value is assume to follow string "max =" 6897 7526 !> 6898 7527 !> @author J.Paul 6899 !> - November, 2013- Initial Version 7528 !> @date November, 2013 - Initial Version 7529 !> @date June, 2015 7530 !> - change way to get information in namelist, 7531 !> value follows string "max =" 7532 !> @date Feb, 2016 7533 !> - check character just after keyword 6900 7534 ! 6901 7535 !> @param[in] cd_name variable name … … 6920 7554 ! loop indices 6921 7555 INTEGER(i4) :: ji 7556 INTEGER(i4) :: jj 6922 7557 !---------------------------------------------------------------- 6923 7558 ! init … … 6928 7563 cl_tmp=fct_split(cd_varinfo,ji,';') 6929 7564 DO WHILE( TRIM(cl_tmp) /= '' ) 6930 il_ind= SCAN(TRIM(cl_tmp),'<')7565 il_ind=INDEX(TRIM(cl_tmp),'max') 6931 7566 IF( il_ind /= 0 )THEN 6932 cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 6933 EXIT 7567 ! check character just after 7568 jj=il_ind+LEN('max') 7569 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7570 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7571 cl_max=fct_split(cl_tmp,2,'=') 7572 EXIT 7573 ENDIF 6934 7574 ENDIF 6935 7575 ji=ji+1 … … 6938 7578 6939 7579 IF( TRIM(cl_max) /= '' )THEN 6940 IF( fct_is_ num(cl_max) )THEN7580 IF( fct_is_real(cl_max) )THEN 6941 7581 READ(cl_max,*) var__get_max 6942 7582 CALL logger_debug("VAR GET MAX: will use maximum value of "//& … … 6952 7592 !> @brief 6953 7593 !> This function check if variable information read in namelist contains 7594 !> units factor value and return it if true. 7595 !> 7596 !> @details 7597 !> units factor value is assume to follow string "unf =" 7598 !> 7599 !> @author J.Paul 7600 !> @date June, 2015 - Initial Version 7601 !> @date Feb, 2016 7602 !> - check character just after keyword 7603 ! 7604 !> @param[in] cd_name variable name 7605 !> @param[in] cd_varinfo variable information read in namelist 7606 !> @return untis factor value to be used (FillValue if none) 7607 !------------------------------------------------------------------- 7608 FUNCTION var__get_unf( cd_name, cd_varinfo ) 7609 IMPLICIT NONE 7610 ! Argument 7611 CHARACTER(LEN=*), INTENT(IN ) :: cd_name 7612 CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo 7613 7614 ! function 7615 REAL(dp) :: var__get_unf 7616 7617 ! local variable 7618 CHARACTER(LEN=lc) :: cl_tmp 7619 CHARACTER(LEN=lc) :: cl_unf 7620 7621 INTEGER(i4) :: il_ind 7622 7623 REAL(dp) :: rl_unf 7624 7625 ! loop indices 7626 INTEGER(i4) :: ji 7627 INTEGER(i4) :: jj 7628 !---------------------------------------------------------------- 7629 ! init 7630 cl_unf='' 7631 var__get_unf=dp_fill 7632 7633 ji=1 7634 cl_tmp=fct_split(cd_varinfo,ji,';') 7635 DO WHILE( TRIM(cl_tmp) /= '' ) 7636 il_ind=INDEX(TRIM(cl_tmp),'unf') 7637 IF( il_ind /= 0 )THEN 7638 ! check character just after 7639 jj=il_ind+LEN('unf') 7640 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7641 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7642 cl_unf=fct_split(cl_tmp,2,'=') 7643 EXIT 7644 ENDIF 7645 ENDIF 7646 ji=ji+1 7647 cl_tmp=fct_split(cd_varinfo,ji,';') 7648 ENDDO 7649 7650 IF( TRIM(cl_unf) /= '' )THEN 7651 rl_unf=math_compute(cl_unf) 7652 IF( rl_unf /= dp_fill )THEN 7653 var__get_unf = rl_unf 7654 CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//& 7655 & "value of "//TRIM(fct_str(var__get_unf))//" for variable "//& 7656 & TRIM(cd_name) ) 7657 ELSE 7658 CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//& 7659 & "value for variable "//TRIM(cd_name)//". check namelist." ) 7660 ENDIF 7661 ENDIF 7662 7663 END FUNCTION var__get_unf 7664 !------------------------------------------------------------------- 7665 !> @brief 7666 !> This function check if variable information read in namelist contains 6954 7667 !> interpolation method and return it if true. 6955 7668 !> 6956 7669 !> @details 6957 !> split namelist information, using ';' as separator. 7670 !> interpolation method is assume to follow string "int =" 7671 !> 6958 7672 !> compare method name with the list of interpolation method available (see 6959 7673 !> module global). 6960 7674 !> check if factor (*rhoi, /rhoj..) are present.<br/> 6961 7675 !> Example:<br/> 6962 !> - cubic/rhoi ;dist_weight6963 !> - bilin7676 !> - int=cubic/rhoi ; ext=dist_weight 7677 !> - int=bilin 6964 7678 !> see @ref interp module for more information. 6965 7679 !> 6966 7680 !> @author J.Paul 6967 !> - November, 2013- Initial Version 7681 !> @date November, 2013 - Initial Version 7682 !> @date June, 2015 7683 !> - change way to get information in namelist, 7684 !> value follows string "int =" 7685 !> @date Feb, 2016 7686 !> - check character just after keyword 6968 7687 ! 6969 7688 !> @param[in] cd_name variable name … … 6982 7701 ! local variable 6983 7702 CHARACTER(LEN=lc) :: cl_tmp 7703 CHARACTER(LEN=lc) :: cl_int 6984 7704 CHARACTER(LEN=lc) :: cl_factor 6985 7705 … … 7000 7720 cl_tmp=fct_split(cd_varinfo,ji,';') 7001 7721 DO WHILE( TRIM(cl_tmp) /= '' ) 7722 il_ind=INDEX(TRIM(cl_tmp),'int') 7723 IF( il_ind /= 0 )THEN 7724 ! check character just after 7725 jj=il_ind+LEN('int') 7726 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7727 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7728 cl_int=fct_split(cl_tmp,2,'=') 7729 EXIT 7730 ENDIF 7731 ENDIF 7732 ji=ji+1 7733 cl_tmp=fct_split(cd_varinfo,ji,';') 7734 ENDDO 7735 7736 IF( TRIM(cl_int) /= '' )THEN 7002 7737 DO jj=1,ip_ninterp 7003 il_ind= INDEX(fct_lower(cl_ tmp),TRIM(cp_interp_list(jj)))7738 il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj))) 7004 7739 IF( il_ind /= 0 )THEN 7005 7740 … … 7009 7744 ! look for factor 7010 7745 IF( il_ind==1 )THEN 7011 cl_factor=cl_ tmp(il_len+1:)7746 cl_factor=cl_int(il_len+1:) 7012 7747 ELSE 7013 cl_factor=cl_ tmp(1:il_ind-1)7748 cl_factor=cl_int(1:il_ind-1) 7014 7749 ENDIF 7015 7750 il_mul=SCAN(TRIM(cl_factor),'*') … … 7052 7787 ENDIF 7053 7788 ENDDO 7054 IF( jj /= ip_ninterp + 1 ) EXIT 7055 ji=ji+1 7056 cl_tmp=fct_split(cd_varinfo,ji,';') 7057 ENDDO 7789 ENDIF 7058 7790 7059 7791 END FUNCTION var__get_interp … … 7064 7796 !> 7065 7797 !> @details 7066 !> split namelist information, using ';' as separator. 7798 !> extrapolation method is assume to follow string "ext =" 7799 !> 7067 7800 !> compare method name with the list of extrapolation method available (see 7068 7801 !> module global).<br/> 7069 7802 !> Example:<br/> 7070 !> - cubic ;dist_weight7071 !> - min_error7803 !> - int=cubic ; ext=dist_weight 7804 !> - ext=min_error 7072 7805 !> see @ref extrap module for more information. 7073 7806 !> 7074 7807 !> @author J.Paul 7075 !> - November, 2013- Initial Version 7808 !> @date November, 2013 - Initial Version 7809 !> @date June, 2015 7810 !> - change way to get information in namelist, 7811 !> value follows string "ext =" 7812 !> @date Feb, 2016 7813 !> - check character just after keyword 7076 7814 ! 7077 7815 !> @param[in] cd_name variable name … … 7090 7828 ! local variable 7091 7829 CHARACTER(LEN=lc) :: cl_tmp 7830 CHARACTER(LEN=lc) :: cl_ext 7831 7832 INTEGER(i4) :: il_ind 7092 7833 7093 7834 ! loop indices … … 7101 7842 cl_tmp=fct_split(cd_varinfo,ji,';') 7102 7843 DO WHILE( TRIM(cl_tmp) /= '' ) 7844 il_ind=INDEX(TRIM(cl_tmp),'ext') 7845 IF( il_ind /= 0 )THEN 7846 ! check character just after 7847 jj=il_ind+LEN('ext') 7848 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7849 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7850 cl_ext=fct_split(cl_tmp,2,'=') 7851 EXIT 7852 ENDIF 7853 ENDIF 7854 ji=ji+1 7855 cl_tmp=fct_split(cd_varinfo,ji,';') 7856 ENDDO 7857 7858 IF( TRIM(cl_ext) /= '' )THEN 7103 7859 DO jj=1,ip_nextrap 7104 IF( TRIM(fct_lower(cl_ tmp)) == TRIM(cp_extrap_list(jj)) )THEN7860 IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN 7105 7861 var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 7106 7862 … … 7111 7867 ENDIF 7112 7868 ENDDO 7113 IF( jj /= ip_nextrap + 1 ) EXIT 7114 ji=ji+1 7115 cl_tmp=fct_split(cd_varinfo,ji,';') 7116 ENDDO 7869 ENDIF 7117 7870 7118 7871 … … 7124 7877 !> 7125 7878 !> @details 7126 !> split namelist information, using ';' as separator. 7879 !> filter method is assume to follow string "flt =" 7880 !> 7127 7881 !> compare method name with the list of filter method available (see 7128 7882 !> module global). 7129 !> look for the number of turn, using '*' separator, and method parameters inside7883 !> look for the number of run, using '*' separator, and method parameters inside 7130 7884 !> bracket.<br/> 7131 7885 !> Example:<br/> 7132 !> - cubic ;2*hamming(2,3)7133 !> - hann7886 !> - int=cubic ; flt=2*hamming(2,3) 7887 !> - flt=hann 7134 7888 !> see @ref filter module for more information. 7135 7889 !> 7136 7890 !> @author J.Paul 7137 !> - November, 2013- Initial Version 7138 ! 7891 !> @date November, 2013 - Initial Version 7892 !> @date June, 2015 7893 !> - change way to get information in namelist, 7894 !> value follows string "flt =" 7895 !> @date Feb, 2016 7896 !> - check character just after keyword 7897 !> 7139 7898 !> @param[in] cd_name variable name 7140 7899 !> @param[in] cd_varinfo variable information read in namelist … … 7151 7910 ! local variable 7152 7911 CHARACTER(LEN=lc) :: cl_tmp 7912 CHARACTER(LEN=lc) :: cl_flt 7153 7913 INTEGER(i4) :: il_ind 7154 7914 … … 7163 7923 cl_tmp=fct_split(cd_varinfo,ji,';') 7164 7924 DO WHILE( TRIM(cl_tmp) /= '' ) 7925 il_ind=INDEX(TRIM(cl_tmp),'flt') 7926 IF( il_ind /= 0 )THEN 7927 ! check character just after 7928 jj=il_ind+LEN('flt') 7929 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7930 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7931 cl_flt=fct_split(cl_tmp,2,'=') 7932 EXIT 7933 ENDIF 7934 ENDIF 7935 ji=ji+1 7936 cl_tmp=fct_split(cd_varinfo,ji,';') 7937 ENDDO 7938 7939 IF( TRIM(cl_flt) /= '' )THEN 7165 7940 DO jj=1,ip_nfilter 7166 il_ind=INDEX(fct_lower(cl_ tmp),TRIM(cp_filter_list(jj)))7941 il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj))) 7167 7942 IF( il_ind /= 0 )THEN 7168 7943 var__get_filter(1)=TRIM(cp_filter_list(jj)) 7169 7944 7170 ! look for number of turn7171 il_ind=SCAN(fct_lower(cl_ tmp),'*')7945 ! look for number of run 7946 il_ind=SCAN(fct_lower(cl_flt),'*') 7172 7947 IF( il_ind /=0 )THEN 7173 IF( fct_is_num(cl_ tmp(1:il_ind-1)) )THEN7174 var__get_filter(2)=TRIM(cl_ tmp(1:il_ind-1))7175 ELSE IF( fct_is_num(cl_ tmp(il_ind+1:)) )THEN7176 var__get_filter(2)=TRIM(cl_ tmp(il_ind+1:))7948 IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN 7949 var__get_filter(2)=TRIM(cl_flt(1:il_ind-1)) 7950 ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN 7951 var__get_filter(2)=TRIM(cl_flt(il_ind+1:)) 7177 7952 ELSE 7178 7953 var__get_filter(2)='1' … … 7183 7958 7184 7959 ! look for filter parameter 7185 il_ind=SCAN(fct_lower(cl_ tmp),'(')7960 il_ind=SCAN(fct_lower(cl_flt),'(') 7186 7961 IF( il_ind /=0 )THEN 7187 cl_ tmp=TRIM(cl_tmp(il_ind+1:))7188 il_ind=SCAN(fct_lower(cl_ tmp),')')7962 cl_flt=TRIM(cl_flt(il_ind+1:)) 7963 il_ind=SCAN(fct_lower(cl_flt),')') 7189 7964 IF( il_ind /=0 )THEN 7190 cl_ tmp=TRIM(cl_tmp(1:il_ind-1))7965 cl_flt=TRIM(cl_flt(1:il_ind-1)) 7191 7966 ! look for cut-off frequency 7192 var__get_filter(3)=fct_split(cl_ tmp,1,',')7967 var__get_filter(3)=fct_split(cl_flt,1,',') 7193 7968 ! look for halo size 7194 var__get_filter(4)=fct_split(cl_ tmp,2,',')7969 var__get_filter(4)=fct_split(cl_flt,2,',') 7195 7970 ! look for alpha parameter 7196 var__get_filter(5)=fct_split(cl_ tmp,3,',')7971 var__get_filter(5)=fct_split(cl_flt,3,',') 7197 7972 ELSE 7198 7973 CALL logger_error("VAR GET FILTER: variable "//& … … 7215 7990 ENDIF 7216 7991 ENDDO 7217 IF( jj /= ip_nfilter + 1 ) EXIT 7992 ENDIF 7993 7994 END FUNCTION var__get_filter 7995 !------------------------------------------------------------------- 7996 !> @brief 7997 !> This function check if variable information read in namelist contains 7998 !> unit and return it if true. 7999 !> 8000 !> @details 8001 !> unit is assume to follow string "unt =" 8002 !> 8003 !> @author J.Paul 8004 !> @date June, 2015 - Initial Version 8005 !> @date Feb, 2016 8006 !> - check character just after keyword 8007 ! 8008 !> @param[in] cd_name variable name 8009 !> @param[in] cd_varinfo variable information read in namelist 8010 !> @return unit string character 8011 !------------------------------------------------------------------- 8012 FUNCTION var__get_unt( cd_name, cd_varinfo ) 8013 IMPLICIT NONE 8014 ! Argument 8015 CHARACTER(LEN=*), INTENT(IN ) :: cd_name 8016 CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo 8017 8018 ! function 8019 CHARACTER(LEN=lc) :: var__get_unt 8020 8021 ! local variable 8022 CHARACTER(LEN=lc) :: cl_tmp 8023 8024 INTEGER(i4) :: il_ind 8025 8026 ! loop indices 8027 INTEGER(i4) :: ji 8028 INTEGER(i4) :: jj 8029 !---------------------------------------------------------------- 8030 8031 var__get_unt='' 8032 8033 ji=1 8034 cl_tmp=fct_split(cd_varinfo,ji,';') 8035 DO WHILE( TRIM(cl_tmp) /= '' ) 8036 il_ind=INDEX(TRIM(cl_tmp),'unt') 8037 IF( il_ind /= 0 )THEN 8038 ! check character just after 8039 jj=il_ind+LEN('unt') 8040 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 8041 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 8042 var__get_unt=fct_split(cl_tmp,2,'=') 8043 EXIT 8044 ENDIF 8045 ENDIF 7218 8046 ji=ji+1 7219 8047 cl_tmp=fct_split(cd_varinfo,ji,';') 7220 8048 ENDDO 7221 8049 7222 END FUNCTION var__get_filter 8050 IF( TRIM(var__get_unt) /= '' )THEN 8051 CALL logger_debug("VAR GET UNIT: will use units "//& 8052 & TRIM(var__get_unt)//" for variable "//& 8053 & TRIM(cd_name) ) 8054 ENDIF 8055 8056 END FUNCTION var__get_unt 7223 8057 !------------------------------------------------------------------- 7224 8058 !> @brief … … 7227 8061 !> 7228 8062 !> @author J.Paul 7229 !> - November, 2013- Initial Version8063 !> @date November, 2013 - Initial Version 7230 8064 ! 7231 8065 !> @param[in] td_var array of variable structure … … 7285 8119 !> 7286 8120 !> @author J.Paul 7287 !> - November, 2013- Initial Version8121 !> @date November, 2013 - Initial Version 7288 8122 ! 7289 8123 !> @param[inout] td_var variable structure … … 7321 8155 !------------------------------------------------------------------- 7322 8156 !> @brief 8157 !> This subroutine replace unit name of the variable, 8158 !> and apply unit factor to the value of this variable. 8159 !> 8160 !> @details 8161 !> new unit name (unt) and unit factor (unf) are read from the namelist. 8162 !> 8163 !> @note the variable value should be already read. 8164 !> 8165 !> @author J.Paul 8166 !> @date June, 2015 - Initial Version 8167 ! 8168 !> @param[inout] td_var variable structure 8169 !------------------------------------------------------------------- 8170 SUBROUTINE var_chg_unit( td_var ) 8171 IMPLICIT NONE 8172 ! Argument 8173 TYPE(TVAR), INTENT(INOUT) :: td_var 8174 8175 ! local variable 8176 TYPE(TATT) :: tl_att 8177 8178 ! loop indices 8179 !---------------------------------------------------------------- 8180 8181 IF( ASSOCIATED(td_var%d_value) )THEN 8182 !- change value 8183 IF( td_var%d_unf /= 1._dp )THEN 8184 WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 8185 td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf 8186 END WHERE 8187 8188 !- change scale factor and offset to avoid mistake 8189 tl_att=att_init('scale_factor',1._dp) 8190 CALL var_move_att(td_var, tl_att) 8191 8192 tl_att=att_init('add_offset',0._dp) 8193 CALL var_move_att(td_var, tl_att) 8194 ENDIF 8195 8196 !- change unit name 8197 IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. & 8198 & TRIM(td_var%c_unt) /= '' )THEN 8199 tl_att=att_init('units',TRIM(td_var%c_unt)) 8200 CALL var_move_att(td_var,tl_att) 8201 ENDIF 8202 8203 ENDIF 8204 8205 END SUBROUTINE var_chg_unit 8206 !------------------------------------------------------------------- 8207 !> @brief 7323 8208 !> This subroutine check variable dimension expected, as defined in 7324 8209 !> file 'variable.cfg'. … … 7329 8214 !> 7330 8215 !> @author J.Paul 7331 !> - November, 2013- Initial Version8216 !> @date November, 2013 - Initial Version 7332 8217 ! 7333 8218 !> @param[inout] td_var variable structure … … 7414 8299 !> 7415 8300 !> @author J.Paul 7416 !> - August, 2014- Initial Version 8301 !> @date August, 2014 - Initial Version 8302 !> @date July 2015 8303 !> - do not use dim_disorder anymore 7417 8304 ! 7418 8305 !> @param[inout] td_var variable structure … … 7438 8325 IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 7439 8326 8327 CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//& 8328 & " new dimension order "//TRIM(cl_dimorder)) 8329 7440 8330 tl_dim(:)=dim_copy(td_var%t_dim(:)) 7441 8331 7442 CALL dim_unorder(tl_dim(:))7443 8332 CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 7444 8333 … … 7467 8356 !> 7468 8357 !> @author J.Paul 7469 !> - September, 2014- Initial Version8358 !> @date September, 2014 - Initial Version 7470 8359 ! 7471 8360 !> @param[in] td_var array of variable structure … … 7492 8381 !> 7493 8382 !> @author J.Paul 7494 !> - November, 2014- Initial Version8383 !> @date November, 2014 - Initial Version 7495 8384 ! 7496 8385 !> @param[in] td_var time variable structure … … 7553 8442 7554 8443 END FUNCTION var_to_date 8444 !------------------------------------------------------------------- 8445 !> @brief This subroutine fill dummy variable array 8446 ! 8447 !> @author J.Paul 8448 !> @date September, 2015 - Initial Version 8449 ! 8450 !> @param[in] cd_dummy dummy configuration file 8451 !------------------------------------------------------------------- 8452 SUBROUTINE var_get_dummy( cd_dummy ) 8453 IMPLICIT NONE 8454 ! Argument 8455 CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 8456 8457 ! local variable 8458 INTEGER(i4) :: il_fileid 8459 INTEGER(i4) :: il_status 8460 8461 LOGICAL :: ll_exist 8462 8463 ! loop indices 8464 ! namelist 8465 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 8466 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 8467 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 8468 8469 !---------------------------------------------------------------- 8470 NAMELIST /namdum/ & !< dummy namelist 8471 & cn_dumvar, & !< variable name 8472 & cn_dumdim, & !< dimension name 8473 & cn_dumatt !< attribute name 8474 !---------------------------------------------------------------- 8475 8476 ! init 8477 cm_dumvar(:)='' 8478 8479 ! read namelist 8480 INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 8481 IF( ll_exist )THEN 8482 8483 il_fileid=fct_getunit() 8484 8485 OPEN( il_fileid, FILE=TRIM(cd_dummy), & 8486 & FORM='FORMATTED', & 8487 & ACCESS='SEQUENTIAL', & 8488 & STATUS='OLD', & 8489 & ACTION='READ', & 8490 & IOSTAT=il_status) 8491 CALL fct_err(il_status) 8492 IF( il_status /= 0 )THEN 8493 CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 8494 ENDIF 8495 8496 READ( il_fileid, NML = namdum ) 8497 cm_dumvar(:)=cn_dumvar(:) 8498 8499 CLOSE( il_fileid ) 8500 8501 ENDIF 8502 8503 END SUBROUTINE var_get_dummy 8504 !------------------------------------------------------------------- 8505 !> @brief This function check if variable is defined as dummy variable 8506 !> in configuraton file 8507 !> 8508 !> @author J.Paul 8509 !> @date September, 2015 - Initial Version 8510 ! 8511 !> @param[in] td_var variable structure 8512 !> @return true if variable is dummy variable 8513 !------------------------------------------------------------------- 8514 FUNCTION var_is_dummy(td_var) 8515 IMPLICIT NONE 8516 8517 ! Argument 8518 TYPE(TVAR), INTENT(IN) :: td_var 8519 8520 ! function 8521 LOGICAL :: var_is_dummy 8522 8523 ! loop indices 8524 INTEGER(i4) :: ji 8525 !---------------------------------------------------------------- 8526 8527 var_is_dummy=.FALSE. 8528 DO ji=1,ip_maxdum 8529 IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 8530 var_is_dummy=.TRUE. 8531 EXIT 8532 ENDIF 8533 ENDDO 8534 8535 END FUNCTION var_is_dummy 7555 8536 END MODULE var 7556 8537
Note: See TracChangeset
for help on using the changeset viewer.
