Changeset 5609 for trunk/NEMOGCM/TOOLS/SIREN/src/variable.f90
- Timestamp:
- 2015-07-17T17:42:15+02:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/TOOLS/SIREN/src/variable.f90 (modified) (192 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/TOOLS/SIREN/src/variable.f90
r5037 r5609 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 283 287 ! 284 288 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 293 297 USE att ! attribute manager 294 298 USE dim ! dimension manager 299 USE math ! mathematical function 295 300 IMPLICIT NONE 296 301 ! NOTE_avoid_public_variables_if_possible … … 318 323 PUBLIC :: var_concat !< concatenate two variables 319 324 PUBLIC :: var_limit_value !< forced min and max value 325 PUBLIC :: var_chg_unit !< change variable unit and value 320 326 PUBLIC :: var_max_dim !< get array of maximum dimension use 321 327 PUBLIC :: var_reorder !< reorder table of value in variable structure … … 382 388 PRIVATE :: var__get_max ! get maximum value from namelist 383 389 PRIVATE :: var__get_min ! get minimum value from namelist 390 PRIVATE :: var__get_unf ! get scale factor value from namelist 391 PRIVATE :: var__get_unt ! get unit from namelist 384 392 PRIVATE :: var__get_interp ! get interpolation method from namelist 385 393 PRIVATE :: var__get_extrap ! get extrapolation method from namelist … … 401 409 TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes 402 410 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< variable dimension 403 411 404 412 LOGICAL :: l_file = .FALSE. !< variable read in a file 405 413 … … 414 422 REAL(dp) :: d_min = dp_fill !< minimum value 415 423 REAL(dp) :: d_max = dp_fill !< maximum value 416 424 425 CHARACTER(LEN=lc) :: c_unt = '' !< new variables units (linked to units factor) 426 REAL(dp) :: d_unf = 1._dp !< units factor 427 417 428 !!! netcdf4 418 429 LOGICAL :: l_contiguous = .FALSE. !< use contiguous storage or not … … 549 560 var__copy_unit%d_max = td_var%d_max 550 561 562 var__copy_unit%c_unt = TRIM(td_var%c_unt) 563 var__copy_unit%d_unf = td_var%d_unf 564 551 565 var__copy_unit%i_type = td_var%i_type 552 566 var__copy_unit%i_natt = td_var%i_natt … … 577 591 var__copy_unit%c_units = TRIM(td_var%c_units) 578 592 var__copy_unit%c_axis = TRIM(td_var%c_axis) 593 var__copy_unit%d_unf = td_var%d_unf 579 594 var__copy_unit%d_scf = td_var%d_scf 580 595 var__copy_unit%d_ofs = td_var%d_ofs … … 788 803 !> - id_id : variable id (read from a file). 789 804 !> - id_ew : number of point composing east west wrap band. 805 !> - dd_unf : real(8) value for units factor attribute. 790 806 !> - dd_scf : real(8) value for scale factor attribute. 791 807 !> - dd_ofs : real(8) value for add offset attribute. … … 801 817 !> - cd_extrap : a array of character defining extrapolation method. 802 818 !> - cd_filter : a array of character defining filtering method. 819 !> - cd_unt : a string character to define output unit 820 !> - dd_unf : real(8) factor applied to change unit 803 821 !> 804 822 !> @note most of these optionals arguments will be inform automatically, … … 807 825 !> @author J.Paul 808 826 !> - November, 2013- Initial Version 827 !> @date February, 2015 - Bug fix: conversion of the FillValue type (float case) 828 !> @date June, 2015 - add unit factor (to change unit) 809 829 !> 810 830 !> @param[in] cd_name variable name … … 833 853 !> @param[in] cd_extrap extrapolation method 834 854 !> @param[in] cd_filter filter method 855 !> @param[in] cd_unt new units (linked to units factor) 856 !> @param[in] dd_unf units factor 835 857 !> @return variable structure 836 858 !------------------------------------------------------------------- … … 843 865 & ld_contiguous, ld_shuffle,& 844 866 & ld_fletcher32, id_deflvl, id_chunksz, & 845 & cd_interp, cd_extrap, cd_filter ) 867 & cd_interp, cd_extrap, cd_filter, & 868 & cd_unt, dd_unf ) 846 869 IMPLICIT NONE 847 870 ! Argument … … 871 894 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 872 895 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 896 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 897 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 873 898 874 899 … … 933 958 tl_att=att_init('_FillValue', INT(dd_fill,i4) ) 934 959 CASE(NF90_FLOAT) 935 tl_att=att_init('_FillValue', INT(dd_fill,sp) )960 tl_att=att_init('_FillValue', REAL(dd_fill,sp) ) 936 961 CASE DEFAULT ! NF90_DOUBLE 937 962 tl_att=att_init('_FillValue', dd_fill ) 938 963 END SELECT 939 964 CALL var_move_att(var__init, tl_att) … … 1038 1063 ENDIF 1039 1064 1065 ! units factor 1066 IF( PRESENT(dd_unf) )THEN 1067 tl_att=att_init('units_factor',dd_unf) 1068 CALL var_move_att(var__init, tl_att) 1069 ENDIF 1070 1071 ! new units (linked to units factor) 1072 IF( PRESENT(cd_unt) )THEN 1073 tl_att=att_init('new_units',cd_units) 1074 CALL var_move_att(var__init, tl_att) 1075 ENDIF 1076 1040 1077 ! add extra information 1041 1078 CALL var__get_extra(var__init) … … 1047 1084 CALL var_del_att(var__init, 'filter') 1048 1085 CALL var_del_att(var__init, 'src_file') 1086 CALL var_del_att(var__init, 'src_i_indices') 1087 CALL var_del_att(var__init, 'src_j_indices') 1049 1088 CALL var_del_att(var__init, 'valid_min') 1050 1089 CALL var_del_att(var__init, 'valid_max') … … 1073 1112 !> @author J.Paul 1074 1113 !> - November, 2013- Initial Version 1075 ! 1114 !> @date June, 2015 1115 !> - add interp, extrap, and filter argument 1116 !> @date July, 2015 1117 !> - add unit factor (to change unit) 1118 !> 1076 1119 !> @param[in] cd_name variable name 1077 1120 !> @param[in] dd_value 1D array of real(8) value … … 1100 1143 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 1101 1144 !> @param[in] id_chunksz chunk size 1145 !> @param[in] cd_interp interpolation method 1146 !> @param[in] cd_extrap extrapolation method 1147 !> @param[in] cd_filter filter method 1148 !> @param[in] cd_unt new units (linked to units factor) 1149 !> @param[in] dd_unf units factor 1102 1150 !> @return variable structure 1103 1151 !------------------------------------------------------------------- … … 1110 1158 & dd_min, dd_max, & 1111 1159 & ld_contiguous, ld_shuffle,& 1112 & ld_fletcher32, id_deflvl, id_chunksz) 1160 & ld_fletcher32, id_deflvl, id_chunksz, & 1161 & cd_interp, cd_extrap, cd_filter, & 1162 & cd_unt, dd_unf) 1113 1163 IMPLICIT NONE 1114 1164 ! Argument … … 1138 1188 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1139 1189 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1190 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1191 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1192 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1193 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1194 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1140 1195 1141 1196 ! local variable … … 1193 1248 & ld_fletcher32=ld_fletcher32, & 1194 1249 & id_deflvl=id_deflvl, & 1195 & id_chunksz=id_chunksz(:)) 1250 & id_chunksz=id_chunksz(:), & 1251 & cd_interp=cd_interp(:), & 1252 & cd_extrap=cd_extrap(:), & 1253 & cd_filter=cd_filter(:), & 1254 & cd_unt=cd_unt, dd_unf=dd_unf ) 1196 1255 1197 1256 ! add value … … 1240 1299 !> @author J.Paul 1241 1300 !> - November, 2013- Initial Version 1301 !> @date February, 2015 - bug fix: array initialise with dimension 1302 !> array not only one value 1303 !> @date June, 2015 1304 !> - add interp, extrap, and filter argument 1305 !> - Bux fix: dimension array initialise not only one value 1306 !> @date July, 2015 1307 !> - add unit factor (to change unit) 1242 1308 ! 1243 1309 !> @param[in] cd_name variable name … … 1269 1335 !> no deflation is in use 1270 1336 !> @param[in] id_chunksz chunk size 1337 !> @param[in] cd_interp interpolation method 1338 !> @param[in] cd_extrap extrapolation method 1339 !> @param[in] cd_filter filter method 1340 !> @param[in] cd_unt new units (linked to units factor) 1341 !> @param[in] dd_unf units factor 1271 1342 !> @return variable structure 1272 1343 !------------------------------------------------------------------- … … 1279 1350 & dd_min, dd_max, & 1280 1351 & ld_contiguous, ld_shuffle,& 1281 & ld_fletcher32, id_deflvl, id_chunksz) 1352 & ld_fletcher32, id_deflvl, id_chunksz, & 1353 & cd_interp, cd_extrap, cd_filter, & 1354 & cd_unt, dd_unf) 1282 1355 IMPLICIT NONE 1283 1356 ! Argument … … 1307 1380 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1308 1381 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1382 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1383 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1384 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1385 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1386 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1309 1387 1310 1388 ! local variable … … 1350 1428 ENDIF 1351 1429 1352 il_count(:)=tl_dim( 1)%i_len1430 il_count(:)=tl_dim(:)%i_len 1353 1431 IF( PRESENT(id_count) )THEN 1354 1432 IF( SIZE(id_count(:)) /= 2 )THEN … … 1381 1459 & ld_fletcher32=ld_fletcher32, & 1382 1460 & id_deflvl=id_deflvl, & 1383 & id_chunksz=id_chunksz(:)) 1461 & id_chunksz=id_chunksz(:), & 1462 & cd_interp=cd_interp(:), & 1463 & cd_extrap=cd_extrap(:), & 1464 & cd_filter=cd_filter(:), & 1465 & cd_unt=cd_unt, dd_unf=dd_unf ) 1384 1466 1385 1467 ! add value … … 1432 1514 !> @author J.Paul 1433 1515 !> - November, 2013- Initial Version 1434 ! 1516 !> @date June, 2015 1517 !> - add interp, extrap, and filter argument 1518 !> @date July, 2015 1519 !> - add unit factor (to change unit) 1520 !> 1435 1521 !> @param[in] cd_name variable name 1436 1522 !> @param[in] dd_value 1D array of real(8) value … … 1461 1547 !> deflation is in use 1462 1548 !> @param[in] id_chunksz chunk size 1549 !> @param[in] cd_interp interpolation method 1550 !> @param[in] cd_extrap extrapolation method 1551 !> @param[in] cd_filter filter method 1552 !> @param[in] cd_unt new units (linked to units factor) 1553 !> @param[in] dd_unf units factor 1463 1554 !> @return variable structure 1464 1555 !------------------------------------------------------------------- … … 1471 1562 & dd_min, dd_max, & 1472 1563 & ld_contiguous, ld_shuffle,& 1473 & ld_fletcher32, id_deflvl, id_chunksz) 1564 & ld_fletcher32, id_deflvl, id_chunksz, & 1565 & cd_interp, cd_extrap, cd_filter, & 1566 & cd_unt, dd_unf) 1474 1567 IMPLICIT NONE 1475 1568 ! Argument … … 1499 1592 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1500 1593 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1594 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1595 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1596 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1597 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1598 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1501 1599 1502 1600 ! local variable … … 1577 1675 & ld_fletcher32=ld_fletcher32, & 1578 1676 & id_deflvl=id_deflvl, & 1579 & id_chunksz=id_chunksz(:)) 1677 & id_chunksz=id_chunksz(:), & 1678 & cd_interp=cd_interp(:), & 1679 & cd_extrap=cd_extrap(:), & 1680 & cd_filter=cd_filter(:), & 1681 & cd_unt=cd_unt, dd_unf=dd_unf ) 1580 1682 1581 1683 ! add value … … 1624 1726 !> @author J.Paul 1625 1727 !> - November, 2013- Initial Version 1626 ! 1728 !> @date June, 2015 1729 !> - add interp, extrap, and filter argument 1730 !> @date July, 2015 1731 !> - add unit factor (to change unit) 1732 !> 1627 1733 !> @param[in] cd_name variable name 1628 1734 !> @param[in] dd_value 4D array of real(8) value … … 1653 1759 !> deflation is in use 1654 1760 !> @param[in] id_chunksz chunk size 1761 !> @param[in] cd_interp interpolation method 1762 !> @param[in] cd_extrap extrapolation method 1763 !> @param[in] cd_filter filter method 1764 !> @param[in] cd_unt new units (linked to units factor) 1765 !> @param[in] dd_unf units factor 1655 1766 !> @return variable structure 1656 1767 !------------------------------------------------------------------- … … 1663 1774 & dd_min, dd_max, & 1664 1775 & ld_contiguous, ld_shuffle,& 1665 & ld_fletcher32, id_deflvl, id_chunksz) 1776 & ld_fletcher32, id_deflvl, id_chunksz, & 1777 & cd_interp, cd_extrap, cd_filter, & 1778 & cd_unt, dd_unf ) 1666 1779 IMPLICIT NONE 1667 1780 ! Argument … … 1691 1804 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1692 1805 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1806 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1807 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1808 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1809 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1810 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1693 1811 1694 1812 ! local variable … … 1723 1841 & ld_fletcher32=ld_fletcher32, & 1724 1842 & id_deflvl=id_deflvl, & 1725 & id_chunksz=id_chunksz(:)) 1843 & id_chunksz=id_chunksz(:), & 1844 & cd_interp=cd_interp(:), & 1845 & cd_extrap=cd_extrap(:), & 1846 & cd_filter=cd_filter(:), & 1847 & cd_unt=cd_unt, dd_unf=dd_unf ) 1726 1848 1727 1849 ! add value … … 1759 1881 !> @author J.Paul 1760 1882 !> - November, 2013- Initial Version 1883 !> @date June, 2015 1884 !> - add interp, extrap, and filter argument 1885 !> @date July, 2015 1886 !> - add unit factor (to change unit) 1761 1887 ! 1762 1888 !> @param[in] cd_name variable name … … 1788 1914 !> deflation is in use 1789 1915 !> @param[in] id_chunksz chunk size 1916 !> @param[in] cd_interp interpolation method 1917 !> @param[in] cd_extrap extrapolation method 1918 !> @param[in] cd_filter filter method 1919 !> @param[in] cd_unt new units (linked to units factor) 1920 !> @param[in] dd_unf units factor 1790 1921 !> @return variable structure 1791 1922 !------------------------------------------------------------------- … … 1798 1929 & dd_min, dd_max, & 1799 1930 & ld_contiguous, ld_shuffle,& 1800 & ld_fletcher32, id_deflvl, id_chunksz) 1931 & ld_fletcher32, id_deflvl, id_chunksz, & 1932 & cd_interp, cd_extrap, cd_filter, & 1933 & cd_unt, dd_unf) 1801 1934 1802 1935 IMPLICIT NONE … … 1827 1960 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1828 1961 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1962 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 1963 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 1964 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 1965 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 1966 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1967 1829 1968 1830 1969 ! local variable … … 1870 2009 & ld_fletcher32=ld_fletcher32, & 1871 2010 & id_deflvl=id_deflvl, & 1872 & id_chunksz=id_chunksz(:)) 2011 & id_chunksz=id_chunksz(:), & 2012 & cd_interp=cd_interp(:), & 2013 & cd_extrap=cd_extrap(:), & 2014 & cd_filter=cd_filter(:), & 2015 & cd_unt=cd_unt, dd_unf=dd_unf ) 1873 2016 1874 2017 DEALLOCATE( dl_value ) … … 1893 2036 !> @author J.Paul 1894 2037 !> - November, 2013- Initial Version 2038 !> @date June, 2015 2039 !> - add interp, extrap, and filter argument 2040 !> @date July, 2015 2041 !> - add unit factor (to change unit) 1895 2042 ! 1896 2043 !> @param[in] cd_name : variable name … … 1922 2069 !> deflation is in use 1923 2070 !> @param[in] id_chunksz : chunk size 2071 !> @param[in] cd_interp interpolation method 2072 !> @param[in] cd_extrap extrapolation method 2073 !> @param[in] cd_filter filter method 2074 !> @param[in] cd_unt new units (linked to units factor) 2075 !> @param[in] dd_unf units factor 1924 2076 !> @return variable structure 1925 2077 !------------------------------------------------------------------- … … 1932 2084 & dd_min, dd_max, & 1933 2085 & ld_contiguous, ld_shuffle,& 1934 & ld_fletcher32, id_deflvl, id_chunksz) 2086 & ld_fletcher32, id_deflvl, id_chunksz, & 2087 & cd_interp, cd_extrap, cd_filter, & 2088 & cd_unt, dd_unf) 1935 2089 1936 2090 IMPLICIT NONE … … 1961 2115 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1962 2116 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2117 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2118 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2119 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2120 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2121 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 1963 2122 1964 2123 ! local variable … … 2006 2165 & ld_fletcher32=ld_fletcher32, & 2007 2166 & id_deflvl=id_deflvl, & 2008 & id_chunksz=id_chunksz(:)) 2167 & id_chunksz=id_chunksz(:), & 2168 & cd_interp=cd_interp(:), & 2169 & cd_extrap=cd_extrap(:), & 2170 & cd_filter=cd_filter(:), & 2171 & cd_unt=cd_unt, dd_unf=dd_unf ) 2009 2172 2010 2173 DEALLOCATE( dl_value ) … … 2029 2192 !> @author J.Paul 2030 2193 !> - November, 2013- Initial Version 2194 !> @date June, 2015 2195 !> - add interp, extrap, and filter argument 2196 !> @date July, 2015 2197 !> - add unit factor (to change unit) 2031 2198 ! 2032 2199 !> @param[in] cd_name : variable name … … 2058 2225 !> deflation is in use 2059 2226 !> @param[in] id_chunksz : chunk size 2227 !> @param[in] cd_interp interpolation method 2228 !> @param[in] cd_extrap extrapolation method 2229 !> @param[in] cd_filter filter method 2230 !> @param[in] cd_unt new units (linked to units factor) 2231 !> @param[in] dd_unf units factor 2060 2232 !> @return variable structure 2061 2233 !------------------------------------------------------------------- … … 2068 2240 & dd_min, dd_max, & 2069 2241 & ld_contiguous, ld_shuffle,& 2070 & ld_fletcher32, id_deflvl, id_chunksz) 2242 & ld_fletcher32, id_deflvl, id_chunksz, & 2243 & cd_interp, cd_extrap, cd_filter, & 2244 & cd_unt, dd_unf) 2071 2245 2072 2246 IMPLICIT NONE … … 2097 2271 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2098 2272 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2273 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2274 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2275 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2276 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2277 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2099 2278 2100 2279 ! local variable … … 2143 2322 & ld_fletcher32=ld_fletcher32, & 2144 2323 & id_deflvl=id_deflvl, & 2145 & id_chunksz=id_chunksz(:)) 2324 & id_chunksz=id_chunksz(:), & 2325 & cd_interp=cd_interp(:), & 2326 & cd_extrap=cd_extrap(:), & 2327 & cd_filter=cd_filter(:), & 2328 & cd_unt=cd_unt, dd_unf=dd_unf) 2146 2329 2147 2330 DEALLOCATE( dl_value ) … … 2166 2349 !> @author J.Paul 2167 2350 !> - November, 2013- Initial Version 2351 !> @date June, 2015 2352 !> - add interp, extrap, and filter argument 2353 !> @date July, 2015 2354 !> - add unit factor (to change unit) 2168 2355 ! 2169 2356 !> @param[in] cd_name variable name … … 2195 2382 !> deflation is in use 2196 2383 !> @param[in] id_chunksz chunk size 2384 !> @param[in] cd_interp interpolation method 2385 !> @param[in] cd_extrap extrapolation method 2386 !> @param[in] cd_filter filter method 2387 !> @param[in] cd_unt new units (linked to units factor) 2388 !> @param[in] dd_unf units factor 2197 2389 !> @return variable structure 2198 2390 !------------------------------------------------------------------- … … 2205 2397 & dd_min, dd_max, & 2206 2398 & ld_contiguous, ld_shuffle,& 2207 & ld_fletcher32, id_deflvl, id_chunksz) 2399 & ld_fletcher32, id_deflvl, id_chunksz, & 2400 & cd_interp, cd_extrap, cd_filter, & 2401 & cd_unt, dd_unf) 2208 2402 2209 2403 IMPLICIT NONE … … 2234 2428 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2235 2429 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2430 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2431 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2432 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2433 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2434 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2236 2435 2237 2436 ! local variable … … 2281 2480 & ld_fletcher32=ld_fletcher32, & 2282 2481 & id_deflvl=id_deflvl, & 2283 & id_chunksz=id_chunksz(:)) 2482 & id_chunksz=id_chunksz(:), & 2483 & cd_interp=cd_interp(:), & 2484 & cd_extrap=cd_extrap(:), & 2485 & cd_filter=cd_filter(:), & 2486 & cd_unt=cd_unt, dd_unf=dd_unf) 2284 2487 2285 2488 DEALLOCATE( dl_value ) … … 2304 2507 !> @author J.Paul 2305 2508 !> - November, 2013- Initial Version 2509 !> @date June, 2015 2510 !> - add interp, extrap, and filter argument 2511 !> @date July, 2015 2512 !> - add unit factor (to change unit) 2306 2513 ! 2307 2514 !> @param[in] cd_name : variable name … … 2333 2540 !> deflation is in use 2334 2541 !> @param[in] id_chunksz : chunk size 2542 !> @param[in] cd_interp interpolation method 2543 !> @param[in] cd_extrap extrapolation method 2544 !> @param[in] cd_filter filter method 2545 !> @param[in] cd_unt new units (linked to units factor) 2546 !> @param[in] dd_unf units factor 2335 2547 !> @return variable structure 2336 2548 !------------------------------------------------------------------- … … 2343 2555 & dd_min, dd_max, & 2344 2556 & ld_contiguous, ld_shuffle,& 2345 & ld_fletcher32, id_deflvl, id_chunksz) 2557 & ld_fletcher32, id_deflvl, id_chunksz, & 2558 & cd_interp, cd_extrap, cd_filter, & 2559 & cd_unt, dd_unf) 2346 2560 2347 2561 IMPLICIT NONE … … 2372 2586 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2373 2587 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2588 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2589 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2590 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2591 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2592 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2374 2593 2375 2594 ! local variable … … 2415 2634 & ld_fletcher32=ld_fletcher32, & 2416 2635 & id_deflvl=id_deflvl, & 2417 & id_chunksz=id_chunksz(:)) 2636 & id_chunksz=id_chunksz(:), & 2637 & cd_interp=cd_interp(:), & 2638 & cd_extrap=cd_extrap(:), & 2639 & cd_filter=cd_filter(:), & 2640 & cd_unt=cd_unt, dd_unf=dd_unf) 2418 2641 2419 2642 DEALLOCATE( dl_value ) … … 2438 2661 !> @author J.Paul 2439 2662 !> - November, 2013- Initial Version 2663 !> @date June, 2015 2664 !> - add interp, extrap, and filter argument 2665 !> @date July, 2015 2666 !> - add unit factor (to change unit) 2440 2667 ! 2441 2668 !> @param[in] cd_name variable name … … 2465 2692 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 2466 2693 !> @param[in] id_chunksz chunk size 2694 !> @param[in] cd_interp interpolation method 2695 !> @param[in] cd_extrap extrapolation method 2696 !> @param[in] cd_filter filter method 2697 !> @param[in] cd_unt new units (linked to units factor) 2698 !> @param[in] dd_unf units factor 2467 2699 !> @return variable structure 2468 2700 !------------------------------------------------------------------- … … 2475 2707 & dd_min, dd_max, & 2476 2708 & ld_contiguous, ld_shuffle,& 2477 & ld_fletcher32, id_deflvl, id_chunksz) 2709 & ld_fletcher32, id_deflvl, id_chunksz, & 2710 & cd_interp, cd_extrap, cd_filter, & 2711 & cd_unt, dd_unf) 2478 2712 2479 2713 IMPLICIT NONE … … 2504 2738 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2505 2739 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2740 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2741 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2742 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2743 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2744 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2506 2745 2507 2746 ! local variable … … 2549 2788 & ld_fletcher32=ld_fletcher32, & 2550 2789 & id_deflvl=id_deflvl, & 2551 & id_chunksz=id_chunksz(:)) 2790 & id_chunksz=id_chunksz(:), & 2791 & cd_interp=cd_interp(:), & 2792 & cd_extrap=cd_extrap(:), & 2793 & cd_filter=cd_filter(:), & 2794 & cd_unt=cd_unt, dd_unf=dd_unf) 2552 2795 2553 2796 DEALLOCATE( dl_value ) … … 2572 2815 !> @author J.Paul 2573 2816 !> - November, 2013- Initial Version 2817 !> @date June, 2015 2818 !> - add interp, extrap, and filter argument 2819 !> @date July, 2015 2820 !> - add unit factor (to change unit) 2574 2821 ! 2575 2822 !> @param[in] cd_name variable name … … 2601 2848 !> deflation is in use 2602 2849 !> @param[in] id_chunksz chunk size 2850 !> @param[in] cd_interp interpolation method 2851 !> @param[in] cd_extrap extrapolation method 2852 !> @param[in] cd_filter filter method 2853 !> @param[in] cd_unt new units (linked to units factor) 2854 !> @param[in] dd_unf units factor 2603 2855 !> @return variable structure 2604 2856 !------------------------------------------------------------------- … … 2611 2863 & dd_min, dd_max, & 2612 2864 & ld_contiguous, ld_shuffle,& 2613 & ld_fletcher32, id_deflvl, id_chunksz) 2865 & ld_fletcher32, id_deflvl, id_chunksz, & 2866 & cd_interp, cd_extrap, cd_filter, & 2867 & cd_unt, dd_unf) 2614 2868 2615 2869 IMPLICIT NONE … … 2640 2894 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2641 2895 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2896 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 2897 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 2898 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 2899 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 2900 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2642 2901 2643 2902 ! local variable … … 2686 2945 & ld_fletcher32=ld_fletcher32, & 2687 2946 & id_deflvl=id_deflvl, & 2688 & id_chunksz=id_chunksz(:)) 2947 & id_chunksz=id_chunksz(:), & 2948 & cd_interp=cd_interp(:), & 2949 & cd_extrap=cd_extrap(:), & 2950 & cd_filter=cd_filter(:), & 2951 & cd_unt=cd_unt, dd_unf=dd_unf) 2689 2952 2690 2953 DEALLOCATE( dl_value ) … … 2709 2972 !> @author J.Paul 2710 2973 !> - November, 2013- Initial Version 2974 !> @date June, 2015 2975 !> - add interp, extrap, and filter argument 2976 !> @date July, 2015 2977 !> - add unit factor (to change unit) 2711 2978 ! 2712 2979 !> @param[in] cd_name variable name … … 2738 3005 !> deflation is in use 2739 3006 !> @param[in] id_chunksz chunk size 3007 !> @param[in] cd_interp interpolation method 3008 !> @param[in] cd_extrap extrapolation method 3009 !> @param[in] cd_filter filter method 3010 !> @param[in] cd_unt new units (linked to units factor) 3011 !> @param[in] dd_unf units factor 2740 3012 !> @return variable structure 2741 3013 !------------------------------------------------------------------- … … 2748 3020 & dd_min, dd_max, & 2749 3021 & ld_contiguous, ld_shuffle,& 2750 & ld_fletcher32, id_deflvl, id_chunksz) 3022 & ld_fletcher32, id_deflvl, id_chunksz, & 3023 & cd_interp, cd_extrap, cd_filter, & 3024 & cd_unt, dd_unf) 2751 3025 2752 3026 IMPLICIT NONE … … 2777 3051 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2778 3052 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3053 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3054 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3055 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3056 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3057 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3058 2779 3059 2780 3060 ! local variable … … 2824 3104 & ld_fletcher32=ld_fletcher32, & 2825 3105 & id_deflvl=id_deflvl, & 2826 & id_chunksz=id_chunksz(:)) 3106 & id_chunksz=id_chunksz(:), & 3107 & cd_interp=cd_interp(:), & 3108 & cd_extrap=cd_extrap(:), & 3109 & cd_filter=cd_filter(:), & 3110 & cd_unt=cd_unt, dd_unf=dd_unf) 2827 3111 2828 3112 DEALLOCATE( dl_value ) … … 2847 3131 !> @author J.Paul 2848 3132 !> - November, 2013- Initial Version 3133 !> @date June, 2015 3134 !> - add interp, extrap, and filter argument 3135 !> @date July, 2015 3136 !> - add unit factor (to change unit) 2849 3137 ! 2850 3138 !> @param[in] cd_name variable name … … 2876 3164 !> deflation is in use 2877 3165 !> @param[in] id_chunksz chunk size 3166 !> @param[in] cd_interp interpolation method 3167 !> @param[in] cd_extrap extrapolation method 3168 !> @param[in] cd_filter filter method 3169 !> @param[in] cd_unt new units (linked to units factor) 3170 !> @param[in] dd_unf units factor 2878 3171 !> @return variable structure 2879 3172 !------------------------------------------------------------------- … … 2886 3179 & dd_min, dd_max, & 2887 3180 & ld_contiguous, ld_shuffle,& 2888 & ld_fletcher32, id_deflvl, id_chunksz) 3181 & ld_fletcher32, id_deflvl, id_chunksz, & 3182 & cd_interp, cd_extrap, cd_filter, & 3183 & cd_unt, dd_unf) 2889 3184 2890 3185 IMPLICIT NONE … … 2915 3210 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2916 3211 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3212 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3213 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3214 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3215 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3216 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 2917 3217 2918 3218 ! local variable … … 2958 3258 & ld_fletcher32=ld_fletcher32, & 2959 3259 & id_deflvl=id_deflvl, & 2960 & id_chunksz=id_chunksz(:)) 3260 & id_chunksz=id_chunksz(:), & 3261 & cd_interp=cd_interp(:), & 3262 & cd_extrap=cd_extrap(:), & 3263 & cd_filter=cd_filter(:), & 3264 & cd_unt=cd_unt, dd_unf=dd_unf) 2961 3265 2962 3266 DEALLOCATE( dl_value ) … … 2981 3285 !> @author J.Paul 2982 3286 !> - November, 2013- Initial Version 3287 !> @date June, 2015 3288 !> - add interp, extrap, and filter argument 3289 !> @date July, 2015 3290 !> - add unit factor (to change unit) 2983 3291 ! 2984 3292 !> @param[in] cd_name variable name … … 3010 3318 !> deflation is in use 3011 3319 !> @param[in] id_chunksz chunk size 3320 !> @param[in] cd_interp interpolation method 3321 !> @param[in] cd_extrap extrapolation method 3322 !> @param[in] cd_filter filter method 3323 !> @param[in] cd_unt new units (linked to units factor) 3324 !> @param[in] dd_unf units factor 3012 3325 !> @return variable structure 3013 3326 !------------------------------------------------------------------- … … 3020 3333 & dd_min, dd_max, & 3021 3334 & ld_contiguous, ld_shuffle,& 3022 & ld_fletcher32, id_deflvl, id_chunksz) 3335 & ld_fletcher32, id_deflvl, id_chunksz, & 3336 & cd_interp, cd_extrap, cd_filter, & 3337 & cd_unt, dd_unf) 3023 3338 3024 3339 IMPLICIT NONE … … 3049 3364 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3050 3365 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3366 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3367 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3368 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3369 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3370 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3051 3371 3052 3372 ! local variable … … 3094 3414 & ld_fletcher32=ld_fletcher32, & 3095 3415 & id_deflvl=id_deflvl, & 3096 & id_chunksz=id_chunksz(:)) 3416 & id_chunksz=id_chunksz(:), & 3417 & cd_interp=cd_interp(:), & 3418 & cd_extrap=cd_extrap(:), & 3419 & cd_filter=cd_filter(:), & 3420 & cd_unt=cd_unt, dd_unf=dd_unf) 3097 3421 3098 3422 DEALLOCATE( dl_value ) … … 3117 3441 !> @author J.Paul 3118 3442 !> - November, 2013- Initial Version 3443 !> @date June, 2015 3444 !> - add interp, extrap, and filter argument 3445 !> @date July, 2015 3446 !> - add unit factor (to change unit) 3119 3447 ! 3120 3448 !> @param[in] cd_name variable name … … 3146 3474 !> deflation is in use 3147 3475 !> @param[in] id_chunksz chunk size 3476 !> @param[in] cd_interp interpolation method 3477 !> @param[in] cd_extrap extrapolation method 3478 !> @param[in] cd_filter filter method 3479 !> @param[in] cd_unt new units (linked to units factor) 3480 !> @param[in] dd_unf units factor 3148 3481 !> @return variable structure 3149 3482 !------------------------------------------------------------------- … … 3156 3489 & dd_min, dd_max, & 3157 3490 & ld_contiguous, ld_shuffle,& 3158 & ld_fletcher32, id_deflvl, id_chunksz) 3491 & ld_fletcher32, id_deflvl, id_chunksz, & 3492 & cd_interp, cd_extrap, cd_filter, & 3493 & cd_unt, dd_unf) 3159 3494 3160 3495 IMPLICIT NONE … … 3185 3520 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3186 3521 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3522 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3523 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3524 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3525 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3526 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3187 3527 3188 3528 ! local variable … … 3231 3571 & ld_fletcher32=ld_fletcher32, & 3232 3572 & id_deflvl=id_deflvl, & 3233 & id_chunksz=id_chunksz(:)) 3573 & id_chunksz=id_chunksz(:), & 3574 & cd_interp=cd_interp(:), & 3575 & cd_extrap=cd_extrap(:), & 3576 & cd_filter=cd_filter(:), & 3577 & cd_unt=cd_unt, dd_unf=dd_unf) 3234 3578 3235 3579 DEALLOCATE( dl_value ) … … 3254 3598 !> @author J.Paul 3255 3599 !> - November, 2013- Initial Version 3600 !> @date June, 2015 3601 !> - add interp, extrap, and filter argument 3602 !> @date July, 2015 3603 !> - add unit factor (to change unit) 3256 3604 ! 3257 3605 !> @param[in] cd_name variable name … … 3283 3631 !> deflation is in use 3284 3632 !> @param[in] id_chunksz chunk size 3633 !> @param[in] cd_interp interpolation method 3634 !> @param[in] cd_extrap extrapolation method 3635 !> @param[in] cd_filter filter method 3636 !> @param[in] cd_unt new units (linked to units factor) 3637 !> @param[in] dd_unf units factor 3638 3285 3639 !> @return variable structure 3286 3640 !------------------------------------------------------------------- … … 3293 3647 & dd_min, dd_max, & 3294 3648 & ld_contiguous, ld_shuffle,& 3295 & ld_fletcher32, id_deflvl, id_chunksz) 3649 & ld_fletcher32, id_deflvl, id_chunksz, & 3650 & cd_interp, cd_extrap, cd_filter, & 3651 & cd_unt, dd_unf) 3296 3652 3297 3653 IMPLICIT NONE … … 3322 3678 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3323 3679 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3680 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3681 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3682 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3683 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3684 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3324 3685 3325 3686 ! local variable … … 3369 3730 & ld_fletcher32=ld_fletcher32, & 3370 3731 & id_deflvl=id_deflvl, & 3371 & id_chunksz=id_chunksz(:)) 3732 & id_chunksz=id_chunksz(:), & 3733 & cd_interp=cd_interp(:), & 3734 & cd_extrap=cd_extrap(:), & 3735 & cd_filter=cd_filter(:), & 3736 & cd_unt=cd_unt, dd_unf=dd_unf) 3372 3737 3373 3738 DEALLOCATE( dl_value ) … … 3392 3757 !> @author J.Paul 3393 3758 !> - November, 2013- Initial Version 3759 !> @date June, 2015 3760 !> - add interp, extrap, and filter argument 3761 !> @date July, 2015 3762 !> - add unit factor (to change unit) 3394 3763 ! 3395 3764 !> @param[in] cd_name variable name … … 3421 3790 !> deflation is in use 3422 3791 !> @param[in] id_chunksz chunk size 3792 !> @param[in] cd_interp interpolation method 3793 !> @param[in] cd_extrap extrapolation method 3794 !> @param[in] cd_filter filter method 3795 !> @param[in] cd_unt new units (linked to units factor) 3796 !> @param[in] dd_unf units factor 3423 3797 !> @return variable structure 3424 3798 !------------------------------------------------------------------- … … 3431 3805 & dd_min, dd_max, & 3432 3806 & ld_contiguous, ld_shuffle,& 3433 & ld_fletcher32, id_deflvl, id_chunksz) 3807 & ld_fletcher32, id_deflvl, id_chunksz, & 3808 & cd_interp, cd_extrap, cd_filter, & 3809 & cd_unt, dd_unf) 3434 3810 3435 3811 IMPLICIT NONE … … 3460 3836 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3461 3837 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3838 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3839 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3840 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3841 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3842 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3843 3462 3844 3463 3845 ! local variable … … 3503 3885 & ld_fletcher32=ld_fletcher32, & 3504 3886 & id_deflvl=id_deflvl, & 3505 & id_chunksz=id_chunksz(:)) 3887 & id_chunksz=id_chunksz(:), & 3888 & cd_interp=cd_interp(:), & 3889 & cd_extrap=cd_extrap(:), & 3890 & cd_filter=cd_filter(:), & 3891 & cd_unt=cd_unt, dd_unf=dd_unf) 3506 3892 3507 3893 DEALLOCATE( dl_value ) … … 3526 3912 !> @author J.Paul 3527 3913 !> - November, 2013- Initial Version 3914 !> @date June, 2015 3915 !> - add interp, extrap, and filter argument 3916 !> @date July, 2015 3917 !> - add unit factor (to change unit) 3528 3918 ! 3529 3919 !> @param[in] cd_name variable name … … 3555 3945 !> deflation is in use 3556 3946 !> @param[in] id_chunksz chunk size 3947 !> @param[in] cd_interp interpolation method 3948 !> @param[in] cd_extrap extrapolation method 3949 !> @param[in] cd_filter filter method 3950 !> @param[in] cd_unt new units (linked to units factor) 3951 !> @param[in] dd_unf units factor 3557 3952 !> @return variable structure 3558 3953 !------------------------------------------------------------------- … … 3565 3960 & dd_min, dd_max, & 3566 3961 & ld_contiguous, ld_shuffle,& 3567 & ld_fletcher32, id_deflvl, id_chunksz) 3962 & ld_fletcher32, id_deflvl, id_chunksz, & 3963 & cd_interp, cd_extrap, cd_filter, & 3964 & cd_unt, dd_unf) 3568 3965 3569 3966 IMPLICIT NONE … … 3594 3991 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3595 3992 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3993 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 3994 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 3995 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 3996 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 3997 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3998 3596 3999 3597 4000 ! local variable … … 3639 4042 & ld_fletcher32=ld_fletcher32, & 3640 4043 & id_deflvl=id_deflvl, & 3641 & id_chunksz=id_chunksz(:)) 4044 & id_chunksz=id_chunksz(:), & 4045 & cd_interp=cd_interp(:), & 4046 & cd_extrap=cd_extrap(:), & 4047 & cd_filter=cd_filter(:), & 4048 & cd_unt=cd_unt, dd_unf=dd_unf) 3642 4049 3643 4050 DEALLOCATE( dl_value ) … … 3662 4069 !> @author J.Paul 3663 4070 !> - November, 2013- Initial Version 4071 !> @date June, 2015 4072 !> - add interp, extrap, and filter argument 4073 !> @date July, 2015 4074 !> - add unit factor (to change unit) 3664 4075 ! 3665 4076 !> @param[in] cd_name variable name … … 3691 4102 !> deflation is in use 3692 4103 !> @param[in] id_chunksz chunk size 4104 !> @param[in] cd_interp interpolation method 4105 !> @param[in] cd_extrap extrapolation method 4106 !> @param[in] cd_filter filter method 4107 !> @param[in] cd_unt new units (linked to units factor) 4108 !> @param[in] dd_unf units factor 3693 4109 !> @return variable structure 3694 4110 !------------------------------------------------------------------- … … 3701 4117 & dd_min, dd_max, & 3702 4118 & ld_contiguous, ld_shuffle,& 3703 & ld_fletcher32, id_deflvl, id_chunksz) 4119 & ld_fletcher32, id_deflvl, id_chunksz, & 4120 & cd_interp, cd_extrap, cd_filter, & 4121 & cd_unt, dd_unf) 3704 4122 3705 4123 IMPLICIT NONE … … 3730 4148 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3731 4149 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4150 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4151 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4152 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4153 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4154 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3732 4155 3733 4156 ! local variable … … 3776 4199 & ld_fletcher32=ld_fletcher32, & 3777 4200 & id_deflvl=id_deflvl, & 3778 & id_chunksz=id_chunksz(:)) 4201 & id_chunksz=id_chunksz(:), & 4202 & cd_interp=cd_interp(:), & 4203 & cd_extrap=cd_extrap(:), & 4204 & cd_filter=cd_filter(:), & 4205 & cd_unt=cd_unt, dd_unf=dd_unf) 3779 4206 3780 4207 DEALLOCATE( dl_value ) … … 3799 4226 !> @author J.Paul 3800 4227 !> - November, 2013- Initial Version 4228 !> @date June, 2015 4229 !> - add interp, extrap, and filter argument 4230 !> @date July, 2015 4231 !> - add unit factor (to change unit) 3801 4232 ! 3802 4233 !> @param[in] cd_name variable name … … 3828 4259 !> deflation is in use 3829 4260 !> @param[in] id_chunksz chunk size 4261 !> @param[in] cd_interp interpolation method 4262 !> @param[in] cd_extrap extrapolation method 4263 !> @param[in] cd_filter filter method 4264 !> @param[in] cd_unt new units (linked to units factor) 4265 !> @param[in] dd_unf units factor 3830 4266 !> @return variable structure 3831 4267 !------------------------------------------------------------------- … … 3838 4274 & dd_min, dd_max, & 3839 4275 & ld_contiguous, ld_shuffle,& 3840 & ld_fletcher32, id_deflvl, id_chunksz) 4276 & ld_fletcher32, id_deflvl, id_chunksz, & 4277 & cd_interp, cd_extrap, cd_filter, & 4278 & cd_unt, dd_unf) 3841 4279 3842 4280 IMPLICIT NONE … … 3867 4305 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3868 4306 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4307 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4308 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4309 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4310 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4311 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 3869 4312 3870 4313 ! local variable … … 3914 4357 & ld_fletcher32=ld_fletcher32, & 3915 4358 & id_deflvl=id_deflvl, & 3916 & id_chunksz=id_chunksz(:)) 4359 & id_chunksz=id_chunksz(:), & 4360 & cd_interp=cd_interp(:), & 4361 & cd_extrap=cd_extrap(:), & 4362 & cd_filter=cd_filter(:), & 4363 & cd_unt=cd_unt, dd_unf=dd_unf) 3917 4364 3918 4365 DEALLOCATE( dl_value ) … … 3937 4384 !> @author J.Paul 3938 4385 !> - November, 2013- Initial Version 4386 !> @date June, 2015 4387 !> - add interp, extrap, and filter argument 4388 !> @date July, 2015 4389 !> - add unit factor (to change unit) 3939 4390 ! 3940 4391 !> @param[in] cd_name variable name … … 3966 4417 !> deflation is in use 3967 4418 !> @param[in] id_chunksz chunk size 4419 !> @param[in] cd_interp interpolation method 4420 !> @param[in] cd_extrap extrapolation method 4421 !> @param[in] cd_filter filter method 4422 !> @param[in] cd_unt new units (linked to units factor) 4423 !> @param[in] dd_unf units factor 3968 4424 !> @return variable structure 3969 4425 !------------------------------------------------------------------- … … 3976 4432 & dd_min, dd_max, & 3977 4433 & ld_contiguous, ld_shuffle,& 3978 & ld_fletcher32, id_deflvl, id_chunksz) 4434 & ld_fletcher32, id_deflvl, id_chunksz, & 4435 & cd_interp, cd_extrap, cd_filter, & 4436 & cd_unt, dd_unf) 3979 4437 3980 4438 IMPLICIT NONE … … 4005 4463 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4006 4464 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4465 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4466 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4467 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4468 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4469 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4007 4470 4008 4471 ! local variable … … 4048 4511 & ld_fletcher32=ld_fletcher32, & 4049 4512 & id_deflvl=id_deflvl, & 4050 & id_chunksz=id_chunksz(:)) 4513 & id_chunksz=id_chunksz(:), & 4514 & cd_interp=cd_interp(:), & 4515 & cd_extrap=cd_extrap(:), & 4516 & cd_filter=cd_filter(:), & 4517 & cd_unt=cd_unt, dd_unf=dd_unf) 4051 4518 4052 4519 DEALLOCATE( dl_value ) … … 4071 4538 !> @author J.Paul 4072 4539 !> - November, 2013- Initial Version 4540 !> @date June, 2015 4541 !> - add interp, extrap, and filter argument 4542 !> @date July, 2015 4543 !> - add unit factor (to change unit) 4073 4544 ! 4074 4545 !> @param[in] cd_name variable name … … 4100 4571 !> deflation is in use 4101 4572 !> @param[in] id_chunksz chunk size 4573 !> @param[in] cd_interp interpolation method 4574 !> @param[in] cd_extrap extrapolation method 4575 !> @param[in] cd_filter filter method 4576 !> @param[in] cd_unt new units (linked to units factor) 4577 !> @param[in] dd_unf units factor 4102 4578 !> @return variable structure 4103 4579 !------------------------------------------------------------------- … … 4110 4586 & dd_min, dd_max, & 4111 4587 & ld_contiguous, ld_shuffle,& 4112 & ld_fletcher32, id_deflvl, id_chunksz) 4588 & ld_fletcher32, id_deflvl, id_chunksz, & 4589 & cd_interp, cd_extrap, cd_filter, & 4590 & cd_unt, dd_unf) 4113 4591 4114 4592 IMPLICIT NONE … … 4139 4617 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4140 4618 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4619 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4620 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4621 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4622 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4623 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4141 4624 4142 4625 ! local variable … … 4184 4667 & ld_fletcher32=ld_fletcher32, & 4185 4668 & id_deflvl=id_deflvl, & 4186 & id_chunksz=id_chunksz(:)) 4669 & id_chunksz=id_chunksz(:), & 4670 & cd_interp=cd_interp(:), & 4671 & cd_extrap=cd_extrap(:), & 4672 & cd_filter=cd_filter(:), & 4673 & cd_unt=cd_unt, dd_unf=dd_unf) 4187 4674 4188 4675 DEALLOCATE( dl_value ) … … 4207 4694 !> @author J.Paul 4208 4695 !> - November, 2013- Initial Version 4696 !> @date June, 2015 4697 !> - add interp, extrap, and filter argument 4698 !> @date July, 2015 4699 !> - add unit factor (to change unit) 4209 4700 ! 4210 4701 !> @param[in] cd_name variable name … … 4236 4727 !> deflation is in use 4237 4728 !> @param[in] id_chunksz chunk size 4729 !> @param[in] cd_interp interpolation method 4730 !> @param[in] cd_extrap extrapolation method 4731 !> @param[in] cd_filter filter method 4732 !> @param[in] cd_unt new units (linked to units factor) 4733 !> @param[in] dd_unf units factor 4238 4734 !> @return variable structure 4239 4735 !------------------------------------------------------------------- … … 4246 4742 & dd_min, dd_max, & 4247 4743 & ld_contiguous, ld_shuffle,& 4248 & ld_fletcher32, id_deflvl, id_chunksz) 4744 & ld_fletcher32, id_deflvl, id_chunksz, & 4745 & cd_interp, cd_extrap, cd_filter, & 4746 & cd_unt, dd_unf) 4249 4747 4250 4748 IMPLICIT NONE … … 4275 4773 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4276 4774 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4775 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4776 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4777 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4778 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4779 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4277 4780 4278 4781 ! local variable … … 4321 4824 & ld_fletcher32=ld_fletcher32, & 4322 4825 & id_deflvl=id_deflvl, & 4323 & id_chunksz=id_chunksz(:)) 4826 & id_chunksz=id_chunksz(:), & 4827 & cd_interp=cd_interp(:), & 4828 & cd_extrap=cd_extrap(:), & 4829 & cd_filter=cd_filter(:), & 4830 & cd_unt=cd_unt, dd_unf=dd_unf) 4324 4831 4325 4832 DEALLOCATE( dl_value ) … … 4344 4851 !> @author J.Paul 4345 4852 !> - November, 2013- Initial Version 4853 !> @date June, 2015 4854 !> - add interp, extrap, and filter argument 4855 !> @date July, 2015 4856 !> - add unit factor (to change unit) 4346 4857 ! 4347 4858 !> @param[in] cd_name variable name … … 4373 4884 !> deflation is in use 4374 4885 !> @param[in] id_chunksz chunk size 4886 !> @param[in] cd_interp interpolation method 4887 !> @param[in] cd_extrap extrapolation method 4888 !> @param[in] cd_filter filter method 4889 !> @param[in] cd_unt new units (linked to units factor) 4890 !> @param[in] dd_unf units factor 4375 4891 !> @return variable structure 4376 4892 !------------------------------------------------------------------- … … 4383 4899 & dd_min, dd_max, & 4384 4900 & ld_contiguous, ld_shuffle,& 4385 & ld_fletcher32, id_deflvl, id_chunksz) 4901 & ld_fletcher32, id_deflvl, id_chunksz, & 4902 & cd_interp, cd_extrap, cd_filter, & 4903 & cd_unt, dd_unf) 4386 4904 4387 4905 IMPLICIT NONE … … 4412 4930 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4413 4931 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4932 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp 4933 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 4934 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 4935 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt 4936 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf 4414 4937 4415 4938 ! local variable … … 4459 4982 & ld_fletcher32=ld_fletcher32, & 4460 4983 & id_deflvl=id_deflvl, & 4461 & id_chunksz=id_chunksz(:)) 4984 & id_chunksz=id_chunksz(:), & 4985 & cd_interp=cd_interp(:), & 4986 & cd_extrap=cd_extrap(:), & 4987 & cd_filter=cd_filter(:), & 4988 & cd_unt=cd_unt, dd_unf=dd_unf) 4462 4989 4463 4990 DEALLOCATE( dl_value ) … … 4821 5348 !> @author J.Paul 4822 5349 !> - November, 2013- Initial Version 5350 !> @date June, 2015 - add all element of the array in the same time 4823 5351 !> 4824 5352 !> @param[inout] td_var variable structure … … 4833 5361 ! local variable 4834 5362 INTEGER(i4) :: il_natt 5363 INTEGER(i4) :: il_status 5364 INTEGER(i4) :: il_ind 5365 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 4835 5366 4836 5367 ! loop indices … … 4840 5371 il_natt=SIZE(td_att(:)) 4841 5372 5373 IF( td_var%i_natt > 0 )THEN 5374 ! already other attribute in variable structure 5375 ALLOCATE( tl_att(td_var%i_natt), stat=il_status ) 5376 IF(il_status /= 0 )THEN 5377 5378 CALL logger_error( & 5379 & " VAR ADD ATT: not enough space to put attributes from "//& 5380 & TRIM(td_var%c_name)//" in temporary attribute structure") 5381 5382 ELSE 5383 5384 ! save temporary global attribute's variable structure 5385 tl_att(:)=att_copy(td_var%t_att(:)) 5386 5387 CALL att_clean(td_var%t_att(:)) 5388 DEALLOCATE( td_var%t_att ) 5389 ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 5390 IF(il_status /= 0 )THEN 5391 5392 CALL logger_error( & 5393 & " VAR ADD ATT: not enough space to put attributes "//& 5394 & "in variable structure "//TRIM(td_var%c_name) ) 5395 5396 ENDIF 5397 5398 ! copy attribute in variable before 5399 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 5400 5401 ! clean 5402 CALL att_clean(tl_att(:)) 5403 DEALLOCATE(tl_att) 5404 5405 ENDIF 5406 ELSE 5407 ! no attribute in variable structure 5408 IF( ASSOCIATED(td_var%t_att) )THEN 5409 CALL att_clean(td_var%t_att(:)) 5410 DEALLOCATE(td_var%t_att) 5411 ENDIF 5412 ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 5413 IF(il_status /= 0 )THEN 5414 5415 CALL logger_error( & 5416 & " VAR ADD ATT: not enough space to put attributes "//& 5417 & "in variable structure "//TRIM(td_var%c_name) ) 5418 5419 ENDIF 5420 ENDIF 5421 5422 ALLOCATE( tl_att(il_natt) ) 5423 tl_att(:)=att_copy(td_att(:)) 5424 5425 ! check if attribute already in variable structure 4842 5426 DO ji=1,il_natt 4843 CALL var_add_att(td_var, td_att(ji)) 5427 il_ind=0 5428 il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name ) 5429 IF( il_ind /= 0 )THEN 5430 CALL logger_error( & 5431 & " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//& 5432 & ", already in variable "//TRIM(td_var%c_name) ) 5433 CALL att_clean(tl_att(ji)) 5434 ENDIF 4844 5435 ENDDO 5436 5437 ! add new attributes 5438 td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:)) 5439 5440 DEALLOCATE(tl_att) 5441 5442 DO ji=1,il_natt 5443 ! highlight some attribute 5444 IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. & 5445 & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN 5446 SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name)) 5447 5448 CASE("add_offset") 5449 td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1) 5450 CASE("scale_factor") 5451 td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1) 5452 CASE("_FillValue") 5453 td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1) 5454 CASE("ew_overlap") 5455 td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4) 5456 CASE("standard_name") 5457 td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5458 CASE("long_name") 5459 td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5460 CASE("units") 5461 td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5462 CASE("grid_point") 5463 td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 5464 5465 END SELECT 5466 ENDIF 5467 ENDDO 5468 5469 ! update number of attribute 5470 td_var%i_natt=td_var%i_natt+il_natt 5471 4845 5472 4846 5473 END SUBROUTINE var__add_att_arr … … 4850 5477 ! 4851 5478 !> @author J.Paul 4852 !> - November, 2013- Initial Version 5479 !> - November, 2013 - Initial Version 5480 !> @date June, 2015 - use var__add_att_arr subroutine 4853 5481 ! 4854 5482 !> @param[inout] td_var variable structure … … 4862 5490 4863 5491 ! local variable 4864 INTEGER(i4) :: il_status 4865 INTEGER(i4) :: il_ind 4866 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 5492 TYPE(TATT), DIMENSION(1) :: tl_att 4867 5493 4868 5494 ! loop indices 4869 INTEGER(i4) :: ji4870 5495 !---------------------------------------------------------------- 4871 5496 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 5497 ! copy structure in an array 5498 tl_att(1)=att_copy(td_att) 5499 5500 ! 5501 CALL var_add_att( td_var, tl_att(:) ) 4977 5502 4978 5503 END SUBROUTINE var__add_att_unit … … 4983 5508 !> @author J.Paul 4984 5509 !> - November, 2013- Initial Version 5510 !> @date February, 2015 - define local attribute structure to avoid mistake 5511 !> with pointer 4985 5512 ! 4986 5513 !> @param[inout] td_var variable structure … … 4996 5523 INTEGER(i4) :: il_ind 4997 5524 5525 TYPE(TATT) :: tl_att 4998 5526 ! loop indices 4999 5527 !---------------------------------------------------------------- … … 5007 5535 IF( il_ind == 0 )THEN 5008 5536 5009 CALL logger_ warn( &5537 CALL logger_debug( & 5010 5538 & " VAR DEL ATT: no attribute "//TRIM(cd_name)//& 5011 5539 & ", in variable "//TRIM(td_var%c_name) ) … … 5013 5541 ELSE 5014 5542 5015 CALL var_del_att(td_var, td_var%t_att(il_ind)) 5543 tl_att=att_copy(td_var%t_att(il_ind)) 5544 CALL var_del_att(td_var, tl_att) 5016 5545 5017 5546 ENDIF … … 5024 5553 !> @author J.Paul 5025 5554 !> - November, 2013- Initial Version 5555 !> @date February, 2015 - delete highlight attribute too, when attribute 5556 !> is deleted 5026 5557 ! 5027 5558 !> @param[inout] td_var variable structure … … 5040 5571 5041 5572 ! loop indices 5042 !INTEGER(i4) :: ji5043 5573 !---------------------------------------------------------------- 5044 5574 … … 5051 5581 IF( il_ind == 0 )THEN 5052 5582 5053 CALL logger_ warn( &5583 CALL logger_debug( & 5054 5584 & " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//& 5055 5585 & ", in variable "//TRIM(td_var%c_name) ) … … 5103 5633 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 5104 5634 5105 !! change attribute id5106 !DO ji=1,td_var%i_natt5107 ! td_var%t_att(ji)%i_id=ji5108 !ENDDO5109 5110 5635 ! clean 5111 5636 CALL att_clean(tl_att(:)) … … 5113 5638 ENDIF 5114 5639 ENDIF 5640 5641 ! highlight attribute 5642 SELECT CASE( TRIM(td_att%c_name) ) 5643 5644 CASE("add_offset") 5645 td_var%d_ofs = 0._dp 5646 CASE("scale_factor") 5647 td_var%d_scf = 1._dp 5648 CASE("_FillValue") 5649 td_var%d_fill = 0._dp 5650 CASE("ew_overlap") 5651 td_var%i_ew = -1 5652 CASE("standard_name") 5653 td_var%c_stdname = '' 5654 CASE("long_name") 5655 td_var%c_longname = '' 5656 CASE("units") 5657 td_var%c_units = '' 5658 CASE("grid_point") 5659 td_var%c_point = '' 5660 5661 END SELECT 5662 5115 5663 ENDIF 5116 5664 … … 5211 5759 !---------------------------------------------------------------- 5212 5760 5213 IF( td_var%i_ndim <= 4)THEN5761 IF( td_var%i_ndim <= ip_maxdim )THEN 5214 5762 5215 5763 ! check if dimension already used in variable structure … … 5227 5775 ELSE 5228 5776 5229 ! back to unorder dimension array 5230 CALL dim_unorder(td_var%t_dim(:)) 5777 ! back to disorder dimension array 5778 CALL dim_disorder(td_var%t_dim(:)) 5779 5231 5780 ! add new dimension 5232 5781 td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim) … … 5272 5821 !---------------------------------------------------------------- 5273 5822 5274 IF( td_var%i_ndim <= 4)THEN5823 IF( td_var%i_ndim <= ip_maxdim )THEN 5275 5824 5276 5825 CALL logger_trace( & … … 6322 6871 !> 6323 6872 !> @author J.Paul 6324 !> - November, 2013- Initial Version 6873 !> - November, 2013 - Initial Version 6874 !> @date June, 2015 6875 !> - new namelist format to get extra information (interpolation,...) 6325 6876 ! 6326 6877 !> @param[in] cd_file configuration file of variable … … 6357 6908 6358 6909 il_fileid=fct_getunit() 6359 CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file))6360 6910 OPEN( il_fileid, FILE=TRIM(cd_file), & 6361 6911 & FORM='FORMATTED', & … … 6366 6916 CALL fct_err(il_status) 6367 6917 IF( il_status /= 0 )THEN 6368 CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file)) 6918 CALL logger_fatal("VAR DEF EXTRA: can not open file "//& 6919 & TRIM(cd_file)) 6369 6920 ENDIF 6370 6921 … … 6375 6926 DO WHILE( il_status == 0 ) 6376 6927 6377 ! search line donot beginning with comment character6928 ! search line not beginning with comment character 6378 6929 IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 6379 6930 il_nvar=il_nvar+1 … … 6419 6970 tg_varextra(ji)%c_axis =TRIM(fct_split(cl_line,3)) 6420 6971 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)) 6972 6973 cl_interp='int='//TRIM(fct_split(cl_line,5)) 6425 6974 tg_varextra(ji)%c_interp(:) = & 6426 6975 & var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp) 6427 6976 CALL logger_debug("VAR DEF EXTRA: "//& 6428 6977 & TRIM(tg_varextra(ji)%c_name)//& 6429 & " "//TRIM(cl_interp)) 6978 & " "//TRIM(tg_varextra(ji)%c_interp(1))) 6979 6980 tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6)) 6981 tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7)) 6430 6982 ELSE 6431 6983 ji=ji-1 … … 6458 7010 !> @details 6459 7011 !> string character format must be : <br/> 6460 !> "varname:int erp; filter; extrap; > min; <max"<br/>7012 !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/> 6461 7013 !> you could specify only interpolation, filter or extrapolation method, 6462 7014 !> whatever the order. you could find more … … 6464 7016 !> \ref extrap module.<br/> 6465 7017 !> Examples: 6466 !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.' 6467 !> cn_varinfo='votemper:cubic; dist_weight; <40.' 7018 !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.' 7019 !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.' 7020 !> 7021 !> 7022 !> @warning variable should be define in tg_varextra (ie in configuration 7023 !> file, to be able to add information from namelist 6468 7024 !> 6469 7025 !> @note If you do not specify a method which is required, default one is … … 6471 7027 !> 6472 7028 !> @author J.Paul 6473 !> - November, 2013- Initial Version 7029 !> - November, 2013 - Initial Version 7030 !> @date July, 2015 - get unit and unit factor (to change unit) 6474 7031 ! 6475 7032 !> @param[in] cd_varinfo variable information from namelist … … 6486 7043 CHARACTER(LEN=lc), DIMENSION(1) :: cl_extrap 6487 7044 CHARACTER(LEN=lc), DIMENSION(5) :: cl_filter 7045 CHARACTER(LEN=lc) :: cl_unt 6488 7046 6489 7047 INTEGER(i4) :: il_ind … … 6492 7050 REAL(dp) :: dl_min 6493 7051 REAL(dp) :: dl_max 7052 REAL(dp) :: dl_unf 6494 7053 6495 7054 TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_varextra … … 6508 7067 dl_min=var__get_min(cl_name, cl_method) 6509 7068 dl_max=var__get_max(cl_name, cl_method) 7069 dl_unf=var__get_unf(cl_name, cl_method) 6510 7070 cl_interp(:)=var__get_interp(cl_name, cl_method) 6511 7071 cl_extrap(:)=var__get_extrap(cl_name, cl_method) 6512 7072 cl_filter(:)=var__get_filter(cl_name, cl_method) 7073 cl_unt=var__get_unt(cl_name, cl_method) 7074 6513 7075 6514 7076 il_ind=var_get_index(tg_varextra(:), TRIM(cl_name)) … … 6516 7078 IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min 6517 7079 IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max 7080 IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf 7081 IF(cl_unt /='') tg_varextra(il_ind)%c_unt =cl_unt 6518 7082 IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:) 6519 7083 IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:) … … 6551 7115 & cd_filter=cl_filter(:), & 6552 7116 & dd_min = dl_min, & 6553 & dd_max = dl_max ) 7117 & dd_max = dl_max, & 7118 & cd_unt = cl_unt, & 7119 & dd_unf = dl_unf ) 6554 7120 6555 7121 ENDIF 6556 7122 6557 7123 ji=ji+1 6558 CALL logger_ trace( "VAR CHG EXTRA: name "//&7124 CALL logger_debug( "VAR CHG EXTRA: name "//& 6559 7125 & TRIM(tg_varextra(il_ind)%c_name) ) 6560 CALL logger_ trace( "VAR CHG EXTRA: interp "//&7126 CALL logger_debug( "VAR CHG EXTRA: interp "//& 6561 7127 & TRIM(tg_varextra(il_ind)%c_interp(1)) ) 6562 CALL logger_ trace( "VAR CHG EXTRA: filter "//&7128 CALL logger_debug( "VAR CHG EXTRA: filter "//& 6563 7129 & TRIM(tg_varextra(il_ind)%c_filter(1)) ) 6564 CALL logger_ trace( "VAR CHG EXTRA: extrap "//&7130 CALL logger_debug( "VAR CHG EXTRA: extrap "//& 6565 7131 & TRIM(tg_varextra(il_ind)%c_extrap(1)) ) 6566 7132 IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN 6567 CALL logger_ trace( "VAR CHG EXTRA: min value "//&7133 CALL logger_debug( "VAR CHG EXTRA: min value "//& 6568 7134 & TRIM(fct_str(tg_varextra(il_ind)%d_min)) ) 6569 7135 ENDIF 6570 7136 IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN 6571 CALL logger_ trace( "VAR CHG EXTRA: max value "//&7137 CALL logger_debug( "VAR CHG EXTRA: max value "//& 6572 7138 & TRIM(fct_str(tg_varextra(il_ind)%d_max)) ) 7139 ENDIF 7140 IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 7141 CALL logger_debug( "VAR CHG EXTRA: new unit "//& 7142 & TRIM(tg_varextra(il_ind)%c_unt) ) 7143 ENDIF 7144 IF( tg_varextra(il_ind)%d_unf /= 1. )THEN 7145 CALL logger_debug( "VAR CHG EXTRA: new unit factor "//& 7146 & TRIM(fct_str(tg_varextra(il_ind)%d_unf)) ) 6573 7147 ENDIF 6574 7148 ENDDO … … 6808 7382 ENDIF 6809 7383 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))) 7384 ! unt 7385 IF( TRIM(td_var%c_unt) == '' .AND. & 7386 & TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 7387 td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt) 7388 ENDIF 7389 7390 ! units factor 7391 IF( td_var%d_unf == 1._dp .AND. & 7392 & tg_varextra(il_ind)%d_unf /= 1._dp )THEN 7393 td_var%d_unf=tg_varextra(il_ind)%d_unf 7394 ENDIF 7395 6819 7396 ENDIF 6820 7397 … … 6833 7410 !> 6834 7411 !> @details 6835 !> minimum value is assume to follow s ign '>'7412 !> minimum value is assume to follow string "min =" 6836 7413 !> 6837 7414 !> @author J.Paul 6838 !> - November, 2013- Initial Version 7415 !> - November, 2013 - Initial Version 7416 !> @date June, 2015 - change way to get information in namelist, 7417 !> value follows string "min =" 6839 7418 ! 6840 7419 !> @param[in] cd_name variable name … … 6867 7446 cl_tmp=fct_split(cd_varinfo,ji,';') 6868 7447 DO WHILE( TRIM(cl_tmp) /= '' ) 6869 il_ind= SCAN(TRIM(cl_tmp),'>')7448 il_ind=INDEX(TRIM(cl_tmp),'min') 6870 7449 IF( il_ind /= 0 )THEN 6871 cl_min= TRIM(ADJUSTL(cl_tmp(il_ind+1:)))7450 cl_min=fct_split(cl_tmp,2,'=') 6872 7451 EXIT 6873 7452 ENDIF … … 6877 7456 6878 7457 IF( TRIM(cl_min) /= '' )THEN 6879 IF( fct_is_ num(cl_min) )THEN7458 IF( fct_is_real(cl_min) )THEN 6880 7459 READ(cl_min,*) var__get_min 6881 7460 CALL logger_debug("VAR GET MIN: will use minimum value of "//& … … 6894 7473 !> 6895 7474 !> @details 6896 !> maximum value is assume to follow s ign '<'7475 !> maximum value is assume to follow string "max =" 6897 7476 !> 6898 7477 !> @author J.Paul 6899 !> - November, 2013- Initial Version 7478 !> - November, 2013 - Initial Version 7479 !> @date June, 2015 - change way to get information in namelist, 7480 !> value follows string "max =" 6900 7481 ! 6901 7482 !> @param[in] cd_name variable name … … 6928 7509 cl_tmp=fct_split(cd_varinfo,ji,';') 6929 7510 DO WHILE( TRIM(cl_tmp) /= '' ) 6930 il_ind= SCAN(TRIM(cl_tmp),'<')7511 il_ind=INDEX(TRIM(cl_tmp),'max') 6931 7512 IF( il_ind /= 0 )THEN 6932 cl_max= TRIM(ADJUSTL(cl_tmp(il_ind+1:)))7513 cl_max=fct_split(cl_tmp,2,'=') 6933 7514 EXIT 6934 7515 ENDIF … … 6938 7519 6939 7520 IF( TRIM(cl_max) /= '' )THEN 6940 IF( fct_is_ num(cl_max) )THEN7521 IF( fct_is_real(cl_max) )THEN 6941 7522 READ(cl_max,*) var__get_max 6942 7523 CALL logger_debug("VAR GET MAX: will use maximum value of "//& … … 6952 7533 !> @brief 6953 7534 !> This function check if variable information read in namelist contains 7535 !> units factor value and return it if true. 7536 !> 7537 !> @details 7538 !> units factor value is assume to follow string "unf =" 7539 !> 7540 !> @author J.Paul 7541 !> - June, 2015- Initial Version 7542 ! 7543 !> @param[in] cd_name variable name 7544 !> @param[in] cd_varinfo variable information read in namelist 7545 !> @return untis factor value to be used (FillValue if none) 7546 !------------------------------------------------------------------- 7547 FUNCTION var__get_unf( cd_name, cd_varinfo ) 7548 IMPLICIT NONE 7549 ! Argument 7550 CHARACTER(LEN=*), INTENT(IN ) :: cd_name 7551 CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo 7552 7553 ! function 7554 REAL(dp) :: var__get_unf 7555 7556 ! local variable 7557 CHARACTER(LEN=lc) :: cl_tmp 7558 CHARACTER(LEN=lc) :: cl_unf 7559 7560 INTEGER(i4) :: il_ind 7561 7562 REAL(dp) :: rl_unf 7563 7564 ! loop indices 7565 INTEGER(i4) :: ji 7566 !---------------------------------------------------------------- 7567 ! init 7568 cl_unf='' 7569 var__get_unf=dp_fill 7570 7571 ji=1 7572 cl_tmp=fct_split(cd_varinfo,ji,';') 7573 DO WHILE( TRIM(cl_tmp) /= '' ) 7574 il_ind=INDEX(TRIM(cl_tmp),'unf') 7575 IF( il_ind /= 0 )THEN 7576 cl_unf=fct_split(cl_tmp,2,'=') 7577 EXIT 7578 ENDIF 7579 ji=ji+1 7580 cl_tmp=fct_split(cd_varinfo,ji,';') 7581 ENDDO 7582 7583 IF( TRIM(cl_unf) /= '' )THEN 7584 rl_unf=math_compute(cl_unf) 7585 IF( rl_unf /= dp_fill )THEN 7586 var__get_unf = rl_unf 7587 CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//& 7588 & "value of "//TRIM(fct_str(var__get_unf))//" for variable "//& 7589 & TRIM(cd_name) ) 7590 ELSE 7591 CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//& 7592 & "value for variable "//TRIM(cd_name)//". check namelist." ) 7593 ENDIF 7594 ENDIF 7595 7596 END FUNCTION var__get_unf 7597 !------------------------------------------------------------------- 7598 !> @brief 7599 !> This function check if variable information read in namelist contains 6954 7600 !> interpolation method and return it if true. 6955 7601 !> 6956 7602 !> @details 6957 !> split namelist information, using ';' as separator. 7603 !> interpolation method is assume to follow string "int =" 7604 !> 6958 7605 !> compare method name with the list of interpolation method available (see 6959 7606 !> module global). 6960 7607 !> check if factor (*rhoi, /rhoj..) are present.<br/> 6961 7608 !> Example:<br/> 6962 !> - cubic/rhoi ;dist_weight6963 !> - bilin7609 !> - int=cubic/rhoi ; ext=dist_weight 7610 !> - int=bilin 6964 7611 !> see @ref interp module for more information. 6965 7612 !> 6966 7613 !> @author J.Paul 6967 !> - November, 2013- Initial Version 7614 !> - November, 2013 - Initial Version 7615 !> @date June, 2015 - change way to get information in namelist, 7616 !> value follows string "int =" 6968 7617 ! 6969 7618 !> @param[in] cd_name variable name … … 6982 7631 ! local variable 6983 7632 CHARACTER(LEN=lc) :: cl_tmp 7633 CHARACTER(LEN=lc) :: cl_int 6984 7634 CHARACTER(LEN=lc) :: cl_factor 6985 7635 … … 7000 7650 cl_tmp=fct_split(cd_varinfo,ji,';') 7001 7651 DO WHILE( TRIM(cl_tmp) /= '' ) 7652 il_ind=INDEX(TRIM(cl_tmp),'int') 7653 IF( il_ind /= 0 )THEN 7654 cl_int=fct_split(cl_tmp,2,'=') 7655 EXIT 7656 ENDIF 7657 ji=ji+1 7658 cl_tmp=fct_split(cd_varinfo,ji,';') 7659 ENDDO 7660 7661 IF( TRIM(cl_int) /= '' )THEN 7002 7662 DO jj=1,ip_ninterp 7003 il_ind= INDEX(fct_lower(cl_ tmp),TRIM(cp_interp_list(jj)))7663 il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj))) 7004 7664 IF( il_ind /= 0 )THEN 7005 7665 … … 7009 7669 ! look for factor 7010 7670 IF( il_ind==1 )THEN 7011 cl_factor=cl_ tmp(il_len+1:)7671 cl_factor=cl_int(il_len+1:) 7012 7672 ELSE 7013 cl_factor=cl_ tmp(1:il_ind-1)7673 cl_factor=cl_int(1:il_ind-1) 7014 7674 ENDIF 7015 7675 il_mul=SCAN(TRIM(cl_factor),'*') … … 7052 7712 ENDIF 7053 7713 ENDDO 7054 IF( jj /= ip_ninterp + 1 ) EXIT 7055 ji=ji+1 7056 cl_tmp=fct_split(cd_varinfo,ji,';') 7057 ENDDO 7714 ENDIF 7058 7715 7059 7716 END FUNCTION var__get_interp … … 7064 7721 !> 7065 7722 !> @details 7066 !> split namelist information, using ';' as separator. 7723 !> extrapolation method is assume to follow string "ext =" 7724 !> 7067 7725 !> compare method name with the list of extrapolation method available (see 7068 7726 !> module global).<br/> 7069 7727 !> Example:<br/> 7070 !> - cubic ;dist_weight7071 !> - min_error7728 !> - int=cubic ; ext=dist_weight 7729 !> - ext=min_error 7072 7730 !> see @ref extrap module for more information. 7073 7731 !> 7074 7732 !> @author J.Paul 7075 !> - November, 2013- Initial Version 7733 !> - November, 2013 - Initial Version 7734 !> @date June, 2015 - change way to get information in namelist, 7735 !> value follows string "ext =" 7076 7736 ! 7077 7737 !> @param[in] cd_name variable name … … 7090 7750 ! local variable 7091 7751 CHARACTER(LEN=lc) :: cl_tmp 7752 CHARACTER(LEN=lc) :: cl_ext 7753 7754 INTEGER(i4) :: il_ind 7092 7755 7093 7756 ! loop indices … … 7101 7764 cl_tmp=fct_split(cd_varinfo,ji,';') 7102 7765 DO WHILE( TRIM(cl_tmp) /= '' ) 7766 il_ind=INDEX(TRIM(cl_tmp),'ext') 7767 IF( il_ind /= 0 )THEN 7768 cl_ext=fct_split(cl_tmp,2,'=') 7769 EXIT 7770 ENDIF 7771 ji=ji+1 7772 cl_tmp=fct_split(cd_varinfo,ji,';') 7773 ENDDO 7774 7775 IF( TRIM(cl_ext) /= '' )THEN 7103 7776 DO jj=1,ip_nextrap 7104 IF( TRIM(fct_lower(cl_ tmp)) == TRIM(cp_extrap_list(jj)) )THEN7777 IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN 7105 7778 var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 7106 7779 … … 7111 7784 ENDIF 7112 7785 ENDDO 7113 IF( jj /= ip_nextrap + 1 ) EXIT 7114 ji=ji+1 7115 cl_tmp=fct_split(cd_varinfo,ji,';') 7116 ENDDO 7786 ENDIF 7117 7787 7118 7788 … … 7124 7794 !> 7125 7795 !> @details 7126 !> split namelist information, using ';' as separator. 7796 !> filter method is assume to follow string "flt =" 7797 !> 7127 7798 !> compare method name with the list of filter method available (see 7128 7799 !> module global). 7129 !> look for the number of turn, using '*' separator, and method parameters inside7800 !> look for the number of run, using '*' separator, and method parameters inside 7130 7801 !> bracket.<br/> 7131 7802 !> Example:<br/> 7132 !> - cubic ;2*hamming(2,3)7133 !> - hann7803 !> - int=cubic ; flt=2*hamming(2,3) 7804 !> - flt=hann 7134 7805 !> see @ref filter module for more information. 7135 7806 !> 7136 7807 !> @author J.Paul 7137 !> - November, 2013- Initial Version 7138 ! 7808 !> - November, 2013 - Initial Version 7809 !> @date June, 2015 - change way to get information in namelist, 7810 !> value follows string "flt =" 7811 !> 7139 7812 !> @param[in] cd_name variable name 7140 7813 !> @param[in] cd_varinfo variable information read in namelist … … 7151 7824 ! local variable 7152 7825 CHARACTER(LEN=lc) :: cl_tmp 7826 CHARACTER(LEN=lc) :: cl_flt 7153 7827 INTEGER(i4) :: il_ind 7154 7828 … … 7163 7837 cl_tmp=fct_split(cd_varinfo,ji,';') 7164 7838 DO WHILE( TRIM(cl_tmp) /= '' ) 7839 il_ind=INDEX(TRIM(cl_tmp),'flt') 7840 IF( il_ind /= 0 )THEN 7841 cl_flt=fct_split(cl_tmp,2,'=') 7842 EXIT 7843 ENDIF 7844 ji=ji+1 7845 cl_tmp=fct_split(cd_varinfo,ji,';') 7846 ENDDO 7847 7848 IF( TRIM(cl_flt) /= '' )THEN 7165 7849 DO jj=1,ip_nfilter 7166 il_ind=INDEX(fct_lower(cl_ tmp),TRIM(cp_filter_list(jj)))7850 il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj))) 7167 7851 IF( il_ind /= 0 )THEN 7168 7852 var__get_filter(1)=TRIM(cp_filter_list(jj)) 7169 7853 7170 ! look for number of turn7171 il_ind=SCAN(fct_lower(cl_ tmp),'*')7854 ! look for number of run 7855 il_ind=SCAN(fct_lower(cl_flt),'*') 7172 7856 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:))7857 IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN 7858 var__get_filter(2)=TRIM(cl_flt(1:il_ind-1)) 7859 ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN 7860 var__get_filter(2)=TRIM(cl_flt(il_ind+1:)) 7177 7861 ELSE 7178 7862 var__get_filter(2)='1' … … 7183 7867 7184 7868 ! look for filter parameter 7185 il_ind=SCAN(fct_lower(cl_ tmp),'(')7869 il_ind=SCAN(fct_lower(cl_flt),'(') 7186 7870 IF( il_ind /=0 )THEN 7187 cl_ tmp=TRIM(cl_tmp(il_ind+1:))7188 il_ind=SCAN(fct_lower(cl_ tmp),')')7871 cl_flt=TRIM(cl_flt(il_ind+1:)) 7872 il_ind=SCAN(fct_lower(cl_flt),')') 7189 7873 IF( il_ind /=0 )THEN 7190 cl_ tmp=TRIM(cl_tmp(1:il_ind-1))7874 cl_flt=TRIM(cl_flt(1:il_ind-1)) 7191 7875 ! look for cut-off frequency 7192 var__get_filter(3)=fct_split(cl_ tmp,1,',')7876 var__get_filter(3)=fct_split(cl_flt,1,',') 7193 7877 ! look for halo size 7194 var__get_filter(4)=fct_split(cl_ tmp,2,',')7878 var__get_filter(4)=fct_split(cl_flt,2,',') 7195 7879 ! look for alpha parameter 7196 var__get_filter(5)=fct_split(cl_ tmp,3,',')7880 var__get_filter(5)=fct_split(cl_flt,3,',') 7197 7881 ELSE 7198 7882 CALL logger_error("VAR GET FILTER: variable "//& … … 7215 7899 ENDIF 7216 7900 ENDDO 7217 IF( jj /= ip_nfilter + 1 ) EXIT 7901 ENDIF 7902 7903 END FUNCTION var__get_filter 7904 !------------------------------------------------------------------- 7905 !> @brief 7906 !> This function check if variable information read in namelist contains 7907 !> unit and return it if true. 7908 !> 7909 !> @details 7910 !> unit is assume to follow string "unt =" 7911 !> 7912 !> @author J.Paul 7913 !> - June, 2015- Initial Version 7914 ! 7915 !> @param[in] cd_name variable name 7916 !> @param[in] cd_varinfo variable information read in namelist 7917 !> @return unit string character 7918 !------------------------------------------------------------------- 7919 FUNCTION var__get_unt( cd_name, cd_varinfo ) 7920 IMPLICIT NONE 7921 ! Argument 7922 CHARACTER(LEN=*), INTENT(IN ) :: cd_name 7923 CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo 7924 7925 ! function 7926 CHARACTER(LEN=lc) :: var__get_unt 7927 7928 ! local variable 7929 CHARACTER(LEN=lc) :: cl_tmp 7930 7931 INTEGER(i4) :: il_ind 7932 7933 ! loop indices 7934 INTEGER(i4) :: ji 7935 !---------------------------------------------------------------- 7936 7937 var__get_unt='' 7938 7939 ji=1 7940 cl_tmp=fct_split(cd_varinfo,ji,';') 7941 DO WHILE( TRIM(cl_tmp) /= '' ) 7942 il_ind=INDEX(TRIM(cl_tmp),'unt') 7943 IF( il_ind /= 0 )THEN 7944 var__get_unt=fct_split(cl_tmp,2,'=') 7945 EXIT 7946 ENDIF 7218 7947 ji=ji+1 7219 7948 cl_tmp=fct_split(cd_varinfo,ji,';') 7220 7949 ENDDO 7221 7950 7222 END FUNCTION var__get_filter 7951 IF( TRIM(var__get_unt) /= '' )THEN 7952 CALL logger_debug("VAR GET UNIT: will use units "//& 7953 & TRIM(var__get_unt)//" for variable "//& 7954 & TRIM(cd_name) ) 7955 ENDIF 7956 7957 END FUNCTION var__get_unt 7223 7958 !------------------------------------------------------------------- 7224 7959 !> @brief … … 7319 8054 7320 8055 END SUBROUTINE var_limit_value 8056 !------------------------------------------------------------------- 8057 !> @brief 8058 !> This subroutine replace unit name of the variable, 8059 !> and apply unit factor to the value of this variable. 8060 !> 8061 !> @details 8062 !> new unit name (unt) and unit factor (unf) are read from the namelist. 8063 !> 8064 !> @note the variable value should be already read. 8065 !> 8066 !> @author J.Paul 8067 !> - June, 2015- Initial Version 8068 ! 8069 !> @param[inout] td_var variable structure 8070 !------------------------------------------------------------------- 8071 SUBROUTINE var_chg_unit( td_var ) 8072 IMPLICIT NONE 8073 ! Argument 8074 TYPE(TVAR), INTENT(INOUT) :: td_var 8075 8076 ! local variable 8077 TYPE(TATT) :: tl_att 8078 8079 ! loop indices 8080 !---------------------------------------------------------------- 8081 8082 IF( ASSOCIATED(td_var%d_value) )THEN 8083 !- change value 8084 IF( td_var%d_unf /= 1._dp )THEN 8085 WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 8086 td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf 8087 END WHERE 8088 8089 !- change scale factor and offset to avoid mistake 8090 tl_att=att_init('scale_factor',1) 8091 CALL var_move_att(td_var, tl_att) 8092 8093 tl_att=att_init('add_offset',0) 8094 CALL var_move_att(td_var, tl_att) 8095 ENDIF 8096 8097 !- change unit name 8098 IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. & 8099 & TRIM(td_var%c_unt) /= '' )THEN 8100 tl_att=att_init('units',TRIM(td_var%c_unt)) 8101 CALL var_move_att(td_var,tl_att) 8102 ENDIF 8103 8104 ENDIF 8105 8106 END SUBROUTINE var_chg_unit 7321 8107 !------------------------------------------------------------------- 7322 8108 !> @brief … … 7414 8200 !> 7415 8201 !> @author J.Paul 7416 !> - August, 2014- Initial Version 8202 !> - August, 2014 - Initial Version 8203 !> @date July 2015 - do not use dim_disorder anymore 7417 8204 ! 7418 8205 !> @param[inout] td_var variable structure … … 7438 8225 IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 7439 8226 8227 CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//& 8228 & " new dimension order "//TRIM(cl_dimorder)) 8229 7440 8230 tl_dim(:)=dim_copy(td_var%t_dim(:)) 7441 8231 7442 CALL dim_unorder(tl_dim(:))7443 8232 CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 7444 8233
Note: See TracChangeset
for help on using the changeset viewer.
