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 5956 for branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/TOOLS/SIREN/src/file.f90 – NEMO

Ignore:
Timestamp:
2015-11-30T20:55:41+01:00 (8 years ago)
Author:
mathiot
Message:

ISF : merged trunk (5936) into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/TOOLS/SIREN/src/file.f90

    r5037 r5956  
    137137!> J.Paul 
    138138! 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 
    141142!> 
    142143!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    288289   !>    
    289290   !> @author J.Paul 
    290    !> - November, 2013- Initial Version 
     291   !> @date November, 2013 - Initial Version 
    291292   !> @date November, 2014 
    292    !>    - use function instead of overload assignment operator  
     293   !> - use function instead of overload assignment operator  
    293294   !> (to avoid memory leak) 
    294295   ! 
     
    409410   !>    
    410411   !> @author J.Paul 
    411    !> - November, 2013- Initial Version 
     412   !> @date November, 2013 - Initial Version 
    412413   !> @date November, 2014 
    413    !>    - use function instead of overload assignment operator  
     414   !> - use function instead of overload assignment operator  
    414415   !> (to avoid memory leak) 
    415416   ! 
     
    448449   ! 
    449450   !> @author J.Paul 
    450    !> - November, 2013- Initial Version 
     451   !> @date November, 2013 - Initial Version 
    451452   ! 
    452453   !> @param[in] cd_file   file name 
     
    553554   ! 
    554555   !> @author J.Paul 
    555    !> - November, 2013- Initial Version 
     556   !> @date November, 2013 - Initial Version 
    556557   ! 
    557558   !> @param[in] cd_file   file name 
     
    589590   ! 
    590591   !> @author J.Paul 
    591    !> - November, 2013- Initial Version 
     592   !> @date November, 2013 - Initial Version 
    592593   ! 
    593594   !> @param[in] td_file   file structure 
     
    604605      CHARACTER(LEN=lc) :: cl_dim 
    605606      LOGICAL           :: ll_error 
    606  
    607       INTEGER(i4) :: il_ind 
     607      LOGICAL           :: ll_warn  
     608 
     609      INTEGER(i4)       :: il_ind 
    608610 
    609611      ! loop indices 
     
    614616      ! check used dimension  
    615617      ll_error=.FALSE. 
     618      ll_warn=.FALSE. 
    616619      DO ji=1,ip_maxdim 
    617620         il_ind=dim_get_index( td_file%t_dim(:), & 
     
    619622         &                     TRIM(td_var%t_dim(ji)%c_sname)) 
    620623         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 
    626634         ENDIF 
    627635      ENDDO 
    628636 
    629637      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.") 
    661674      ELSE 
    662675 
     
    679692   ! 
    680693   !> @author J.Paul 
    681    !> - November, 2013- Initial Version 
     694   !> @date November, 2013 - Initial Version 
    682695   !> @date September, 2014 
    683696   !> - add dimension to file if need be 
     
    707720      IF( TRIM(td_file%c_name) == '' )THEN 
    708721 
    709          CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    710722         CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//& 
    711723         & "running file_add_var" ) 
     724         CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    712725 
    713726      ELSE 
     
    723736               &                                       td_var%c_stdname ) 
    724737            ENDIF 
    725  
     738            CALL logger_debug( & 
     739            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) ) 
    726740            IF( il_ind /= 0 )THEN 
    727741 
     
    739753            ELSE 
    740754 
    741                CALL logger_trace( & 
     755               CALL logger_debug( & 
    742756               &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//& 
    743757               &  ", standard name "//TRIM(td_var%c_stdname)//& 
     
    770784                        !il_rec=td_file%t_dim(3)%i_len 
    771785                  END SELECT 
    772                   CALL logger_info( & 
    773                      &  " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind))) 
    774786 
    775787                  IF( td_file%i_nvar > 0 )THEN 
     
    806818                        ENDIF 
    807819 
    808                         IF( il_ind < td_file%i_nvar )THEN 
     820                        IF( il_ind < td_file%i_nvar+1 )THEN 
    809821                           ! variable with more dimension than new variable 
    810822                           td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = & 
     
    893905   ! 
    894906   !> @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 
    896910   ! 
    897911   !> @param[inout] td_file   file structure 
     
    907921      ! local variable 
    908922      INTEGER(i4)       :: il_ind 
     923      TYPE(TVAR)        :: tl_var 
    909924      !---------------------------------------------------------------- 
    910925 
     
    928943            IF( il_ind /= 0 )THEN 
    929944    
    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) 
    931947 
    932948            ELSE 
    933949 
    934                CALL logger_warn( & 
     950               CALL logger_debug( & 
    935951               &  " FILE DEL VAR NAME: there is no variable with name or "//& 
    936952               &  "standard name "//TRIM(cd_name)//" in file "//& 
     
    953969   !> 
    954970   !> @author J.Paul 
    955    !> - November, 2013- Initial Version 
     971   !> @date November, 2013 - Initial Version 
    956972   !> 
    957973   !> @param[inout] td_file   file structure 
     
    10961112   ! 
    10971113   !> @author J.Paul 
    1098    !> - November, 2013- Initial Version 
     1114   !> @date November, 2013 - Initial Version 
    10991115   ! 
    11001116   !> @param[inout] td_file   file structure 
     
    11311147   ! 
    11321148   !> @author J.Paul 
    1133    !> - November, 2013- Initial Version 
     1149   !> @date November, 2013 - Initial Version 
    11341150   ! 
    11351151   !> @param[inout] td_file   file structure 
     
    12471263   ! 
    12481264   !> @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 
    12501269   ! 
    12511270   !> @param[inout] td_file   file structure 
     
    12611280      ! local variable 
    12621281      INTEGER(i4)       :: il_ind 
     1282      TYPE(TATT)        :: tl_att 
    12631283      !---------------------------------------------------------------- 
    12641284 
     
    12821302            IF( il_ind /= 0 )THEN 
    12831303    
    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) 
    12851306 
    12861307            ELSE 
    12871308 
    1288                CALL logger_warn( & 
     1309               CALL logger_debug( & 
    12891310               &  " FILE DEL ATT NAME: there is no attribute with name "//& 
    12901311               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name)) 
     
    13051326   ! 
    13061327   !> @author J.Paul 
    1307    !> - November, 2013- Initial Version 
     1328   !> @date November, 2013 - Initial Version 
    13081329   ! 
    13091330   !> @param[inout] td_file   file structure 
     
    14031424   ! 
    14041425   !> @author J.Paul 
    1405    !> - November, 2013- Initial Version 
     1426   !> @date November, 2013 - Initial Version 
    14061427   ! 
    14071428   !> @param[inout] td_file   file structure 
     
    14441465   ! 
    14451466   !> @author J.Paul 
    1446    !> - November, 2013- Initial Version 
     1467   !> @date November, 2013 - Initial Version 
    14471468   !> @date September, 2014 
    14481469   !> - do not reorder dimension, before put in file 
     
    15291550   !> 
    15301551   !> @author J.Paul 
    1531    !> - November, 2013- Initial Version 
     1552   !> @date November, 2013 - Initial Version 
    15321553   ! 
    15331554   !> @param[inout] td_file   file structure 
     
    16091630   ! 
    16101631   !> @author J.Paul 
    1611    !> - November, 2013- Initial Version 
     1632   !> @date November, 2013 - Initial Version 
    16121633   ! 
    16131634   !> @param[inout] td_file   file structure 
     
    16521673   ! 
    16531674   !> @author J.Paul 
    1654    !> - November, 2013- Initial Version 
     1675   !> @date November, 2013 - Initial Version 
    16551676   ! 
    16561677   !> @param[in] td_file   file structure 
     
    17171738         WRITE(*,'(/a)') " File variable" 
    17181739         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.) 
    17201741         ENDDO 
    17211742      ENDIF 
     
    17301751   ! 
    17311752   !> @author J.Paul 
    1732    !> - November, 2013- Initial Version 
     1753   !> @date November, 2013 - Initial Version 
    17331754   ! 
    17341755   !> @param[in] cd_file   file structure 
     
    17691790   ! 
    17701791   !> @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) 
    17721798   ! 
    17731799   !> @param[in] cd_file   file name (without suffix) 
     
    18031829         IF( .NOT. fct_is_num(file__get_number(2:)) )THEN 
    18041830            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='' 
    18051837         ENDIF 
    18061838      ELSE 
     
    18161848   ! 
    18171849   !> @author J.Paul 
    1818    !> - November, 2013- Initial Version 
     1850   !> @date November, 2013 - Initial Version 
    18191851   ! 
    18201852   !> @param[in] td_file   file structure 
     
    18791911   ! 
    18801912   !> @author J.Paul 
    1881    !> - November, 2013- Initial Version 
     1913   !> @date November, 2013 - Initial Version 
    18821914   ! 
    18831915   !> @param[in] td_file   file structure 
     
    19061938   ! 
    19071939   !> @author J.Paul 
    1908    !> - November, 2013- Initial Version 
     1940   !> @date November, 2013 - Initial Version 
    19091941   ! 
    19101942   !> @param[in] td_file   file structure 
     
    20192051   ! 
    20202052   !> @author J.Paul 
    2021    !> - November, 2013- Initial Version 
     2053   !> @date November, 2013 - Initial Version 
    20222054   ! 
    20232055   !> @param[in] td_file   array of file structure 
     
    20572089   !>  
    20582090   !> @author J.Paul 
    2059    !> - September, 2014- Initial Version 
     2091   !> @date September, 2014 - Initial Version 
    20602092   ! 
    20612093   !> @param[in] td_file   array of file  
Note: See TracChangeset for help on using the changeset viewer.