New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10251 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/file.f90 – NEMO

Ignore:
Timestamp:
2018-10-29T15:20:26+01:00 (5 years ago)
Author:
kingr
Message:

Rolled back to r10247 - i.e., undid merge of pkg br and 3.6_stable br

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/file.f90

    r10248 r10251  
    137137!> J.Paul 
    138138! REVISION HISTORY: 
    139 !> @date November, 2013 - Initial Version 
    140 !> @date November, 2014  
    141 !> - Fix memory leaks bug 
     139!> @date November, 2013- Initial Version 
     140!> @date November, 2014 - Fix memory leaks bug 
    142141!> 
    143142!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    289288   !>    
    290289   !> @author J.Paul 
    291    !> @date November, 2013 - Initial Version 
     290   !> - November, 2013- Initial Version 
    292291   !> @date November, 2014 
    293    !> - use function instead of overload assignment operator  
     292   !>    - use function instead of overload assignment operator  
    294293   !> (to avoid memory leak) 
    295294   ! 
     
    410409   !>    
    411410   !> @author J.Paul 
    412    !> @date November, 2013 - Initial Version 
     411   !> - November, 2013- Initial Version 
    413412   !> @date November, 2014 
    414    !> - use function instead of overload assignment operator  
     413   !>    - use function instead of overload assignment operator  
    415414   !> (to avoid memory leak) 
    416415   ! 
     
    449448   ! 
    450449   !> @author J.Paul 
    451    !> @date November, 2013 - Initial Version 
     450   !> - November, 2013- Initial Version 
    452451   ! 
    453452   !> @param[in] cd_file   file name 
     
    554553   ! 
    555554   !> @author J.Paul 
    556    !> @date November, 2013 - Initial Version 
     555   !> - November, 2013- Initial Version 
    557556   ! 
    558557   !> @param[in] cd_file   file name 
     
    590589   ! 
    591590   !> @author J.Paul 
    592    !> @date November, 2013 - Initial Version 
     591   !> - November, 2013- Initial Version 
    593592   ! 
    594593   !> @param[in] td_file   file structure 
     
    605604      CHARACTER(LEN=lc) :: cl_dim 
    606605      LOGICAL           :: ll_error 
    607       LOGICAL           :: ll_warn  
    608  
    609       INTEGER(i4)       :: il_ind 
     606 
     607      INTEGER(i4) :: il_ind 
    610608 
    611609      ! loop indices 
     
    616614      ! check used dimension  
    617615      ll_error=.FALSE. 
    618       ll_warn=.FALSE. 
    619616      DO ji=1,ip_maxdim 
    620617         il_ind=dim_get_index( td_file%t_dim(:), & 
     
    622619         &                     TRIM(td_var%t_dim(ji)%c_sname)) 
    623620         IF( il_ind /= 0 )THEN 
    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 
     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 
    634626         ENDIF 
    635627      ENDDO 
    636628 
    637629      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 
    638638 
    639639         cl_dim='(/' 
     
    659659         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 
    660660 
    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.") 
    674661      ELSE 
    675662 
     
    692679   ! 
    693680   !> @author J.Paul 
    694    !> @date November, 2013 - Initial Version 
     681   !> - November, 2013- Initial Version 
    695682   !> @date September, 2014 
    696683   !> - add dimension to file if need be 
     
    720707      IF( TRIM(td_file%c_name) == '' )THEN 
    721708 
     709         CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    722710         CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//& 
    723711         & "running file_add_var" ) 
    724          CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    725712 
    726713      ELSE 
     
    736723               &                                       td_var%c_stdname ) 
    737724            ENDIF 
    738             CALL logger_debug( & 
    739             &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) ) 
     725 
    740726            IF( il_ind /= 0 )THEN 
    741727 
     
    753739            ELSE 
    754740 
    755                CALL logger_debug( & 
     741               CALL logger_trace( & 
    756742               &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//& 
    757743               &  ", standard name "//TRIM(td_var%c_stdname)//& 
     
    784770                        !il_rec=td_file%t_dim(3)%i_len 
    785771                  END SELECT 
     772                  CALL logger_info( & 
     773                     &  " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind))) 
    786774 
    787775                  IF( td_file%i_nvar > 0 )THEN 
     
    818806                        ENDIF 
    819807 
    820                         IF( il_ind < td_file%i_nvar+1 )THEN 
     808                        IF( il_ind < td_file%i_nvar )THEN 
    821809                           ! variable with more dimension than new variable 
    822810                           td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = & 
     
    905893   ! 
    906894   !> @author J.Paul 
    907    !> @date November, 2013 - Initial Version 
    908    !> @date February, 2015  
    909    !> - define local variable structure to avoid mistake with pointer 
     895   !> - November, 2013- Initial Version 
    910896   ! 
    911897   !> @param[inout] td_file   file structure 
     
    921907      ! local variable 
    922908      INTEGER(i4)       :: il_ind 
    923       TYPE(TVAR)        :: tl_var 
    924909      !---------------------------------------------------------------- 
    925910 
     
    943928            IF( il_ind /= 0 )THEN 
    944929    
    945                tl_var=var_copy(td_file%t_var(il_ind)) 
    946                CALL file_del_var(td_file, tl_var) 
     930               CALL file_del_var(td_file, td_file%t_var(il_ind)) 
    947931 
    948932            ELSE 
    949933 
    950                CALL logger_debug( & 
     934               CALL logger_warn( & 
    951935               &  " FILE DEL VAR NAME: there is no variable with name or "//& 
    952936               &  "standard name "//TRIM(cd_name)//" in file "//& 
     
    969953   !> 
    970954   !> @author J.Paul 
    971    !> @date November, 2013 - Initial Version 
     955   !> - November, 2013- Initial Version 
    972956   !> 
    973957   !> @param[inout] td_file   file structure 
     
    11121096   ! 
    11131097   !> @author J.Paul 
    1114    !> @date November, 2013 - Initial Version 
     1098   !> - November, 2013- Initial Version 
    11151099   ! 
    11161100   !> @param[inout] td_file   file structure 
     
    11471131   ! 
    11481132   !> @author J.Paul 
    1149    !> @date November, 2013 - Initial Version 
     1133   !> - November, 2013- Initial Version 
    11501134   ! 
    11511135   !> @param[inout] td_file   file structure 
     
    12631247   ! 
    12641248   !> @author J.Paul 
    1265    !> @date November, 2013 - Initial Version 
    1266    !> @date February, 2015  
    1267    !> - define local attribute structure to avoid mistake 
    1268    !> with pointer 
     1249   !> - November, 2013- Initial Version 
    12691250   ! 
    12701251   !> @param[inout] td_file   file structure 
     
    12801261      ! local variable 
    12811262      INTEGER(i4)       :: il_ind 
    1282       TYPE(TATT)        :: tl_att 
    12831263      !---------------------------------------------------------------- 
    12841264 
     
    13021282            IF( il_ind /= 0 )THEN 
    13031283    
    1304                tl_att=att_copy(td_file%t_att(il_ind)) 
    1305                CALL file_del_att(td_file, tl_att) 
     1284               CALL file_del_att(td_file, td_file%t_att(il_ind)) 
    13061285 
    13071286            ELSE 
    13081287 
    1309                CALL logger_debug( & 
     1288               CALL logger_warn( & 
    13101289               &  " FILE DEL ATT NAME: there is no attribute with name "//& 
    13111290               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name)) 
     
    13261305   ! 
    13271306   !> @author J.Paul 
    1328    !> @date November, 2013 - Initial Version 
     1307   !> - November, 2013- Initial Version 
    13291308   ! 
    13301309   !> @param[inout] td_file   file structure 
     
    14241403   ! 
    14251404   !> @author J.Paul 
    1426    !> @date November, 2013 - Initial Version 
     1405   !> - November, 2013- Initial Version 
    14271406   ! 
    14281407   !> @param[inout] td_file   file structure 
     
    14651444   ! 
    14661445   !> @author J.Paul 
    1467    !> @date November, 2013 - Initial Version 
     1446   !> - November, 2013- Initial Version 
    14681447   !> @date September, 2014 
    14691448   !> - do not reorder dimension, before put in file 
     
    15501529   !> 
    15511530   !> @author J.Paul 
    1552    !> @date November, 2013 - Initial Version 
     1531   !> - November, 2013- Initial Version 
    15531532   ! 
    15541533   !> @param[inout] td_file   file structure 
     
    16301609   ! 
    16311610   !> @author J.Paul 
    1632    !> @date November, 2013 - Initial Version 
     1611   !> - November, 2013- Initial Version 
    16331612   ! 
    16341613   !> @param[inout] td_file   file structure 
     
    16731652   ! 
    16741653   !> @author J.Paul 
    1675    !> @date November, 2013 - Initial Version 
     1654   !> - November, 2013- Initial Version 
    16761655   ! 
    16771656   !> @param[in] td_file   file structure 
     
    17381717         WRITE(*,'(/a)') " File variable" 
    17391718         DO ji=1,td_file%i_nvar 
    1740             CALL var_print(td_file%t_var(ji),.FALSE.) 
     1719            CALL var_print(td_file%t_var(ji))!,.FALSE.) 
    17411720         ENDDO 
    17421721      ENDIF 
     
    17511730   ! 
    17521731   !> @author J.Paul 
    1753    !> @date November, 2013 - Initial Version 
     1732   !> - November, 2013- Initial Version 
    17541733   ! 
    17551734   !> @param[in] cd_file   file structure 
     
    17901769   ! 
    17911770   !> @author J.Paul 
    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) 
     1771   !> - November, 2013- Initial Version 
    17981772   ! 
    17991773   !> @param[in] cd_file   file name (without suffix) 
     
    18291803         IF( .NOT. fct_is_num(file__get_number(2:)) )THEN 
    18301804            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='' 
    18371805         ENDIF 
    18381806      ELSE 
     
    18481816   ! 
    18491817   !> @author J.Paul 
    1850    !> @date November, 2013 - Initial Version 
     1818   !> - November, 2013- Initial Version 
    18511819   ! 
    18521820   !> @param[in] td_file   file structure 
     
    19111879   ! 
    19121880   !> @author J.Paul 
    1913    !> @date November, 2013 - Initial Version 
     1881   !> - November, 2013- Initial Version 
    19141882   ! 
    19151883   !> @param[in] td_file   file structure 
     
    19381906   ! 
    19391907   !> @author J.Paul 
    1940    !> @date November, 2013 - Initial Version 
     1908   !> - November, 2013- Initial Version 
    19411909   ! 
    19421910   !> @param[in] td_file   file structure 
     
    20512019   ! 
    20522020   !> @author J.Paul 
    2053    !> @date November, 2013 - Initial Version 
     2021   !> - November, 2013- Initial Version 
    20542022   ! 
    20552023   !> @param[in] td_file   array of file structure 
     
    20892057   !>  
    20902058   !> @author J.Paul 
    2091    !> @date September, 2014 - Initial Version 
     2059   !> - September, 2014- Initial Version 
    20922060   ! 
    20932061   !> @param[in] td_file   array of file  
Note: See TracChangeset for help on using the changeset viewer.