- Timestamp:
- 2018-10-29T11:44:36+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/file.f90
r5037 r10248 137 137 !> J.Paul 138 138 ! REVISION HISTORY: 139 !> @date November, 2013- Initial Version 140 !> @date November, 2014 - Fix memory leaks bug 139 !> @date November, 2013 - Initial Version 140 !> @date November, 2014 141 !> - Fix memory leaks bug 141 142 !> 142 143 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 288 289 !> 289 290 !> @author J.Paul 290 !> - November, 2013- Initial Version291 !> @date November, 2013 - Initial Version 291 292 !> @date November, 2014 292 !> 293 !> - use function instead of overload assignment operator 293 294 !> (to avoid memory leak) 294 295 ! … … 409 410 !> 410 411 !> @author J.Paul 411 !> - November, 2013- Initial Version412 !> @date November, 2013 - Initial Version 412 413 !> @date November, 2014 413 !> 414 !> - use function instead of overload assignment operator 414 415 !> (to avoid memory leak) 415 416 ! … … 448 449 ! 449 450 !> @author J.Paul 450 !> - November, 2013- Initial Version451 !> @date November, 2013 - Initial Version 451 452 ! 452 453 !> @param[in] cd_file file name … … 553 554 ! 554 555 !> @author J.Paul 555 !> - November, 2013- Initial Version556 !> @date November, 2013 - Initial Version 556 557 ! 557 558 !> @param[in] cd_file file name … … 589 590 ! 590 591 !> @author J.Paul 591 !> - November, 2013- Initial Version592 !> @date November, 2013 - Initial Version 592 593 ! 593 594 !> @param[in] td_file file structure … … 604 605 CHARACTER(LEN=lc) :: cl_dim 605 606 LOGICAL :: ll_error 606 607 INTEGER(i4) :: il_ind 607 LOGICAL :: ll_warn 608 609 INTEGER(i4) :: il_ind 608 610 609 611 ! loop indices … … 614 616 ! check used dimension 615 617 ll_error=.FALSE. 618 ll_warn=.FALSE. 616 619 DO ji=1,ip_maxdim 617 620 il_ind=dim_get_index( td_file%t_dim(:), & … … 619 622 & TRIM(td_var%t_dim(ji)%c_sname)) 620 623 IF( il_ind /= 0 )THEN 621 IF( td_var%t_dim(ji)%l_use .AND. & 622 & td_file%t_dim(il_ind)%l_use .AND. & 623 & td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN 624 ll_error=.TRUE. 625 ENDIF 624 IF( td_var%t_dim(ji)%l_use .AND. & 625 & td_file%t_dim(il_ind)%l_use .AND. & 626 & td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN 627 IF( INDEX( TRIM(td_var%c_axis), & 628 & TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN 629 ll_warn=.TRUE. 630 ELSE 631 ll_error=.TRUE. 632 ENDIF 633 ENDIF 626 634 ENDIF 627 635 ENDDO 628 636 629 637 IF( ll_error )THEN 630 631 file_check_var_dim=.FALSE.632 633 CALL logger_error( &634 & " FILE CHECK VAR DIM: variable and file dimension differ"//&635 & " for variable "//TRIM(td_var%c_name)//&636 & " and file "//TRIM(td_file%c_name))637 638 638 639 639 cl_dim='(/' … … 659 659 CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 660 660 661 file_check_var_dim=.FALSE. 662 663 CALL logger_error( & 664 & " FILE CHECK VAR DIM: variable and file dimension differ"//& 665 & " for variable "//TRIM(td_var%c_name)//& 666 & " and file "//TRIM(td_file%c_name)) 667 668 ELSEIF( ll_warn )THEN 669 CALL logger_warn( & 670 & " FILE CHECK VAR DIM: variable and file dimension differ"//& 671 & " for variable "//TRIM(td_var%c_name)//& 672 & " and file "//TRIM(td_file%c_name)//". you should use"//& 673 & " var_check_dim to remove useless dimension.") 661 674 ELSE 662 675 … … 679 692 ! 680 693 !> @author J.Paul 681 !> - November, 2013- Initial Version694 !> @date November, 2013 - Initial Version 682 695 !> @date September, 2014 683 696 !> - add dimension to file if need be … … 707 720 IF( TRIM(td_file%c_name) == '' )THEN 708 721 709 CALL logger_error( " FILE ADD VAR: structure file unknown" )710 722 CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//& 711 723 & "running file_add_var" ) 724 CALL logger_error( " FILE ADD VAR: structure file unknown" ) 712 725 713 726 ELSE … … 723 736 & td_var%c_stdname ) 724 737 ENDIF 725 738 CALL logger_debug( & 739 & " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) ) 726 740 IF( il_ind /= 0 )THEN 727 741 … … 739 753 ELSE 740 754 741 CALL logger_ trace( &755 CALL logger_debug( & 742 756 & " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//& 743 757 & ", standard name "//TRIM(td_var%c_stdname)//& … … 770 784 !il_rec=td_file%t_dim(3)%i_len 771 785 END SELECT 772 CALL logger_info( &773 & " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind)))774 786 775 787 IF( td_file%i_nvar > 0 )THEN … … 806 818 ENDIF 807 819 808 IF( il_ind < td_file%i_nvar )THEN820 IF( il_ind < td_file%i_nvar+1 )THEN 809 821 ! variable with more dimension than new variable 810 822 td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = & … … 893 905 ! 894 906 !> @author J.Paul 895 !> - November, 2013- Initial Version 907 !> @date November, 2013 - Initial Version 908 !> @date February, 2015 909 !> - define local variable structure to avoid mistake with pointer 896 910 ! 897 911 !> @param[inout] td_file file structure … … 907 921 ! local variable 908 922 INTEGER(i4) :: il_ind 923 TYPE(TVAR) :: tl_var 909 924 !---------------------------------------------------------------- 910 925 … … 928 943 IF( il_ind /= 0 )THEN 929 944 930 CALL file_del_var(td_file, td_file%t_var(il_ind)) 945 tl_var=var_copy(td_file%t_var(il_ind)) 946 CALL file_del_var(td_file, tl_var) 931 947 932 948 ELSE 933 949 934 CALL logger_ warn( &950 CALL logger_debug( & 935 951 & " FILE DEL VAR NAME: there is no variable with name or "//& 936 952 & "standard name "//TRIM(cd_name)//" in file "//& … … 953 969 !> 954 970 !> @author J.Paul 955 !> - November, 2013- Initial Version971 !> @date November, 2013 - Initial Version 956 972 !> 957 973 !> @param[inout] td_file file structure … … 1096 1112 ! 1097 1113 !> @author J.Paul 1098 !> - November, 2013- Initial Version1114 !> @date November, 2013 - Initial Version 1099 1115 ! 1100 1116 !> @param[inout] td_file file structure … … 1131 1147 ! 1132 1148 !> @author J.Paul 1133 !> - November, 2013- Initial Version1149 !> @date November, 2013 - Initial Version 1134 1150 ! 1135 1151 !> @param[inout] td_file file structure … … 1247 1263 ! 1248 1264 !> @author J.Paul 1249 !> - November, 2013- Initial Version 1265 !> @date November, 2013 - Initial Version 1266 !> @date February, 2015 1267 !> - define local attribute structure to avoid mistake 1268 !> with pointer 1250 1269 ! 1251 1270 !> @param[inout] td_file file structure … … 1261 1280 ! local variable 1262 1281 INTEGER(i4) :: il_ind 1282 TYPE(TATT) :: tl_att 1263 1283 !---------------------------------------------------------------- 1264 1284 … … 1282 1302 IF( il_ind /= 0 )THEN 1283 1303 1284 CALL file_del_att(td_file, td_file%t_att(il_ind)) 1304 tl_att=att_copy(td_file%t_att(il_ind)) 1305 CALL file_del_att(td_file, tl_att) 1285 1306 1286 1307 ELSE 1287 1308 1288 CALL logger_ warn( &1309 CALL logger_debug( & 1289 1310 & " FILE DEL ATT NAME: there is no attribute with name "//& 1290 1311 & TRIM(cd_name)//" in file "//TRIM(td_file%c_name)) … … 1305 1326 ! 1306 1327 !> @author J.Paul 1307 !> - November, 2013- Initial Version1328 !> @date November, 2013 - Initial Version 1308 1329 ! 1309 1330 !> @param[inout] td_file file structure … … 1403 1424 ! 1404 1425 !> @author J.Paul 1405 !> - November, 2013- Initial Version1426 !> @date November, 2013 - Initial Version 1406 1427 ! 1407 1428 !> @param[inout] td_file file structure … … 1444 1465 ! 1445 1466 !> @author J.Paul 1446 !> - November, 2013- Initial Version1467 !> @date November, 2013 - Initial Version 1447 1468 !> @date September, 2014 1448 1469 !> - do not reorder dimension, before put in file … … 1529 1550 !> 1530 1551 !> @author J.Paul 1531 !> - November, 2013- Initial Version1552 !> @date November, 2013 - Initial Version 1532 1553 ! 1533 1554 !> @param[inout] td_file file structure … … 1609 1630 ! 1610 1631 !> @author J.Paul 1611 !> - November, 2013- Initial Version1632 !> @date November, 2013 - Initial Version 1612 1633 ! 1613 1634 !> @param[inout] td_file file structure … … 1652 1673 ! 1653 1674 !> @author J.Paul 1654 !> - November, 2013- Initial Version1675 !> @date November, 2013 - Initial Version 1655 1676 ! 1656 1677 !> @param[in] td_file file structure … … 1717 1738 WRITE(*,'(/a)') " File variable" 1718 1739 DO ji=1,td_file%i_nvar 1719 CALL var_print(td_file%t_var(ji) )!,.FALSE.)1740 CALL var_print(td_file%t_var(ji),.FALSE.) 1720 1741 ENDDO 1721 1742 ENDIF … … 1730 1751 ! 1731 1752 !> @author J.Paul 1732 !> - November, 2013- Initial Version1753 !> @date November, 2013 - Initial Version 1733 1754 ! 1734 1755 !> @param[in] cd_file file structure … … 1769 1790 ! 1770 1791 !> @author J.Paul 1771 !> - November, 2013- Initial Version 1792 !> @date November, 2013 - Initial Version 1793 !> @date February, 2015 1794 !> - add case to not return date (yyyymmdd) at the end of filename 1795 !> @date February, 2015 1796 !> - add case to not return release number 1797 !> we assume release number only on one digit (ex : file_v3.5.nc) 1772 1798 ! 1773 1799 !> @param[in] cd_file file name (without suffix) … … 1803 1829 IF( .NOT. fct_is_num(file__get_number(2:)) )THEN 1804 1830 file__get_number='' 1831 ELSEIF( LEN(TRIM(file__get_number))-1 == 8 )THEN 1832 ! date case yyyymmdd 1833 file__get_number='' 1834 ELSEIF( LEN(TRIM(file__get_number))-1 == 1 )THEN 1835 ! release number case 1836 file__get_number='' 1805 1837 ENDIF 1806 1838 ELSE … … 1816 1848 ! 1817 1849 !> @author J.Paul 1818 !> - November, 2013- Initial Version1850 !> @date November, 2013 - Initial Version 1819 1851 ! 1820 1852 !> @param[in] td_file file structure … … 1879 1911 ! 1880 1912 !> @author J.Paul 1881 !> - November, 2013- Initial Version1913 !> @date November, 2013 - Initial Version 1882 1914 ! 1883 1915 !> @param[in] td_file file structure … … 1906 1938 ! 1907 1939 !> @author J.Paul 1908 !> - November, 2013- Initial Version1940 !> @date November, 2013 - Initial Version 1909 1941 ! 1910 1942 !> @param[in] td_file file structure … … 2019 2051 ! 2020 2052 !> @author J.Paul 2021 !> - November, 2013- Initial Version2053 !> @date November, 2013 - Initial Version 2022 2054 ! 2023 2055 !> @param[in] td_file array of file structure … … 2057 2089 !> 2058 2090 !> @author J.Paul 2059 !> - September, 2014- Initial Version2091 !> @date September, 2014 - Initial Version 2060 2092 ! 2061 2093 !> @param[in] td_file array of file
Note: See TracChangeset
for help on using the changeset viewer.