Changeset 6625 for branches/UKMO/dev_r5518_v3.4_asm_nemovar_community/NEMOGCM/TOOLS/SIREN/src/variable.f90
- Timestamp:
- 2016-05-26T11:08:07+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_v3.4_asm_nemovar_community/NEMOGCM/TOOLS/SIREN/src/variable.f90
r6617 r6625 281 281 !> @date November, 2014 282 282 !> - Fix memory leaks bug 283 !> @date June, 2015284 !> - change way to get variable information in namelist285 !> @date July, 2015286 !> - add subroutine var_chg_unit to change unit of output variable287 !> @date Spetember, 2015288 !> - manage useless (dummy) variable289 283 ! 290 284 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 299 293 USE att ! attribute manager 300 294 USE dim ! dimension manager 301 USE math ! mathematical function302 295 IMPLICIT NONE 303 296 ! NOTE_avoid_public_variables_if_possible … … 307 300 308 301 PUBLIC :: tg_varextra !< array of variable structure with extra information. 309 310 PRIVATE :: cm_dumvar !< dummy variable array311 302 312 303 ! function and subroutine … … 327 318 PUBLIC :: var_concat !< concatenate two variables 328 319 PUBLIC :: var_limit_value !< forced min and max value 329 PUBLIC :: var_chg_unit !< change variable unit and value330 320 PUBLIC :: var_max_dim !< get array of maximum dimension use 331 321 PUBLIC :: var_reorder !< reorder table of value in variable structure … … 338 328 PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information. 339 329 PUBLIC :: var_check_dim !< check variable dimension expected 340 PUBLIC :: var_get_dummy !< fill dummy variable array341 PUBLIC :: var_is_dummy !< check if variable is defined as dummy variable342 330 343 331 PRIVATE :: var__init ! initialize variable structure without array of value … … 394 382 PRIVATE :: var__get_max ! get maximum value from namelist 395 383 PRIVATE :: var__get_min ! get minimum value from namelist 396 PRIVATE :: var__get_unf ! get scale factor value from namelist397 PRIVATE :: var__get_unt ! get unit from namelist398 384 PRIVATE :: var__get_interp ! get interpolation method from namelist 399 385 PRIVATE :: var__get_extrap ! get extrapolation method from namelist … … 415 401 TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes 416 402 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< variable dimension 417 403 418 404 LOGICAL :: l_file = .FALSE. !< variable read in a file 419 405 … … 428 414 REAL(dp) :: d_min = dp_fill !< minimum value 429 415 REAL(dp) :: d_max = dp_fill !< maximum value 430 431 CHARACTER(LEN=lc) :: c_unt = '' !< new variables units (linked to units factor) 432 REAL(dp) :: d_unf = 1._dp !< units factor 433 416 434 417 !!! netcdf4 435 418 LOGICAL :: l_contiguous = .FALSE. !< use contiguous storage or not … … 450 433 TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< array of variable structure with extra information. 451 434 !< fill when running var_def_extra() 452 453 CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumvar !< dummy variable454 435 455 436 INTERFACE var_init … … 537 518 !> 538 519 !> @author J.Paul 539 !> @date November, 2013- Initial Version520 !> - November, 2013- Initial Version 540 521 !> @date November, 2014 541 522 !> - use function instead of overload assignment operator (to avoid memory leak) … … 567 548 var__copy_unit%d_min = td_var%d_min 568 549 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_unf572 550 573 551 var__copy_unit%i_type = td_var%i_type … … 599 577 var__copy_unit%c_units = TRIM(td_var%c_units) 600 578 var__copy_unit%c_axis = TRIM(td_var%c_axis) 601 var__copy_unit%d_unf = td_var%d_unf602 579 var__copy_unit%d_scf = td_var%d_scf 603 580 var__copy_unit%d_ofs = td_var%d_ofs … … 650 627 !> 651 628 !> @author J.Paul 652 !> @date November, 2013- Initial Version629 !> - November, 2013- Initial Version 653 630 !> @date November, 2014 654 631 !> - use function instead of overload assignment operator … … 679 656 !> 680 657 !> @author J.Paul 681 !> @date November, 2013- Initial Version658 !> - November, 2013- Initial Version 682 659 !> 683 660 !> @param[inout] td_var variable strucutre … … 718 695 ! 719 696 !> @author J.Paul 720 !> @date September, 2014- Initial Version697 !> - September, 2014- Initial Version 721 698 ! 722 699 !> @param[inout] td_var array of variable strucutre … … 741 718 ! 742 719 !> @author J.Paul 743 !> @date September, 2014- Initial Version720 !> - September, 2014- Initial Version 744 721 ! 745 722 !> @param[inout] td_var array of variable strucutre … … 767 744 ! 768 745 !> @author J.Paul 769 !> @date September, 2014- Initial Version746 !> - September, 2014- Initial Version 770 747 ! 771 748 !> @param[inout] td_var array of variable strucutre … … 811 788 !> - id_id : variable id (read from a file). 812 789 !> - id_ew : number of point composing east west wrap band. 813 !> - dd_unf : real(8) value for units factor attribute.814 790 !> - dd_scf : real(8) value for scale factor attribute. 815 791 !> - dd_ofs : real(8) value for add offset attribute. … … 825 801 !> - cd_extrap : a array of character defining extrapolation method. 826 802 !> - cd_filter : a array of character defining filtering method. 827 !> - cd_unt : a string character to define output unit828 !> - dd_unf : real(8) factor applied to change unit829 803 !> 830 804 !> @note most of these optionals arguments will be inform automatically, … … 832 806 !> 833 807 !> @author J.Paul 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) 808 !> - November, 2013- Initial Version 839 809 !> 840 810 !> @param[in] cd_name variable name … … 863 833 !> @param[in] cd_extrap extrapolation method 864 834 !> @param[in] cd_filter filter method 865 !> @param[in] cd_unt new units (linked to units factor)866 !> @param[in] dd_unf units factor867 835 !> @return variable structure 868 836 !------------------------------------------------------------------- … … 875 843 & ld_contiguous, ld_shuffle,& 876 844 & ld_fletcher32, id_deflvl, id_chunksz, & 877 & cd_interp, cd_extrap, cd_filter, & 878 & cd_unt, dd_unf ) 845 & cd_interp, cd_extrap, cd_filter ) 879 846 IMPLICIT NONE 880 847 ! Argument … … 904 871 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap 905 872 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter 906 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt907 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf908 873 909 874 … … 968 933 tl_att=att_init('_FillValue', INT(dd_fill,i4) ) 969 934 CASE(NF90_FLOAT) 970 tl_att=att_init('_FillValue', REAL(dd_fill,sp) )935 tl_att=att_init('_FillValue', INT(dd_fill,sp) ) 971 936 CASE DEFAULT ! NF90_DOUBLE 972 tl_att=att_init('_FillValue', dd_fill )937 tl_att=att_init('_FillValue', dd_fill ) 973 938 END SELECT 974 939 CALL var_move_att(var__init, tl_att) … … 1073 1038 ENDIF 1074 1039 1075 ! units factor1076 IF( PRESENT(dd_unf) )THEN1077 tl_att=att_init('units_factor',dd_unf)1078 CALL var_move_att(var__init, tl_att)1079 ENDIF1080 1081 ! new units (linked to units factor)1082 IF( PRESENT(cd_unt) )THEN1083 tl_att=att_init('new_units',cd_units)1084 CALL var_move_att(var__init, tl_att)1085 ENDIF1086 1087 1040 ! add extra information 1088 1041 CALL var__get_extra(var__init) … … 1094 1047 CALL var_del_att(var__init, 'filter') 1095 1048 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')1098 1049 CALL var_del_att(var__init, 'valid_min') 1099 1050 CALL var_del_att(var__init, 'valid_max') … … 1121 1072 ! 1122 1073 !> @author J.Paul 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 !> 1074 !> - November, 2013- Initial Version 1075 ! 1129 1076 !> @param[in] cd_name variable name 1130 1077 !> @param[in] dd_value 1D array of real(8) value … … 1153 1100 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 1154 1101 !> @param[in] id_chunksz chunk size 1155 !> @param[in] cd_interp interpolation method1156 !> @param[in] cd_extrap extrapolation method1157 !> @param[in] cd_filter filter method1158 !> @param[in] cd_unt new units (linked to units factor)1159 !> @param[in] dd_unf units factor1160 1102 !> @return variable structure 1161 1103 !------------------------------------------------------------------- … … 1168 1110 & dd_min, dd_max, & 1169 1111 & ld_contiguous, ld_shuffle,& 1170 & ld_fletcher32, id_deflvl, id_chunksz, & 1171 & cd_interp, cd_extrap, cd_filter, & 1172 & cd_unt, dd_unf) 1112 & ld_fletcher32, id_deflvl, id_chunksz) 1173 1113 IMPLICIT NONE 1174 1114 ! Argument … … 1198 1138 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1199 1139 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1200 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp1201 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap1202 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter1203 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt1204 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf1205 1140 1206 1141 ! local variable … … 1258 1193 & ld_fletcher32=ld_fletcher32, & 1259 1194 & id_deflvl=id_deflvl, & 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 ) 1195 & id_chunksz=id_chunksz(:)) 1265 1196 1266 1197 ! add value … … 1308 1239 ! 1309 1240 !> @author J.Paul 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) 1241 !> - November, 2013- Initial Version 1319 1242 ! 1320 1243 !> @param[in] cd_name variable name … … 1346 1269 !> no deflation is in use 1347 1270 !> @param[in] id_chunksz chunk size 1348 !> @param[in] cd_interp interpolation method1349 !> @param[in] cd_extrap extrapolation method1350 !> @param[in] cd_filter filter method1351 !> @param[in] cd_unt new units (linked to units factor)1352 !> @param[in] dd_unf units factor1353 1271 !> @return variable structure 1354 1272 !------------------------------------------------------------------- … … 1361 1279 & dd_min, dd_max, & 1362 1280 & ld_contiguous, ld_shuffle,& 1363 & ld_fletcher32, id_deflvl, id_chunksz, & 1364 & cd_interp, cd_extrap, cd_filter, & 1365 & cd_unt, dd_unf) 1281 & ld_fletcher32, id_deflvl, id_chunksz) 1366 1282 IMPLICIT NONE 1367 1283 ! Argument … … 1391 1307 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1392 1308 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1393 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp1394 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap1395 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter1396 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt1397 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf1398 1309 1399 1310 ! local variable … … 1439 1350 ENDIF 1440 1351 1441 il_count(:)=tl_dim( :)%i_len1352 il_count(:)=tl_dim(1)%i_len 1442 1353 IF( PRESENT(id_count) )THEN 1443 1354 IF( SIZE(id_count(:)) /= 2 )THEN … … 1470 1381 & ld_fletcher32=ld_fletcher32, & 1471 1382 & id_deflvl=id_deflvl, & 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 ) 1383 & id_chunksz=id_chunksz(:)) 1477 1384 1478 1385 ! add value … … 1524 1431 ! 1525 1432 !> @author J.Paul 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 !> 1433 !> - November, 2013- Initial Version 1434 ! 1532 1435 !> @param[in] cd_name variable name 1533 1436 !> @param[in] dd_value 1D array of real(8) value … … 1558 1461 !> deflation is in use 1559 1462 !> @param[in] id_chunksz chunk size 1560 !> @param[in] cd_interp interpolation method1561 !> @param[in] cd_extrap extrapolation method1562 !> @param[in] cd_filter filter method1563 !> @param[in] cd_unt new units (linked to units factor)1564 !> @param[in] dd_unf units factor1565 1463 !> @return variable structure 1566 1464 !------------------------------------------------------------------- … … 1573 1471 & dd_min, dd_max, & 1574 1472 & ld_contiguous, ld_shuffle,& 1575 & ld_fletcher32, id_deflvl, id_chunksz, & 1576 & cd_interp, cd_extrap, cd_filter, & 1577 & cd_unt, dd_unf) 1473 & ld_fletcher32, id_deflvl, id_chunksz) 1578 1474 IMPLICIT NONE 1579 1475 ! Argument … … 1603 1499 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1604 1500 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1605 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp1606 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap1607 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter1608 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt1609 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf1610 1501 1611 1502 ! local variable … … 1686 1577 & ld_fletcher32=ld_fletcher32, & 1687 1578 & id_deflvl=id_deflvl, & 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 ) 1579 & id_chunksz=id_chunksz(:)) 1693 1580 1694 1581 ! add value … … 1736 1623 ! 1737 1624 !> @author J.Paul 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 !> 1625 !> - November, 2013- Initial Version 1626 ! 1744 1627 !> @param[in] cd_name variable name 1745 1628 !> @param[in] dd_value 4D array of real(8) value … … 1770 1653 !> deflation is in use 1771 1654 !> @param[in] id_chunksz chunk size 1772 !> @param[in] cd_interp interpolation method1773 !> @param[in] cd_extrap extrapolation method1774 !> @param[in] cd_filter filter method1775 !> @param[in] cd_unt new units (linked to units factor)1776 !> @param[in] dd_unf units factor1777 1655 !> @return variable structure 1778 1656 !------------------------------------------------------------------- … … 1785 1663 & dd_min, dd_max, & 1786 1664 & ld_contiguous, ld_shuffle,& 1787 & ld_fletcher32, id_deflvl, id_chunksz, & 1788 & cd_interp, cd_extrap, cd_filter, & 1789 & cd_unt, dd_unf ) 1665 & ld_fletcher32, id_deflvl, id_chunksz) 1790 1666 IMPLICIT NONE 1791 1667 ! Argument … … 1815 1691 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1816 1692 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1817 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp1818 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap1819 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter1820 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt1821 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf1822 1693 1823 1694 ! local variable … … 1852 1723 & ld_fletcher32=ld_fletcher32, & 1853 1724 & id_deflvl=id_deflvl, & 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 ) 1725 & id_chunksz=id_chunksz(:)) 1859 1726 1860 1727 ! add value … … 1891 1758 ! 1892 1759 !> @author J.Paul 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) 1760 !> - November, 2013- Initial Version 1898 1761 ! 1899 1762 !> @param[in] cd_name variable name … … 1925 1788 !> deflation is in use 1926 1789 !> @param[in] id_chunksz chunk size 1927 !> @param[in] cd_interp interpolation method1928 !> @param[in] cd_extrap extrapolation method1929 !> @param[in] cd_filter filter method1930 !> @param[in] cd_unt new units (linked to units factor)1931 !> @param[in] dd_unf units factor1932 1790 !> @return variable structure 1933 1791 !------------------------------------------------------------------- … … 1940 1798 & dd_min, dd_max, & 1941 1799 & ld_contiguous, ld_shuffle,& 1942 & ld_fletcher32, id_deflvl, id_chunksz, & 1943 & cd_interp, cd_extrap, cd_filter, & 1944 & cd_unt, dd_unf) 1800 & ld_fletcher32, id_deflvl, id_chunksz) 1945 1801 1946 1802 IMPLICIT NONE … … 1971 1827 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 1972 1828 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 1973 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp1974 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap1975 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter1976 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt1977 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf1978 1979 1829 1980 1830 ! local variable … … 2020 1870 & ld_fletcher32=ld_fletcher32, & 2021 1871 & id_deflvl=id_deflvl, & 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 ) 1872 & id_chunksz=id_chunksz(:)) 2027 1873 2028 1874 DEALLOCATE( dl_value ) … … 2046 1892 ! 2047 1893 !> @author J.Paul 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) 1894 !> - November, 2013- Initial Version 2053 1895 ! 2054 1896 !> @param[in] cd_name : variable name … … 2080 1922 !> deflation is in use 2081 1923 !> @param[in] id_chunksz : chunk size 2082 !> @param[in] cd_interp interpolation method2083 !> @param[in] cd_extrap extrapolation method2084 !> @param[in] cd_filter filter method2085 !> @param[in] cd_unt new units (linked to units factor)2086 !> @param[in] dd_unf units factor2087 1924 !> @return variable structure 2088 1925 !------------------------------------------------------------------- … … 2095 1932 & dd_min, dd_max, & 2096 1933 & ld_contiguous, ld_shuffle,& 2097 & ld_fletcher32, id_deflvl, id_chunksz, & 2098 & cd_interp, cd_extrap, cd_filter, & 2099 & cd_unt, dd_unf) 1934 & ld_fletcher32, id_deflvl, id_chunksz) 2100 1935 2101 1936 IMPLICIT NONE … … 2126 1961 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2127 1962 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2128 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp2129 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap2130 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter2131 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt2132 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf2133 1963 2134 1964 ! local variable … … 2176 2006 & ld_fletcher32=ld_fletcher32, & 2177 2007 & id_deflvl=id_deflvl, & 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 ) 2008 & id_chunksz=id_chunksz(:)) 2183 2009 2184 2010 DEALLOCATE( dl_value ) … … 2202 2028 ! 2203 2029 !> @author J.Paul 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) 2030 !> - November, 2013- Initial Version 2209 2031 ! 2210 2032 !> @param[in] cd_name : variable name … … 2236 2058 !> deflation is in use 2237 2059 !> @param[in] id_chunksz : chunk size 2238 !> @param[in] cd_interp interpolation method2239 !> @param[in] cd_extrap extrapolation method2240 !> @param[in] cd_filter filter method2241 !> @param[in] cd_unt new units (linked to units factor)2242 !> @param[in] dd_unf units factor2243 2060 !> @return variable structure 2244 2061 !------------------------------------------------------------------- … … 2251 2068 & dd_min, dd_max, & 2252 2069 & ld_contiguous, ld_shuffle,& 2253 & ld_fletcher32, id_deflvl, id_chunksz, & 2254 & cd_interp, cd_extrap, cd_filter, & 2255 & cd_unt, dd_unf) 2070 & ld_fletcher32, id_deflvl, id_chunksz) 2256 2071 2257 2072 IMPLICIT NONE … … 2282 2097 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2283 2098 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2284 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp2285 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap2286 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter2287 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt2288 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf2289 2099 2290 2100 ! local variable … … 2333 2143 & ld_fletcher32=ld_fletcher32, & 2334 2144 & id_deflvl=id_deflvl, & 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) 2145 & id_chunksz=id_chunksz(:)) 2340 2146 2341 2147 DEALLOCATE( dl_value ) … … 2359 2165 ! 2360 2166 !> @author J.Paul 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) 2167 !> - November, 2013- Initial Version 2366 2168 ! 2367 2169 !> @param[in] cd_name variable name … … 2393 2195 !> deflation is in use 2394 2196 !> @param[in] id_chunksz chunk size 2395 !> @param[in] cd_interp interpolation method2396 !> @param[in] cd_extrap extrapolation method2397 !> @param[in] cd_filter filter method2398 !> @param[in] cd_unt new units (linked to units factor)2399 !> @param[in] dd_unf units factor2400 2197 !> @return variable structure 2401 2198 !------------------------------------------------------------------- … … 2408 2205 & dd_min, dd_max, & 2409 2206 & ld_contiguous, ld_shuffle,& 2410 & ld_fletcher32, id_deflvl, id_chunksz, & 2411 & cd_interp, cd_extrap, cd_filter, & 2412 & cd_unt, dd_unf) 2207 & ld_fletcher32, id_deflvl, id_chunksz) 2413 2208 2414 2209 IMPLICIT NONE … … 2439 2234 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2440 2235 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2441 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp2442 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap2443 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter2444 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt2445 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf2446 2236 2447 2237 ! local variable … … 2491 2281 & ld_fletcher32=ld_fletcher32, & 2492 2282 & id_deflvl=id_deflvl, & 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) 2283 & id_chunksz=id_chunksz(:)) 2498 2284 2499 2285 DEALLOCATE( dl_value ) … … 2517 2303 ! 2518 2304 !> @author J.Paul 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) 2305 !> - November, 2013- Initial Version 2524 2306 ! 2525 2307 !> @param[in] cd_name : variable name … … 2551 2333 !> deflation is in use 2552 2334 !> @param[in] id_chunksz : chunk size 2553 !> @param[in] cd_interp interpolation method2554 !> @param[in] cd_extrap extrapolation method2555 !> @param[in] cd_filter filter method2556 !> @param[in] cd_unt new units (linked to units factor)2557 !> @param[in] dd_unf units factor2558 2335 !> @return variable structure 2559 2336 !------------------------------------------------------------------- … … 2566 2343 & dd_min, dd_max, & 2567 2344 & ld_contiguous, ld_shuffle,& 2568 & ld_fletcher32, id_deflvl, id_chunksz, & 2569 & cd_interp, cd_extrap, cd_filter, & 2570 & cd_unt, dd_unf) 2345 & ld_fletcher32, id_deflvl, id_chunksz) 2571 2346 2572 2347 IMPLICIT NONE … … 2597 2372 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2598 2373 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2599 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp2600 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap2601 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter2602 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt2603 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf2604 2374 2605 2375 ! local variable … … 2645 2415 & ld_fletcher32=ld_fletcher32, & 2646 2416 & id_deflvl=id_deflvl, & 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) 2417 & id_chunksz=id_chunksz(:)) 2652 2418 2653 2419 DEALLOCATE( dl_value ) … … 2671 2437 ! 2672 2438 !> @author J.Paul 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) 2439 !> - November, 2013- Initial Version 2678 2440 ! 2679 2441 !> @param[in] cd_name variable name … … 2703 2465 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 2704 2466 !> @param[in] id_chunksz chunk size 2705 !> @param[in] cd_interp interpolation method2706 !> @param[in] cd_extrap extrapolation method2707 !> @param[in] cd_filter filter method2708 !> @param[in] cd_unt new units (linked to units factor)2709 !> @param[in] dd_unf units factor2710 2467 !> @return variable structure 2711 2468 !------------------------------------------------------------------- … … 2718 2475 & dd_min, dd_max, & 2719 2476 & ld_contiguous, ld_shuffle,& 2720 & ld_fletcher32, id_deflvl, id_chunksz, & 2721 & cd_interp, cd_extrap, cd_filter, & 2722 & cd_unt, dd_unf) 2477 & ld_fletcher32, id_deflvl, id_chunksz) 2723 2478 2724 2479 IMPLICIT NONE … … 2749 2504 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2750 2505 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2751 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp2752 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap2753 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter2754 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt2755 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf2756 2506 2757 2507 ! local variable … … 2799 2549 & ld_fletcher32=ld_fletcher32, & 2800 2550 & id_deflvl=id_deflvl, & 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) 2551 & id_chunksz=id_chunksz(:)) 2806 2552 2807 2553 DEALLOCATE( dl_value ) … … 2825 2571 ! 2826 2572 !> @author J.Paul 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) 2573 !> - November, 2013- Initial Version 2832 2574 ! 2833 2575 !> @param[in] cd_name variable name … … 2859 2601 !> deflation is in use 2860 2602 !> @param[in] id_chunksz chunk size 2861 !> @param[in] cd_interp interpolation method2862 !> @param[in] cd_extrap extrapolation method2863 !> @param[in] cd_filter filter method2864 !> @param[in] cd_unt new units (linked to units factor)2865 !> @param[in] dd_unf units factor2866 2603 !> @return variable structure 2867 2604 !------------------------------------------------------------------- … … 2874 2611 & dd_min, dd_max, & 2875 2612 & ld_contiguous, ld_shuffle,& 2876 & ld_fletcher32, id_deflvl, id_chunksz, & 2877 & cd_interp, cd_extrap, cd_filter, & 2878 & cd_unt, dd_unf) 2613 & ld_fletcher32, id_deflvl, id_chunksz) 2879 2614 2880 2615 IMPLICIT NONE … … 2905 2640 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 2906 2641 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 2907 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp2908 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap2909 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter2910 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt2911 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf2912 2642 2913 2643 ! local variable … … 2956 2686 & ld_fletcher32=ld_fletcher32, & 2957 2687 & id_deflvl=id_deflvl, & 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) 2688 & id_chunksz=id_chunksz(:)) 2963 2689 2964 2690 DEALLOCATE( dl_value ) … … 2982 2708 ! 2983 2709 !> @author J.Paul 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) 2710 !> - November, 2013- Initial Version 2989 2711 ! 2990 2712 !> @param[in] cd_name variable name … … 3016 2738 !> deflation is in use 3017 2739 !> @param[in] id_chunksz chunk size 3018 !> @param[in] cd_interp interpolation method3019 !> @param[in] cd_extrap extrapolation method3020 !> @param[in] cd_filter filter method3021 !> @param[in] cd_unt new units (linked to units factor)3022 !> @param[in] dd_unf units factor3023 2740 !> @return variable structure 3024 2741 !------------------------------------------------------------------- … … 3031 2748 & dd_min, dd_max, & 3032 2749 & ld_contiguous, ld_shuffle,& 3033 & ld_fletcher32, id_deflvl, id_chunksz, & 3034 & cd_interp, cd_extrap, cd_filter, & 3035 & cd_unt, dd_unf) 2750 & ld_fletcher32, id_deflvl, id_chunksz) 3036 2751 3037 2752 IMPLICIT NONE … … 3062 2777 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3063 2778 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3064 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp3065 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap3066 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter3067 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt3068 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf3069 3070 2779 3071 2780 ! local variable … … 3115 2824 & ld_fletcher32=ld_fletcher32, & 3116 2825 & id_deflvl=id_deflvl, & 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) 2826 & id_chunksz=id_chunksz(:)) 3122 2827 3123 2828 DEALLOCATE( dl_value ) … … 3141 2846 ! 3142 2847 !> @author J.Paul 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) 2848 !> - November, 2013- Initial Version 3148 2849 ! 3149 2850 !> @param[in] cd_name variable name … … 3175 2876 !> deflation is in use 3176 2877 !> @param[in] id_chunksz chunk size 3177 !> @param[in] cd_interp interpolation method3178 !> @param[in] cd_extrap extrapolation method3179 !> @param[in] cd_filter filter method3180 !> @param[in] cd_unt new units (linked to units factor)3181 !> @param[in] dd_unf units factor3182 2878 !> @return variable structure 3183 2879 !------------------------------------------------------------------- … … 3190 2886 & dd_min, dd_max, & 3191 2887 & ld_contiguous, ld_shuffle,& 3192 & ld_fletcher32, id_deflvl, id_chunksz, & 3193 & cd_interp, cd_extrap, cd_filter, & 3194 & cd_unt, dd_unf) 2888 & ld_fletcher32, id_deflvl, id_chunksz) 3195 2889 3196 2890 IMPLICIT NONE … … 3221 2915 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3222 2916 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3223 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp3224 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap3225 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter3226 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt3227 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf3228 2917 3229 2918 ! local variable … … 3269 2958 & ld_fletcher32=ld_fletcher32, & 3270 2959 & id_deflvl=id_deflvl, & 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) 2960 & id_chunksz=id_chunksz(:)) 3276 2961 3277 2962 DEALLOCATE( dl_value ) … … 3295 2980 ! 3296 2981 !> @author J.Paul 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) 2982 !> - November, 2013- Initial Version 3302 2983 ! 3303 2984 !> @param[in] cd_name variable name … … 3329 3010 !> deflation is in use 3330 3011 !> @param[in] id_chunksz chunk size 3331 !> @param[in] cd_interp interpolation method3332 !> @param[in] cd_extrap extrapolation method3333 !> @param[in] cd_filter filter method3334 !> @param[in] cd_unt new units (linked to units factor)3335 !> @param[in] dd_unf units factor3336 3012 !> @return variable structure 3337 3013 !------------------------------------------------------------------- … … 3344 3020 & dd_min, dd_max, & 3345 3021 & ld_contiguous, ld_shuffle,& 3346 & ld_fletcher32, id_deflvl, id_chunksz, & 3347 & cd_interp, cd_extrap, cd_filter, & 3348 & cd_unt, dd_unf) 3022 & ld_fletcher32, id_deflvl, id_chunksz) 3349 3023 3350 3024 IMPLICIT NONE … … 3375 3049 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3376 3050 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3377 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp3378 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap3379 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter3380 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt3381 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf3382 3051 3383 3052 ! local variable … … 3425 3094 & ld_fletcher32=ld_fletcher32, & 3426 3095 & id_deflvl=id_deflvl, & 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) 3096 & id_chunksz=id_chunksz(:)) 3432 3097 3433 3098 DEALLOCATE( dl_value ) … … 3451 3116 ! 3452 3117 !> @author J.Paul 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) 3118 !> - November, 2013- Initial Version 3458 3119 ! 3459 3120 !> @param[in] cd_name variable name … … 3485 3146 !> deflation is in use 3486 3147 !> @param[in] id_chunksz chunk size 3487 !> @param[in] cd_interp interpolation method3488 !> @param[in] cd_extrap extrapolation method3489 !> @param[in] cd_filter filter method3490 !> @param[in] cd_unt new units (linked to units factor)3491 !> @param[in] dd_unf units factor3492 3148 !> @return variable structure 3493 3149 !------------------------------------------------------------------- … … 3500 3156 & dd_min, dd_max, & 3501 3157 & ld_contiguous, ld_shuffle,& 3502 & ld_fletcher32, id_deflvl, id_chunksz, & 3503 & cd_interp, cd_extrap, cd_filter, & 3504 & cd_unt, dd_unf) 3158 & ld_fletcher32, id_deflvl, id_chunksz) 3505 3159 3506 3160 IMPLICIT NONE … … 3531 3185 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3532 3186 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3533 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp3534 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap3535 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter3536 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt3537 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf3538 3187 3539 3188 ! local variable … … 3582 3231 & ld_fletcher32=ld_fletcher32, & 3583 3232 & id_deflvl=id_deflvl, & 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) 3233 & id_chunksz=id_chunksz(:)) 3589 3234 3590 3235 DEALLOCATE( dl_value ) … … 3608 3253 ! 3609 3254 !> @author J.Paul 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) 3255 !> - November, 2013- Initial Version 3615 3256 ! 3616 3257 !> @param[in] cd_name variable name … … 3642 3283 !> deflation is in use 3643 3284 !> @param[in] id_chunksz chunk size 3644 !> @param[in] cd_interp interpolation method3645 !> @param[in] cd_extrap extrapolation method3646 !> @param[in] cd_filter filter method3647 !> @param[in] cd_unt new units (linked to units factor)3648 !> @param[in] dd_unf units factor3649 3650 3285 !> @return variable structure 3651 3286 !------------------------------------------------------------------- … … 3658 3293 & dd_min, dd_max, & 3659 3294 & ld_contiguous, ld_shuffle,& 3660 & ld_fletcher32, id_deflvl, id_chunksz, & 3661 & cd_interp, cd_extrap, cd_filter, & 3662 & cd_unt, dd_unf) 3295 & ld_fletcher32, id_deflvl, id_chunksz) 3663 3296 3664 3297 IMPLICIT NONE … … 3689 3322 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3690 3323 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3691 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp3692 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap3693 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter3694 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt3695 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf3696 3324 3697 3325 ! local variable … … 3741 3369 & ld_fletcher32=ld_fletcher32, & 3742 3370 & id_deflvl=id_deflvl, & 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) 3371 & id_chunksz=id_chunksz(:)) 3748 3372 3749 3373 DEALLOCATE( dl_value ) … … 3767 3391 ! 3768 3392 !> @author J.Paul 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) 3393 !> - November, 2013- Initial Version 3774 3394 ! 3775 3395 !> @param[in] cd_name variable name … … 3801 3421 !> deflation is in use 3802 3422 !> @param[in] id_chunksz chunk size 3803 !> @param[in] cd_interp interpolation method3804 !> @param[in] cd_extrap extrapolation method3805 !> @param[in] cd_filter filter method3806 !> @param[in] cd_unt new units (linked to units factor)3807 !> @param[in] dd_unf units factor3808 3423 !> @return variable structure 3809 3424 !------------------------------------------------------------------- … … 3816 3431 & dd_min, dd_max, & 3817 3432 & ld_contiguous, ld_shuffle,& 3818 & ld_fletcher32, id_deflvl, id_chunksz, & 3819 & cd_interp, cd_extrap, cd_filter, & 3820 & cd_unt, dd_unf) 3433 & ld_fletcher32, id_deflvl, id_chunksz) 3821 3434 3822 3435 IMPLICIT NONE … … 3847 3460 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 3848 3461 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 3849 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp3850 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap3851 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter3852 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt3853 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf3854 3855 3462 3856 3463 ! local variable … … 3896 3503 & ld_fletcher32=ld_fletcher32, & 3897 3504 & id_deflvl=id_deflvl, & 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) 3505 & id_chunksz=id_chunksz(:)) 3903 3506 3904 3507 DEALLOCATE( dl_value ) … … 3922 3525 ! 3923 3526 !> @author J.Paul 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) 3527 !> - November, 2013- Initial Version 3929 3528 ! 3930 3529 !> @param[in] cd_name variable name … … 3956 3555 !> deflation is in use 3957 3556 !> @param[in] id_chunksz chunk size 3958 !> @param[in] cd_interp interpolation method3959 !> @param[in] cd_extrap extrapolation method3960 !> @param[in] cd_filter filter method3961 !> @param[in] cd_unt new units (linked to units factor)3962 !> @param[in] dd_unf units factor3963 3557 !> @return variable structure 3964 3558 !------------------------------------------------------------------- … … 3971 3565 & dd_min, dd_max, & 3972 3566 & ld_contiguous, ld_shuffle,& 3973 & ld_fletcher32, id_deflvl, id_chunksz, & 3974 & cd_interp, cd_extrap, cd_filter, & 3975 & cd_unt, dd_unf) 3567 & ld_fletcher32, id_deflvl, id_chunksz) 3976 3568 3977 3569 IMPLICIT NONE … … 4002 3594 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4003 3595 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4004 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp4005 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap4006 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter4007 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt4008 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf4009 4010 3596 4011 3597 ! local variable … … 4053 3639 & ld_fletcher32=ld_fletcher32, & 4054 3640 & id_deflvl=id_deflvl, & 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) 3641 & id_chunksz=id_chunksz(:)) 4060 3642 4061 3643 DEALLOCATE( dl_value ) … … 4079 3661 ! 4080 3662 !> @author J.Paul 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) 3663 !> - November, 2013- Initial Version 4086 3664 ! 4087 3665 !> @param[in] cd_name variable name … … 4113 3691 !> deflation is in use 4114 3692 !> @param[in] id_chunksz chunk size 4115 !> @param[in] cd_interp interpolation method4116 !> @param[in] cd_extrap extrapolation method4117 !> @param[in] cd_filter filter method4118 !> @param[in] cd_unt new units (linked to units factor)4119 !> @param[in] dd_unf units factor4120 3693 !> @return variable structure 4121 3694 !------------------------------------------------------------------- … … 4128 3701 & dd_min, dd_max, & 4129 3702 & ld_contiguous, ld_shuffle,& 4130 & ld_fletcher32, id_deflvl, id_chunksz, & 4131 & cd_interp, cd_extrap, cd_filter, & 4132 & cd_unt, dd_unf) 3703 & ld_fletcher32, id_deflvl, id_chunksz) 4133 3704 4134 3705 IMPLICIT NONE … … 4159 3730 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4160 3731 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4161 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp4162 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap4163 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter4164 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt4165 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf4166 3732 4167 3733 ! local variable … … 4210 3776 & ld_fletcher32=ld_fletcher32, & 4211 3777 & id_deflvl=id_deflvl, & 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) 3778 & id_chunksz=id_chunksz(:)) 4217 3779 4218 3780 DEALLOCATE( dl_value ) … … 4236 3798 ! 4237 3799 !> @author J.Paul 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) 3800 !> - November, 2013- Initial Version 4243 3801 ! 4244 3802 !> @param[in] cd_name variable name … … 4270 3828 !> deflation is in use 4271 3829 !> @param[in] id_chunksz chunk size 4272 !> @param[in] cd_interp interpolation method4273 !> @param[in] cd_extrap extrapolation method4274 !> @param[in] cd_filter filter method4275 !> @param[in] cd_unt new units (linked to units factor)4276 !> @param[in] dd_unf units factor4277 3830 !> @return variable structure 4278 3831 !------------------------------------------------------------------- … … 4285 3838 & dd_min, dd_max, & 4286 3839 & ld_contiguous, ld_shuffle,& 4287 & ld_fletcher32, id_deflvl, id_chunksz, & 4288 & cd_interp, cd_extrap, cd_filter, & 4289 & cd_unt, dd_unf) 3840 & ld_fletcher32, id_deflvl, id_chunksz) 4290 3841 4291 3842 IMPLICIT NONE … … 4316 3867 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4317 3868 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4318 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp4319 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap4320 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter4321 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt4322 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf4323 3869 4324 3870 ! local variable … … 4368 3914 & ld_fletcher32=ld_fletcher32, & 4369 3915 & id_deflvl=id_deflvl, & 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) 3916 & id_chunksz=id_chunksz(:)) 4375 3917 4376 3918 DEALLOCATE( dl_value ) … … 4394 3936 ! 4395 3937 !> @author J.Paul 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) 3938 !> - November, 2013- Initial Version 4401 3939 ! 4402 3940 !> @param[in] cd_name variable name … … 4428 3966 !> deflation is in use 4429 3967 !> @param[in] id_chunksz chunk size 4430 !> @param[in] cd_interp interpolation method4431 !> @param[in] cd_extrap extrapolation method4432 !> @param[in] cd_filter filter method4433 !> @param[in] cd_unt new units (linked to units factor)4434 !> @param[in] dd_unf units factor4435 3968 !> @return variable structure 4436 3969 !------------------------------------------------------------------- … … 4443 3976 & dd_min, dd_max, & 4444 3977 & ld_contiguous, ld_shuffle,& 4445 & ld_fletcher32, id_deflvl, id_chunksz, & 4446 & cd_interp, cd_extrap, cd_filter, & 4447 & cd_unt, dd_unf) 3978 & ld_fletcher32, id_deflvl, id_chunksz) 4448 3979 4449 3980 IMPLICIT NONE … … 4474 4005 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4475 4006 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4476 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp4477 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap4478 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter4479 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt4480 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf4481 4007 4482 4008 ! local variable … … 4522 4048 & ld_fletcher32=ld_fletcher32, & 4523 4049 & id_deflvl=id_deflvl, & 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) 4050 & id_chunksz=id_chunksz(:)) 4529 4051 4530 4052 DEALLOCATE( dl_value ) … … 4548 4070 ! 4549 4071 !> @author J.Paul 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) 4072 !> - November, 2013- Initial Version 4555 4073 ! 4556 4074 !> @param[in] cd_name variable name … … 4582 4100 !> deflation is in use 4583 4101 !> @param[in] id_chunksz chunk size 4584 !> @param[in] cd_interp interpolation method4585 !> @param[in] cd_extrap extrapolation method4586 !> @param[in] cd_filter filter method4587 !> @param[in] cd_unt new units (linked to units factor)4588 !> @param[in] dd_unf units factor4589 4102 !> @return variable structure 4590 4103 !------------------------------------------------------------------- … … 4597 4110 & dd_min, dd_max, & 4598 4111 & ld_contiguous, ld_shuffle,& 4599 & ld_fletcher32, id_deflvl, id_chunksz, & 4600 & cd_interp, cd_extrap, cd_filter, & 4601 & cd_unt, dd_unf) 4112 & ld_fletcher32, id_deflvl, id_chunksz) 4602 4113 4603 4114 IMPLICIT NONE … … 4628 4139 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4629 4140 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4630 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp4631 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap4632 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter4633 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt4634 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf4635 4141 4636 4142 ! local variable … … 4678 4184 & ld_fletcher32=ld_fletcher32, & 4679 4185 & id_deflvl=id_deflvl, & 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) 4186 & id_chunksz=id_chunksz(:)) 4685 4187 4686 4188 DEALLOCATE( dl_value ) … … 4704 4206 ! 4705 4207 !> @author J.Paul 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) 4208 !> - November, 2013- Initial Version 4711 4209 ! 4712 4210 !> @param[in] cd_name variable name … … 4738 4236 !> deflation is in use 4739 4237 !> @param[in] id_chunksz chunk size 4740 !> @param[in] cd_interp interpolation method4741 !> @param[in] cd_extrap extrapolation method4742 !> @param[in] cd_filter filter method4743 !> @param[in] cd_unt new units (linked to units factor)4744 !> @param[in] dd_unf units factor4745 4238 !> @return variable structure 4746 4239 !------------------------------------------------------------------- … … 4753 4246 & dd_min, dd_max, & 4754 4247 & ld_contiguous, ld_shuffle,& 4755 & ld_fletcher32, id_deflvl, id_chunksz, & 4756 & cd_interp, cd_extrap, cd_filter, & 4757 & cd_unt, dd_unf) 4248 & ld_fletcher32, id_deflvl, id_chunksz) 4758 4249 4759 4250 IMPLICIT NONE … … 4784 4275 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4785 4276 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4786 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp4787 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap4788 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter4789 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt4790 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf4791 4277 4792 4278 ! local variable … … 4835 4321 & ld_fletcher32=ld_fletcher32, & 4836 4322 & id_deflvl=id_deflvl, & 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) 4323 & id_chunksz=id_chunksz(:)) 4842 4324 4843 4325 DEALLOCATE( dl_value ) … … 4861 4343 ! 4862 4344 !> @author J.Paul 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) 4345 !> - November, 2013- Initial Version 4868 4346 ! 4869 4347 !> @param[in] cd_name variable name … … 4895 4373 !> deflation is in use 4896 4374 !> @param[in] id_chunksz chunk size 4897 !> @param[in] cd_interp interpolation method4898 !> @param[in] cd_extrap extrapolation method4899 !> @param[in] cd_filter filter method4900 !> @param[in] cd_unt new units (linked to units factor)4901 !> @param[in] dd_unf units factor4902 4375 !> @return variable structure 4903 4376 !------------------------------------------------------------------- … … 4910 4383 & dd_min, dd_max, & 4911 4384 & ld_contiguous, ld_shuffle,& 4912 & ld_fletcher32, id_deflvl, id_chunksz, & 4913 & cd_interp, cd_extrap, cd_filter, & 4914 & cd_unt, dd_unf) 4385 & ld_fletcher32, id_deflvl, id_chunksz) 4915 4386 4916 4387 IMPLICIT NONE … … 4941 4412 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl 4942 4413 INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 4943 CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp4944 CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap4945 CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter4946 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt4947 REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf4948 4414 4949 4415 ! local variable … … 4993 4459 & ld_fletcher32=ld_fletcher32, & 4994 4460 & id_deflvl=id_deflvl, & 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) 4461 & id_chunksz=id_chunksz(:)) 5000 4462 5001 4463 DEALLOCATE( dl_value ) … … 5011 4473 !> 5012 4474 !> @author J.Paul 5013 !> @date November, 2013- Initial Version4475 !> - November, 2013- Initial Version 5014 4476 ! 5015 4477 !> @param[in] td_var1 variable structure … … 5061 4523 !> 5062 4524 !> @author J.Paul 5063 !> @date November, 2013- Initial Version4525 !> - November, 2013- Initial Version 5064 4526 ! 5065 4527 !> @param[in] td_var1 variable structure … … 5133 4595 !> 5134 4596 !> @author J.Paul 5135 !> @date November, 2013- Initial Version4597 !> - November, 2013- Initial Version 5136 4598 ! 5137 4599 !> @param[in] td_var1 variable structure … … 5208 4670 !> 5209 4671 !> @author J.Paul 5210 !> @date November, 2013- Initial Version4672 !> - November, 2013- Initial Version 5211 4673 ! 5212 4674 !> @param[in] td_var1 variable structure … … 5283 4745 !> 5284 4746 !> @author J.Paul 5285 !> @date November, 2013- Initial Version4747 !> - November, 2013- Initial Version 5286 4748 ! 5287 4749 !> @param[in] td_var1 variable structure … … 5358 4820 !> 5359 4821 !> @author J.Paul 5360 !> @date November, 2013 - Initial Version 5361 !> @date June, 2015 5362 !> - add all element of the array in the same time 4822 !> - November, 2013- Initial Version 5363 4823 !> 5364 4824 !> @param[inout] td_var variable structure … … 5373 4833 ! local variable 5374 4834 INTEGER(i4) :: il_natt 5375 INTEGER(i4) :: il_status5376 INTEGER(i4) :: il_ind5377 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att5378 4835 5379 4836 ! loop indices … … 5383 4840 il_natt=SIZE(td_att(:)) 5384 4841 5385 IF( td_var%i_natt > 0 )THEN5386 ! already other attribute in variable structure5387 ALLOCATE( tl_att(td_var%i_natt), stat=il_status )5388 IF(il_status /= 0 )THEN5389 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 ELSE5395 5396 ! save temporary global attribute's variable structure5397 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 )THEN5403 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 ENDIF5409 5410 ! copy attribute in variable before5411 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))5412 5413 ! clean5414 CALL att_clean(tl_att(:))5415 DEALLOCATE(tl_att)5416 5417 ENDIF5418 ELSE5419 ! no attribute in variable structure5420 IF( ASSOCIATED(td_var%t_att) )THEN5421 CALL att_clean(td_var%t_att(:))5422 DEALLOCATE(td_var%t_att)5423 ENDIF5424 ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )5425 IF(il_status /= 0 )THEN5426 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 ENDIF5432 ENDIF5433 5434 ALLOCATE( tl_att(il_natt) )5435 tl_att(:)=att_copy(td_att(:))5436 5437 ! check if attribute already in variable structure5438 4842 DO ji=1,il_natt 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 4843 CALL var_add_att(td_var, td_att(ji)) 5447 4844 ENDDO 5448 5449 ! add new attributes5450 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_natt5455 ! highlight some attribute5456 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' )THEN5458 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 SELECT5478 ENDIF5479 ENDDO5480 5481 ! update number of attribute5482 td_var%i_natt=td_var%i_natt+il_natt5483 5484 4845 5485 4846 END SUBROUTINE var__add_att_arr … … 5489 4850 ! 5490 4851 !> @author J.Paul 5491 !> @date November, 2013 - Initial Version 5492 !> @date June, 2015 5493 !> - use var__add_att_arr subroutine 4852 !> - November, 2013- Initial Version 5494 4853 ! 5495 4854 !> @param[inout] td_var variable structure … … 5503 4862 5504 4863 ! local variable 5505 TYPE(TATT), DIMENSION(1) :: tl_att 4864 INTEGER(i4) :: il_status 4865 INTEGER(i4) :: il_ind 4866 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 5506 4867 5507 4868 ! loop indices 4869 INTEGER(i4) :: ji 5508 4870 !---------------------------------------------------------------- 5509 4871 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(:) ) 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 5515 4977 5516 4978 END SUBROUTINE var__add_att_unit … … 5520 4982 ! 5521 4983 !> @author J.Paul 5522 !> @date November, 2013 - Initial Version 5523 !> @date February, 2015 5524 !> - define local attribute structure to avoid mistake 5525 !> with pointer 4984 !> - November, 2013- Initial Version 5526 4985 ! 5527 4986 !> @param[inout] td_var variable structure … … 5537 4996 INTEGER(i4) :: il_ind 5538 4997 5539 TYPE(TATT) :: tl_att5540 4998 ! loop indices 5541 4999 !---------------------------------------------------------------- … … 5549 5007 IF( il_ind == 0 )THEN 5550 5008 5551 CALL logger_ debug( &5009 CALL logger_warn( & 5552 5010 & " VAR DEL ATT: no attribute "//TRIM(cd_name)//& 5553 5011 & ", in variable "//TRIM(td_var%c_name) ) … … 5555 5013 ELSE 5556 5014 5557 tl_att=att_copy(td_var%t_att(il_ind)) 5558 CALL var_del_att(td_var, tl_att) 5015 CALL var_del_att(td_var, td_var%t_att(il_ind)) 5559 5016 5560 5017 ENDIF … … 5566 5023 ! 5567 5024 !> @author J.Paul 5568 !> @date November, 2013- Initial Version 5569 !> @date February, 2015 5570 !> - delete highlight attribute too, when attribute 5571 !> is deleted 5025 !> - November, 2013- Initial Version 5572 5026 ! 5573 5027 !> @param[inout] td_var variable structure … … 5586 5040 5587 5041 ! loop indices 5042 !INTEGER(i4) :: ji 5588 5043 !---------------------------------------------------------------- 5589 5044 … … 5596 5051 IF( il_ind == 0 )THEN 5597 5052 5598 CALL logger_ debug( &5053 CALL logger_warn( & 5599 5054 & " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//& 5600 5055 & ", in variable "//TRIM(td_var%c_name) ) … … 5648 5103 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 5649 5104 5105 !! change attribute id 5106 !DO ji=1,td_var%i_natt 5107 ! td_var%t_att(ji)%i_id=ji 5108 !ENDDO 5109 5650 5110 ! clean 5651 5111 CALL att_clean(tl_att(:)) … … 5653 5113 ENDIF 5654 5114 ENDIF 5655 5656 ! highlight attribute5657 SELECT CASE( TRIM(td_att%c_name) )5658 5659 CASE("add_offset")5660 td_var%d_ofs = 0._dp5661 CASE("scale_factor")5662 td_var%d_scf = 1._dp5663 CASE("_FillValue")5664 td_var%d_fill = 0._dp5665 CASE("ew_overlap")5666 td_var%i_ew = -15667 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 SELECT5677 5678 5115 ENDIF 5679 5116 … … 5684 5121 ! 5685 5122 !> @author J.Paul 5686 !> @date November, 2013- Initial Version5123 !> - November, 2013- Initial Version 5687 5124 ! 5688 5125 !> @param[inout] td_var variable structure … … 5719 5156 ! 5720 5157 !> @author J.Paul 5721 !> @date November, 2013- Initial Version5158 !> - November, 2013- Initial Version 5722 5159 ! 5723 5160 !> @param[inout] td_var variable structure … … 5758 5195 ! 5759 5196 !> @author J.Paul 5760 !> @date November, 2013- Initial Version5197 !> - November, 2013- Initial Version 5761 5198 ! 5762 5199 !> @param[inout] td_var variable structure … … 5774 5211 !---------------------------------------------------------------- 5775 5212 5776 IF( td_var%i_ndim <= ip_maxdim)THEN5213 IF( td_var%i_ndim <= 4 )THEN 5777 5214 5778 5215 ! check if dimension already used in variable structure … … 5790 5227 ELSE 5791 5228 5792 ! back to disorder dimension array 5793 CALL dim_disorder(td_var%t_dim(:)) 5794 5229 ! back to unorder dimension array 5230 CALL dim_unorder(td_var%t_dim(:)) 5795 5231 ! add new dimension 5796 5232 td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim) … … 5817 5253 ! 5818 5254 !> @author J.Paul 5819 !> @date November, 2013- Initial Version5255 !> - November, 2013- Initial Version 5820 5256 ! 5821 5257 !> @param[inout] td_var variable structure … … 5836 5272 !---------------------------------------------------------------- 5837 5273 5838 IF( td_var%i_ndim <= ip_maxdim)THEN5274 IF( td_var%i_ndim <= 4 )THEN 5839 5275 5840 5276 CALL logger_trace( & … … 5881 5317 ! 5882 5318 !> @author J.Paul 5883 !> @date November, 2013- Initial Version5319 !> - November, 2013- Initial Version 5884 5320 ! 5885 5321 !> @param[inout] td_var variable structure … … 5924 5360 !> 5925 5361 !> @author J.Paul 5926 !> @date June, 2014- Initial Version5362 !> - June, 2014- Initial Version 5927 5363 ! 5928 5364 !> @param[in] td_var array of variables structure … … 5950 5386 !> 5951 5387 !> @author J.Paul 5952 !> @date November, 2013- Initial Version5388 !> - November, 2013- Initial Version 5953 5389 ! 5954 5390 !> @param[in] td_var variable structure … … 6057 5493 !> 6058 5494 !> @author J.Paul 6059 !> @date November, 2013- Initial Version5495 !> - November, 2013- Initial Version 6060 5496 !> 6061 5497 !> @param[inout] td_var variable structure … … 6195 5631 !> 6196 5632 !> @author J.Paul 6197 !> @date November, 2013- Initial Version5633 !> - November, 2013- Initial Version 6198 5634 !> 6199 5635 !> @param[inout] td_var variable structure … … 6249 5685 !> 6250 5686 !> @author J.Paul 6251 !> @date November, 2013- Initial Version5687 !> - November, 2013- Initial Version 6252 5688 ! 6253 5689 !> @param[inout] td_var variable structure … … 6325 5761 ! 6326 5762 !> @author J.Paul 6327 !> @date November, 2013- Initial Version5763 !> - November, 2013- Initial Version 6328 5764 ! 6329 5765 !> @param[inout] td_var variabele structure … … 6401 5837 ! 6402 5838 !> @author J.Paul 6403 !> @date November, 2013- Initial Version5839 !> - November, 2013- Initial Version 6404 5840 ! 6405 5841 !> @param[inout] td_var variabele structure … … 6477 5913 ! 6478 5914 !> @author J.Paul 6479 !> @date November, 2013- Initial Version5915 !> - November, 2013- Initial Version 6480 5916 ! 6481 5917 !> @param[inout] td_var variabele structure … … 6551 5987 !> 6552 5988 !> @author J.Paul 6553 !> @date November, 2013- Initial Version5989 !> - November, 2013- Initial Version 6554 5990 ! 6555 5991 !> @param[inout] td_var variable structure … … 6621 6057 !> 6622 6058 !> @author J.Paul 6623 !> @date November, 2013- Initial Version6059 !> - November, 2013- Initial Version 6624 6060 !> 6625 6061 !> @param[inout] td_var variable structure … … 6644 6080 !> 6645 6081 !> @author J.Paul 6646 !> @date September, 2014- Initial Version6082 !> - September, 2014- Initial Version 6647 6083 !> 6648 6084 !> @param[in] td_var array of variable structure … … 6706 6142 !> given variable name or standard name. 6707 6143 !> 6144 !> @warning only variable read from file, have an id. 6145 !> 6708 6146 !> @author J.Paul 6709 !> @date November, 2013 - Initial Version 6710 !> @date July, 2015 6711 !> - check long name 6147 !> - November, 2013- Initial Version 6712 6148 ! 6713 6149 !> @param[in] td_var array of variable structure … … 6743 6179 ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.& 6744 6180 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 6745 6746 var_get_id=td_var(ji)%i_id6747 EXIT6748 6749 ! look for variable long name6750 ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&6751 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN6752 6181 6753 6182 var_get_id=td_var(ji)%i_id … … 6771 6200 !> 6772 6201 !> @author J.Paul 6773 !> @date November, 2013- Initial Version6202 !> - November, 2013- Initial Version 6774 6203 ! 6775 6204 !> @param[in] td_var array of variable structure … … 6790 6219 IF( ASSOCIATED(td_var%d_value) )THEN 6791 6220 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))) 6221 CALL logger_trace( "VAR GET MASK: create mask from variable "//& 6222 & TRIM(td_var%c_name) ) 6795 6223 var_get_mask(:,:,:)=1 6796 6224 WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill ) … … 6811 6239 !> 6812 6240 !> @author J.Paul 6813 !> @date November, 2013- Initial Version6241 !> - November, 2013- Initial Version 6814 6242 ! 6815 6243 !> @param[inout] td_var array of variable structure … … 6894 6322 !> 6895 6323 !> @author J.Paul 6896 !> @date November, 2013 - Initial Version 6897 !> @date June, 2015 6898 !> - new namelist format to get extra information (interpolation,...) 6324 !> - November, 2013- Initial Version 6899 6325 ! 6900 6326 !> @param[in] cd_file configuration file of variable … … 6931 6357 6932 6358 il_fileid=fct_getunit() 6359 CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file)) 6933 6360 OPEN( il_fileid, FILE=TRIM(cd_file), & 6934 6361 & FORM='FORMATTED', & … … 6939 6366 CALL fct_err(il_status) 6940 6367 IF( il_status /= 0 )THEN 6941 CALL logger_fatal("VAR DEF EXTRA: can not open file "//& 6942 & TRIM(cd_file)) 6368 CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file)) 6943 6369 ENDIF 6944 6370 … … 6949 6375 DO WHILE( il_status == 0 ) 6950 6376 6951 ! search line not beginning with comment character6377 ! search line do not beginning with comment character 6952 6378 IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 6953 6379 il_nvar=il_nvar+1 … … 6993 6419 tg_varextra(ji)%c_axis =TRIM(fct_split(cl_line,3)) 6994 6420 tg_varextra(ji)%c_point =TRIM(fct_split(cl_line,4)) 6995 6996 cl_interp='int='//TRIM(fct_split(cl_line,5)) 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)) 6997 6425 tg_varextra(ji)%c_interp(:) = & 6998 6426 & var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp) 6999 6427 CALL logger_debug("VAR DEF EXTRA: "//& 7000 6428 & TRIM(tg_varextra(ji)%c_name)//& 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)) 6429 & " "//TRIM(cl_interp)) 7005 6430 ELSE 7006 6431 ji=ji-1 … … 7033 6458 !> @details 7034 6459 !> string character format must be : <br/> 7035 !> "varname:int =interp; flt=filter; ext=extrap; min=min; max=max"<br/>6460 !> "varname:interp; filter; extrap; > min; < max"<br/> 7036 6461 !> you could specify only interpolation, filter or extrapolation method, 7037 6462 !> whatever the order. you could find more … … 7039 6464 !> \ref extrap module.<br/> 7040 6465 !> Examples: 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 6466 !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.' 6467 !> cn_varinfo='votemper:cubic; dist_weight; <40.' 7047 6468 !> 7048 6469 !> @note If you do not specify a method which is required, default one is … … 7050 6471 !> 7051 6472 !> @author J.Paul 7052 !> @date November, 2013 - Initial Version 7053 !> @date July, 2015 7054 !> - get unit and unit factor (to change unit) 6473 !> - November, 2013- Initial Version 7055 6474 ! 7056 6475 !> @param[in] cd_varinfo variable information from namelist … … 7067 6486 CHARACTER(LEN=lc), DIMENSION(1) :: cl_extrap 7068 6487 CHARACTER(LEN=lc), DIMENSION(5) :: cl_filter 7069 CHARACTER(LEN=lc) :: cl_unt7070 6488 7071 6489 INTEGER(i4) :: il_ind … … 7074 6492 REAL(dp) :: dl_min 7075 6493 REAL(dp) :: dl_max 7076 REAL(dp) :: dl_unf7077 6494 7078 6495 TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_varextra … … 7091 6508 dl_min=var__get_min(cl_name, cl_method) 7092 6509 dl_max=var__get_max(cl_name, cl_method) 7093 dl_unf=var__get_unf(cl_name, cl_method)7094 6510 cl_interp(:)=var__get_interp(cl_name, cl_method) 7095 6511 cl_extrap(:)=var__get_extrap(cl_name, cl_method) 7096 6512 cl_filter(:)=var__get_filter(cl_name, cl_method) 7097 cl_unt=var__get_unt(cl_name, cl_method)7098 7099 6513 7100 6514 il_ind=var_get_index(tg_varextra(:), TRIM(cl_name)) … … 7102 6516 IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min 7103 6517 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_unf7105 IF(cl_unt /='') tg_varextra(il_ind)%c_unt =cl_unt7106 6518 IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:) 7107 6519 IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:) … … 7139 6551 & cd_filter=cl_filter(:), & 7140 6552 & dd_min = dl_min, & 7141 & dd_max = dl_max, & 7142 & cd_unt = cl_unt, & 7143 & dd_unf = dl_unf ) 6553 & dd_max = dl_max ) 7144 6554 7145 6555 ENDIF 7146 6556 7147 6557 ji=ji+1 7148 CALL logger_ debug( "VAR CHG EXTRA: name "//&6558 CALL logger_trace( "VAR CHG EXTRA: name "//& 7149 6559 & TRIM(tg_varextra(il_ind)%c_name) ) 7150 CALL logger_ debug( "VAR CHG EXTRA: interp "//&6560 CALL logger_trace( "VAR CHG EXTRA: interp "//& 7151 6561 & TRIM(tg_varextra(il_ind)%c_interp(1)) ) 7152 CALL logger_ debug( "VAR CHG EXTRA: filter "//&6562 CALL logger_trace( "VAR CHG EXTRA: filter "//& 7153 6563 & TRIM(tg_varextra(il_ind)%c_filter(1)) ) 7154 CALL logger_ debug( "VAR CHG EXTRA: extrap "//&6564 CALL logger_trace( "VAR CHG EXTRA: extrap "//& 7155 6565 & TRIM(tg_varextra(il_ind)%c_extrap(1)) ) 7156 6566 IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN 7157 CALL logger_ debug( "VAR CHG EXTRA: min value "//&6567 CALL logger_trace( "VAR CHG EXTRA: min value "//& 7158 6568 & TRIM(fct_str(tg_varextra(il_ind)%d_min)) ) 7159 6569 ENDIF 7160 6570 IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN 7161 CALL logger_ debug( "VAR CHG EXTRA: max value "//&6571 CALL logger_trace( "VAR CHG EXTRA: max value "//& 7162 6572 & TRIM(fct_str(tg_varextra(il_ind)%d_max)) ) 7163 ENDIF7164 IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN7165 CALL logger_debug( "VAR CHG EXTRA: new unit "//&7166 & TRIM(tg_varextra(il_ind)%c_unt) )7167 ENDIF7168 IF( tg_varextra(il_ind)%d_unf /= 1. )THEN7169 CALL logger_debug( "VAR CHG EXTRA: new unit factor "//&7170 & TRIM(fct_str(tg_varextra(il_ind)%d_unf)) )7171 6573 ENDIF 7172 6574 ENDDO … … 7191 6593 !> 7192 6594 !> @author J.Paul 7193 !> @date November, 2013- Initial Version6595 !> - November, 2013- Initial Version 7194 6596 ! 7195 6597 !> @param[inout] td_var variable structure … … 7285 6687 !> 7286 6688 !> @author J.Paul 7287 !> @date November, 2013- Initial Version6689 !> - November, 2013- Initial Version 7288 6690 !> 7289 6691 !> @param[inout] td_var variable structure … … 7295 6697 7296 6698 ! local variable 7297 CHARACTER(LEN=lc) :: cl_tmp7298 7299 6699 INTEGER(i4) :: il_ind 7300 7301 6700 TYPE(TATT) :: tl_att 7302 6701 7303 6702 ! loop indices 7304 INTEGER(i4) :: ji7305 6703 !---------------------------------------------------------------- 7306 6704 … … 7355 6753 td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis) 7356 6754 ! create attibute 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) 6755 tl_att=att_init('axis',TRIM(td_var%c_axis)) 6756 CALL var_move_att(td_var, tl_att) 7367 6757 ENDIF 7368 6758 … … 7418 6808 ENDIF 7419 6809 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).") 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))) 7436 6819 ENDIF 7437 6820 … … 7450 6833 !> 7451 6834 !> @details 7452 !> minimum value is assume to follow s tring "min ="6835 !> minimum value is assume to follow sign '>' 7453 6836 !> 7454 6837 !> @author J.Paul 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 6838 !> - November, 2013- Initial Version 7461 6839 ! 7462 6840 !> @param[in] cd_name variable name … … 7481 6859 ! loop indices 7482 6860 INTEGER(i4) :: ji 7483 INTEGER(i4) :: jj7484 6861 !---------------------------------------------------------------- 7485 6862 ! init … … 7490 6867 cl_tmp=fct_split(cd_varinfo,ji,';') 7491 6868 DO WHILE( TRIM(cl_tmp) /= '' ) 7492 il_ind= INDEX(TRIM(cl_tmp),'min')6869 il_ind=SCAN(TRIM(cl_tmp),'>') 7493 6870 IF( il_ind /= 0 )THEN 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 6871 cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 6872 EXIT 7501 6873 ENDIF 7502 6874 ji=ji+1 … … 7505 6877 7506 6878 IF( TRIM(cl_min) /= '' )THEN 7507 IF( fct_is_ real(cl_min) )THEN6879 IF( fct_is_num(cl_min) )THEN 7508 6880 READ(cl_min,*) var__get_min 7509 6881 CALL logger_debug("VAR GET MIN: will use minimum value of "//& 7510 6882 & TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) ) 7511 6883 ELSE 7512 CALL logger_error("VAR GET MIN: invalid minimum value ("//& 7513 & TRIM(cl_min)//") for variable "//TRIM(cd_name)//& 7514 & ". check namelist." ) 6884 CALL logger_error("VAR GET MIN: invalid minimum value for "//& 6885 & "variable "//TRIM(cd_name)//". check namelist." ) 7515 6886 ENDIF 7516 6887 ENDIF … … 7523 6894 !> 7524 6895 !> @details 7525 !> maximum value is assume to follow s tring "max ="6896 !> maximum value is assume to follow sign '<' 7526 6897 !> 7527 6898 !> @author J.Paul 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 6899 !> - November, 2013- Initial Version 7534 6900 ! 7535 6901 !> @param[in] cd_name variable name … … 7554 6920 ! loop indices 7555 6921 INTEGER(i4) :: ji 7556 INTEGER(i4) :: jj7557 6922 !---------------------------------------------------------------- 7558 6923 ! init … … 7563 6928 cl_tmp=fct_split(cd_varinfo,ji,';') 7564 6929 DO WHILE( TRIM(cl_tmp) /= '' ) 7565 il_ind= INDEX(TRIM(cl_tmp),'max')6930 il_ind=SCAN(TRIM(cl_tmp),'<') 7566 6931 IF( il_ind /= 0 )THEN 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 6932 cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 6933 EXIT 7574 6934 ENDIF 7575 6935 ji=ji+1 … … 7578 6938 7579 6939 IF( TRIM(cl_max) /= '' )THEN 7580 IF( fct_is_ real(cl_max) )THEN6940 IF( fct_is_num(cl_max) )THEN 7581 6941 READ(cl_max,*) var__get_max 7582 6942 CALL logger_debug("VAR GET MAX: will use maximum value of "//& … … 7592 6952 !> @brief 7593 6953 !> This function check if variable information read in namelist contains 7594 !> units factor value and return it if true.7595 !>7596 !> @details7597 !> units factor value is assume to follow string "unf ="7598 !>7599 !> @author J.Paul7600 !> @date June, 2015 - Initial Version7601 !> @date Feb, 20167602 !> - check character just after keyword7603 !7604 !> @param[in] cd_name variable name7605 !> @param[in] cd_varinfo variable information read in namelist7606 !> @return untis factor value to be used (FillValue if none)7607 !-------------------------------------------------------------------7608 FUNCTION var__get_unf( cd_name, cd_varinfo )7609 IMPLICIT NONE7610 ! Argument7611 CHARACTER(LEN=*), INTENT(IN ) :: cd_name7612 CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo7613 7614 ! function7615 REAL(dp) :: var__get_unf7616 7617 ! local variable7618 CHARACTER(LEN=lc) :: cl_tmp7619 CHARACTER(LEN=lc) :: cl_unf7620 7621 INTEGER(i4) :: il_ind7622 7623 REAL(dp) :: rl_unf7624 7625 ! loop indices7626 INTEGER(i4) :: ji7627 INTEGER(i4) :: jj7628 !----------------------------------------------------------------7629 ! init7630 cl_unf=''7631 var__get_unf=dp_fill7632 7633 ji=17634 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 )THEN7638 ! check character just after7639 jj=il_ind+LEN('unf')7640 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. &7641 & TRIM(cl_tmp(jj:jj)) == '=' )THEN7642 cl_unf=fct_split(cl_tmp,2,'=')7643 EXIT7644 ENDIF7645 ENDIF7646 ji=ji+17647 cl_tmp=fct_split(cd_varinfo,ji,';')7648 ENDDO7649 7650 IF( TRIM(cl_unf) /= '' )THEN7651 rl_unf=math_compute(cl_unf)7652 IF( rl_unf /= dp_fill )THEN7653 var__get_unf = rl_unf7654 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 ELSE7658 CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//&7659 & "value for variable "//TRIM(cd_name)//". check namelist." )7660 ENDIF7661 ENDIF7662 7663 END FUNCTION var__get_unf7664 !-------------------------------------------------------------------7665 !> @brief7666 !> This function check if variable information read in namelist contains7667 6954 !> interpolation method and return it if true. 7668 6955 !> 7669 6956 !> @details 7670 !> interpolation method is assume to follow string "int =" 7671 !> 6957 !> split namelist information, using ';' as separator. 7672 6958 !> compare method name with the list of interpolation method available (see 7673 6959 !> module global). 7674 6960 !> check if factor (*rhoi, /rhoj..) are present.<br/> 7675 6961 !> Example:<br/> 7676 !> - int=cubic/rhoi ; ext=dist_weight7677 !> - int=bilin6962 !> - cubic/rhoi ; dist_weight 6963 !> - bilin 7678 6964 !> see @ref interp module for more information. 7679 6965 !> 7680 6966 !> @author J.Paul 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 6967 !> - November, 2013- Initial Version 7687 6968 ! 7688 6969 !> @param[in] cd_name variable name … … 7701 6982 ! local variable 7702 6983 CHARACTER(LEN=lc) :: cl_tmp 7703 CHARACTER(LEN=lc) :: cl_int7704 6984 CHARACTER(LEN=lc) :: cl_factor 7705 6985 … … 7720 7000 cl_tmp=fct_split(cd_varinfo,ji,';') 7721 7001 DO WHILE( TRIM(cl_tmp) /= '' ) 7722 il_ind=INDEX(TRIM(cl_tmp),'int')7723 IF( il_ind /= 0 )THEN7724 ! check character just after7725 jj=il_ind+LEN('int')7726 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. &7727 & TRIM(cl_tmp(jj:jj)) == '=' )THEN7728 cl_int=fct_split(cl_tmp,2,'=')7729 EXIT7730 ENDIF7731 ENDIF7732 ji=ji+17733 cl_tmp=fct_split(cd_varinfo,ji,';')7734 ENDDO7735 7736 IF( TRIM(cl_int) /= '' )THEN7737 7002 DO jj=1,ip_ninterp 7738 il_ind= INDEX(fct_lower(cl_ int),TRIM(cp_interp_list(jj)))7003 il_ind= INDEX(fct_lower(cl_tmp),TRIM(cp_interp_list(jj))) 7739 7004 IF( il_ind /= 0 )THEN 7740 7005 … … 7744 7009 ! look for factor 7745 7010 IF( il_ind==1 )THEN 7746 cl_factor=cl_ int(il_len+1:)7011 cl_factor=cl_tmp(il_len+1:) 7747 7012 ELSE 7748 cl_factor=cl_ int(1:il_ind-1)7013 cl_factor=cl_tmp(1:il_ind-1) 7749 7014 ENDIF 7750 7015 il_mul=SCAN(TRIM(cl_factor),'*') … … 7787 7052 ENDIF 7788 7053 ENDDO 7789 ENDIF 7054 IF( jj /= ip_ninterp + 1 ) EXIT 7055 ji=ji+1 7056 cl_tmp=fct_split(cd_varinfo,ji,';') 7057 ENDDO 7790 7058 7791 7059 END FUNCTION var__get_interp … … 7796 7064 !> 7797 7065 !> @details 7798 !> extrapolation method is assume to follow string "ext =" 7799 !> 7066 !> split namelist information, using ';' as separator. 7800 7067 !> compare method name with the list of extrapolation method available (see 7801 7068 !> module global).<br/> 7802 7069 !> Example:<br/> 7803 !> - int=cubic ; ext=dist_weight7804 !> - ext=min_error7070 !> - cubic ; dist_weight 7071 !> - min_error 7805 7072 !> see @ref extrap module for more information. 7806 7073 !> 7807 7074 !> @author J.Paul 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 7075 !> - November, 2013- Initial Version 7814 7076 ! 7815 7077 !> @param[in] cd_name variable name … … 7828 7090 ! local variable 7829 7091 CHARACTER(LEN=lc) :: cl_tmp 7830 CHARACTER(LEN=lc) :: cl_ext7831 7832 INTEGER(i4) :: il_ind7833 7092 7834 7093 ! loop indices … … 7842 7101 cl_tmp=fct_split(cd_varinfo,ji,';') 7843 7102 DO WHILE( TRIM(cl_tmp) /= '' ) 7844 il_ind=INDEX(TRIM(cl_tmp),'ext')7845 IF( il_ind /= 0)THEN7846 ! check character just after7847 jj=il_ind+LEN('ext') 7848 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR.&7849 & TRIM(cl_tmp(jj:jj)) == '=' )THEN7850 cl_ext=fct_split(cl_tmp,2,'=') 7103 DO jj=1,ip_nextrap 7104 IF( TRIM(fct_lower(cl_tmp)) == TRIM(cp_extrap_list(jj)) )THEN 7105 var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 7106 7107 CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//& 7108 & " will use extrapolation method "//TRIM(var__get_extrap(1)) ) 7109 7851 7110 EXIT 7852 7111 ENDIF 7853 ENDIF 7112 ENDDO 7113 IF( jj /= ip_nextrap + 1 ) EXIT 7854 7114 ji=ji+1 7855 7115 cl_tmp=fct_split(cd_varinfo,ji,';') 7856 7116 ENDDO 7857 7858 IF( TRIM(cl_ext) /= '' )THEN7859 DO jj=1,ip_nextrap7860 IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN7861 var__get_extrap(1)=TRIM(cp_extrap_list(jj))7862 7863 CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//&7864 & " will use extrapolation method "//TRIM(var__get_extrap(1)) )7865 7866 EXIT7867 ENDIF7868 ENDDO7869 ENDIF7870 7117 7871 7118 … … 7877 7124 !> 7878 7125 !> @details 7879 !> filter method is assume to follow string "flt =" 7880 !> 7126 !> split namelist information, using ';' as separator. 7881 7127 !> compare method name with the list of filter method available (see 7882 7128 !> module global). 7883 !> look for the number of run, using '*' separator, and method parameters inside7129 !> look for the number of turn, using '*' separator, and method parameters inside 7884 7130 !> bracket.<br/> 7885 7131 !> Example:<br/> 7886 !> - int=cubic ; flt=2*hamming(2,3)7887 !> - flt=hann7132 !> - cubic ; 2*hamming(2,3) 7133 !> - hann 7888 7134 !> see @ref filter module for more information. 7889 7135 !> 7890 7136 !> @author J.Paul 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 !> 7137 !> - November, 2013- Initial Version 7138 ! 7898 7139 !> @param[in] cd_name variable name 7899 7140 !> @param[in] cd_varinfo variable information read in namelist … … 7910 7151 ! local variable 7911 7152 CHARACTER(LEN=lc) :: cl_tmp 7912 CHARACTER(LEN=lc) :: cl_flt7913 7153 INTEGER(i4) :: il_ind 7914 7154 … … 7923 7163 cl_tmp=fct_split(cd_varinfo,ji,';') 7924 7164 DO WHILE( TRIM(cl_tmp) /= '' ) 7925 il_ind=INDEX(TRIM(cl_tmp),'flt')7926 IF( il_ind /= 0 )THEN7927 ! check character just after7928 jj=il_ind+LEN('flt')7929 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. &7930 & TRIM(cl_tmp(jj:jj)) == '=' )THEN7931 cl_flt=fct_split(cl_tmp,2,'=')7932 EXIT7933 ENDIF7934 ENDIF7935 ji=ji+17936 cl_tmp=fct_split(cd_varinfo,ji,';')7937 ENDDO7938 7939 IF( TRIM(cl_flt) /= '' )THEN7940 7165 DO jj=1,ip_nfilter 7941 il_ind=INDEX(fct_lower(cl_ flt),TRIM(cp_filter_list(jj)))7166 il_ind=INDEX(fct_lower(cl_tmp),TRIM(cp_filter_list(jj))) 7942 7167 IF( il_ind /= 0 )THEN 7943 7168 var__get_filter(1)=TRIM(cp_filter_list(jj)) 7944 7169 7945 ! look for number of run7946 il_ind=SCAN(fct_lower(cl_ flt),'*')7170 ! look for number of turn 7171 il_ind=SCAN(fct_lower(cl_tmp),'*') 7947 7172 IF( il_ind /=0 )THEN 7948 IF( fct_is_num(cl_ flt(1:il_ind-1)) )THEN7949 var__get_filter(2)=TRIM(cl_ flt(1:il_ind-1))7950 ELSE IF( fct_is_num(cl_ flt(il_ind+1:)) )THEN7951 var__get_filter(2)=TRIM(cl_ flt(il_ind+1:))7173 IF( fct_is_num(cl_tmp(1:il_ind-1)) )THEN 7174 var__get_filter(2)=TRIM(cl_tmp(1:il_ind-1)) 7175 ELSE IF( fct_is_num(cl_tmp(il_ind+1:)) )THEN 7176 var__get_filter(2)=TRIM(cl_tmp(il_ind+1:)) 7952 7177 ELSE 7953 7178 var__get_filter(2)='1' … … 7958 7183 7959 7184 ! look for filter parameter 7960 il_ind=SCAN(fct_lower(cl_ flt),'(')7185 il_ind=SCAN(fct_lower(cl_tmp),'(') 7961 7186 IF( il_ind /=0 )THEN 7962 cl_ flt=TRIM(cl_flt(il_ind+1:))7963 il_ind=SCAN(fct_lower(cl_ flt),')')7187 cl_tmp=TRIM(cl_tmp(il_ind+1:)) 7188 il_ind=SCAN(fct_lower(cl_tmp),')') 7964 7189 IF( il_ind /=0 )THEN 7965 cl_ flt=TRIM(cl_flt(1:il_ind-1))7190 cl_tmp=TRIM(cl_tmp(1:il_ind-1)) 7966 7191 ! look for cut-off frequency 7967 var__get_filter(3)=fct_split(cl_ flt,1,',')7192 var__get_filter(3)=fct_split(cl_tmp,1,',') 7968 7193 ! look for halo size 7969 var__get_filter(4)=fct_split(cl_ flt,2,',')7194 var__get_filter(4)=fct_split(cl_tmp,2,',') 7970 7195 ! look for alpha parameter 7971 var__get_filter(5)=fct_split(cl_ flt,3,',')7196 var__get_filter(5)=fct_split(cl_tmp,3,',') 7972 7197 ELSE 7973 7198 CALL logger_error("VAR GET FILTER: variable "//& … … 7990 7215 ENDIF 7991 7216 ENDDO 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 7217 IF( jj /= ip_nfilter + 1 ) EXIT 8046 7218 ji=ji+1 8047 7219 cl_tmp=fct_split(cd_varinfo,ji,';') 8048 7220 ENDDO 8049 7221 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 7222 END FUNCTION var__get_filter 8057 7223 !------------------------------------------------------------------- 8058 7224 !> @brief … … 8061 7227 !> 8062 7228 !> @author J.Paul 8063 !> @date November, 2013- Initial Version7229 !> - November, 2013- Initial Version 8064 7230 ! 8065 7231 !> @param[in] td_var array of variable structure … … 8119 7285 !> 8120 7286 !> @author J.Paul 8121 !> @date November, 2013- Initial Version7287 !> - November, 2013- Initial Version 8122 7288 ! 8123 7289 !> @param[inout] td_var variable structure … … 8155 7321 !------------------------------------------------------------------- 8156 7322 !> @brief 8157 !> This subroutine replace unit name of the variable,8158 !> and apply unit factor to the value of this variable.8159 !>8160 !> @details8161 !> 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.Paul8166 !> @date June, 2015 - Initial Version8167 !8168 !> @param[inout] td_var variable structure8169 !-------------------------------------------------------------------8170 SUBROUTINE var_chg_unit( td_var )8171 IMPLICIT NONE8172 ! Argument8173 TYPE(TVAR), INTENT(INOUT) :: td_var8174 8175 ! local variable8176 TYPE(TATT) :: tl_att8177 8178 ! loop indices8179 !----------------------------------------------------------------8180 8181 IF( ASSOCIATED(td_var%d_value) )THEN8182 !- change value8183 IF( td_var%d_unf /= 1._dp )THEN8184 WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )8185 td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf8186 END WHERE8187 8188 !- change scale factor and offset to avoid mistake8189 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 ENDIF8195 8196 !- change unit name8197 IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. &8198 & TRIM(td_var%c_unt) /= '' )THEN8199 tl_att=att_init('units',TRIM(td_var%c_unt))8200 CALL var_move_att(td_var,tl_att)8201 ENDIF8202 8203 ENDIF8204 8205 END SUBROUTINE var_chg_unit8206 !-------------------------------------------------------------------8207 !> @brief8208 7323 !> This subroutine check variable dimension expected, as defined in 8209 7324 !> file 'variable.cfg'. … … 8214 7329 !> 8215 7330 !> @author J.Paul 8216 !> @date November, 2013- Initial Version7331 !> - November, 2013- Initial Version 8217 7332 ! 8218 7333 !> @param[inout] td_var variable structure … … 8299 7414 !> 8300 7415 !> @author J.Paul 8301 !> @date August, 2014 - Initial Version 8302 !> @date July 2015 8303 !> - do not use dim_disorder anymore 7416 !> - August, 2014- Initial Version 8304 7417 ! 8305 7418 !> @param[inout] td_var variable structure … … 8325 7438 IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 8326 7439 8327 CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//&8328 & " new dimension order "//TRIM(cl_dimorder))8329 8330 7440 tl_dim(:)=dim_copy(td_var%t_dim(:)) 8331 7441 7442 CALL dim_unorder(tl_dim(:)) 8332 7443 CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 8333 7444 … … 8356 7467 !> 8357 7468 !> @author J.Paul 8358 !> @date September, 2014- Initial Version7469 !> - September, 2014- Initial Version 8359 7470 ! 8360 7471 !> @param[in] td_var array of variable structure … … 8381 7492 !> 8382 7493 !> @author J.Paul 8383 !> @date November, 2014- Initial Version7494 !> - November, 2014- Initial Version 8384 7495 ! 8385 7496 !> @param[in] td_var time variable structure … … 8442 7553 8443 7554 END FUNCTION var_to_date 8444 !-------------------------------------------------------------------8445 !> @brief This subroutine fill dummy variable array8446 !8447 !> @author J.Paul8448 !> @date September, 2015 - Initial Version8449 !8450 !> @param[in] cd_dummy dummy configuration file8451 !-------------------------------------------------------------------8452 SUBROUTINE var_get_dummy( cd_dummy )8453 IMPLICIT NONE8454 ! Argument8455 CHARACTER(LEN=*), INTENT(IN) :: cd_dummy8456 8457 ! local variable8458 INTEGER(i4) :: il_fileid8459 INTEGER(i4) :: il_status8460 8461 LOGICAL :: ll_exist8462 8463 ! loop indices8464 ! namelist8465 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar8466 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim8467 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt8468 8469 !----------------------------------------------------------------8470 NAMELIST /namdum/ & !< dummy namelist8471 & cn_dumvar, & !< variable name8472 & cn_dumdim, & !< dimension name8473 & cn_dumatt !< attribute name8474 !----------------------------------------------------------------8475 8476 ! init8477 cm_dumvar(:)=''8478 8479 ! read namelist8480 INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)8481 IF( ll_exist )THEN8482 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 )THEN8493 CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))8494 ENDIF8495 8496 READ( il_fileid, NML = namdum )8497 cm_dumvar(:)=cn_dumvar(:)8498 8499 CLOSE( il_fileid )8500 8501 ENDIF8502 8503 END SUBROUTINE var_get_dummy8504 !-------------------------------------------------------------------8505 !> @brief This function check if variable is defined as dummy variable8506 !> in configuraton file8507 !>8508 !> @author J.Paul8509 !> @date September, 2015 - Initial Version8510 !8511 !> @param[in] td_var variable structure8512 !> @return true if variable is dummy variable8513 !-------------------------------------------------------------------8514 FUNCTION var_is_dummy(td_var)8515 IMPLICIT NONE8516 8517 ! Argument8518 TYPE(TVAR), INTENT(IN) :: td_var8519 8520 ! function8521 LOGICAL :: var_is_dummy8522 8523 ! loop indices8524 INTEGER(i4) :: ji8525 !----------------------------------------------------------------8526 8527 var_is_dummy=.FALSE.8528 DO ji=1,ip_maxdum8529 IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN8530 var_is_dummy=.TRUE.8531 EXIT8532 ENDIF8533 ENDDO8534 8535 END FUNCTION var_is_dummy8536 7555 END MODULE var 8537 7556
Note: See TracChangeset
for help on using the changeset viewer.
