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 6440 for branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/file.f90 – NEMO

Ignore:
Timestamp:
2016-04-07T16:32:24+02:00 (8 years ago)
Author:
dancopsey
Message:

Merged in nemo_v3_6_STABLE_copy up to revision 6436.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/file.f90

    r5037 r6440  
    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 
    683    !> - add dimension to file if need be 
     696   !> - add dimension in file if need be 
    684697   !> - do not reorder dimension from variable, before put in file 
     698   !> @date September, 2015 
     699   !> - check variable dimension expected 
    685700   ! 
    686701   !> @param[inout] td_file   file structure 
    … …  
    692707      ! Argument       
    693708      TYPE(TFILE), INTENT(INOUT) :: td_file 
    694       TYPE(TVAR) , INTENT(IN   ) :: td_var 
     709      TYPE(TVAR) , INTENT(INOUT) :: td_var 
    695710 
    696711      ! local variable 
    … …  
    707722      IF( TRIM(td_file%c_name) == '' )THEN 
    708723 
    709          CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    710724         CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//& 
    711725         & "running file_add_var" ) 
     726         CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    712727 
    713728      ELSE 
    … …  
    723738               &                                       td_var%c_stdname ) 
    724739            ENDIF 
    725  
     740            CALL logger_debug( & 
     741            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) ) 
    726742            IF( il_ind /= 0 )THEN 
    727743 
    … …  
    739755            ELSE 
    740756 
    741                CALL logger_trace( & 
     757               CALL logger_debug( & 
    742758               &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//& 
    743759               &  ", standard name "//TRIM(td_var%c_stdname)//& 
    … …  
    746762               ! check used dimension  
    747763               IF( file_check_var_dim(td_file, td_var) )THEN 
     764 
     765                  ! check variable dimension expected 
     766                  CALL var_check_dim(td_var) 
    748767 
    749768                  ! update dimension if need be 
    … …  
    770789                        !il_rec=td_file%t_dim(3)%i_len 
    771790                  END SELECT 
    772                   CALL logger_info( & 
    773                      &  " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind))) 
    774791 
    775792                  IF( td_file%i_nvar > 0 )THEN 
    … …  
    806823                        ENDIF 
    807824 
    808                         IF( il_ind < td_file%i_nvar )THEN 
     825                        IF( il_ind < td_file%i_nvar+1 )THEN 
    809826                           ! variable with more dimension than new variable 
    810827                           td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = & 
    … …  
    893910   ! 
    894911   !> @author J.Paul 
    895    !> - November, 2013- Initial Version 
     912   !> @date November, 2013 - Initial Version 
     913   !> @date February, 2015  
     914   !> - define local variable structure to avoid mistake with pointer 
    896915   ! 
    897916   !> @param[inout] td_file   file structure 
    … …  
    907926      ! local variable 
    908927      INTEGER(i4)       :: il_ind 
     928      TYPE(TVAR)        :: tl_var 
    909929      !---------------------------------------------------------------- 
    910930 
    … …  
    928948            IF( il_ind /= 0 )THEN 
    929949    
    930                CALL file_del_var(td_file, td_file%t_var(il_ind)) 
     950               tl_var=var_copy(td_file%t_var(il_ind)) 
     951               CALL file_del_var(td_file, tl_var) 
    931952 
    932953            ELSE 
    933954 
    934                CALL logger_warn( & 
     955               CALL logger_debug( & 
    935956               &  " FILE DEL VAR NAME: there is no variable with name or "//& 
    936957               &  "standard name "//TRIM(cd_name)//" in file "//& 
    … …  
    953974   !> 
    954975   !> @author J.Paul 
    955    !> - November, 2013- Initial Version 
     976   !> @date November, 2013 - Initial Version 
    956977   !> 
    957978   !> @param[inout] td_file   file structure 
    … …  
    10341055                  ! new number of variable in file 
    10351056                  td_file%i_nvar=td_file%i_nvar-1 
    1036  
    10371057                  SELECT CASE(td_var%i_ndim) 
    10381058                     CASE(0) 
    … …  
    10961116   ! 
    10971117   !> @author J.Paul 
    1098    !> - November, 2013- Initial Version 
     1118   !> @date November, 2013 - Initial Version 
    10991119   ! 
    11001120   !> @param[inout] td_file   file structure 
    … …  
    11311151   ! 
    11321152   !> @author J.Paul 
    1133    !> - November, 2013- Initial Version 
     1153   !> @date November, 2013 - Initial Version 
    11341154   ! 
    11351155   !> @param[inout] td_file   file structure 
    … …  
    12471267   ! 
    12481268   !> @author J.Paul 
    1249    !> - November, 2013- Initial Version 
     1269   !> @date November, 2013 - Initial Version 
     1270   !> @date February, 2015  
     1271   !> - define local attribute structure to avoid mistake 
     1272   !> with pointer 
    12501273   ! 
    12511274   !> @param[inout] td_file   file structure 
    … …  
    12611284      ! local variable 
    12621285      INTEGER(i4)       :: il_ind 
     1286      TYPE(TATT)        :: tl_att 
    12631287      !---------------------------------------------------------------- 
    12641288 
    … …  
    12821306            IF( il_ind /= 0 )THEN 
    12831307    
    1284                CALL file_del_att(td_file, td_file%t_att(il_ind)) 
     1308               tl_att=att_copy(td_file%t_att(il_ind)) 
     1309               CALL file_del_att(td_file, tl_att) 
    12851310 
    12861311            ELSE 
    12871312 
    1288                CALL logger_warn( & 
     1313               CALL logger_debug( & 
    12891314               &  " FILE DEL ATT NAME: there is no attribute with name "//& 
    12901315               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name)) 
    … …  
    13051330   ! 
    13061331   !> @author J.Paul 
    1307    !> - November, 2013- Initial Version 
     1332   !> @date November, 2013 - Initial Version 
    13081333   ! 
    13091334   !> @param[inout] td_file   file structure 
    … …  
    14031428   ! 
    14041429   !> @author J.Paul 
    1405    !> - November, 2013- Initial Version 
     1430   !> @date November, 2013 - Initial Version 
    14061431   ! 
    14071432   !> @param[inout] td_file   file structure 
    … …  
    14441469   ! 
    14451470   !> @author J.Paul 
    1446    !> - November, 2013- Initial Version 
     1471   !> @date November, 2013 - Initial Version 
    14471472   !> @date September, 2014 
    14481473   !> - do not reorder dimension, before put in file 
    … …  
    15291554   !> 
    15301555   !> @author J.Paul 
    1531    !> - November, 2013- Initial Version 
     1556   !> @date November, 2013 - Initial Version 
    15321557   ! 
    15331558   !> @param[inout] td_file   file structure 
    … …  
    16091634   ! 
    16101635   !> @author J.Paul 
    1611    !> - November, 2013- Initial Version 
     1636   !> @date November, 2013 - Initial Version 
    16121637   ! 
    16131638   !> @param[inout] td_file   file structure 
    … …  
    16521677   ! 
    16531678   !> @author J.Paul 
    1654    !> - November, 2013- Initial Version 
     1679   !> @date November, 2013 - Initial Version 
    16551680   ! 
    16561681   !> @param[in] td_file   file structure 
    … …  
    17171742         WRITE(*,'(/a)') " File variable" 
    17181743         DO ji=1,td_file%i_nvar 
    1719             CALL var_print(td_file%t_var(ji))!,.FALSE.) 
     1744            CALL var_print(td_file%t_var(ji),.FALSE.) 
    17201745         ENDDO 
    17211746      ENDIF 
    … …  
    17301755   ! 
    17311756   !> @author J.Paul 
    1732    !> - November, 2013- Initial Version 
     1757   !> @date November, 2013 - Initial Version 
    17331758   ! 
    17341759   !> @param[in] cd_file   file structure 
    … …  
    17691794   ! 
    17701795   !> @author J.Paul 
    1771    !> - November, 2013- Initial Version 
     1796   !> @date November, 2013 - Initial Version 
     1797   !> @date February, 2015  
     1798   !> - add case to not return date (yyyymmdd) at the end of filename 
     1799   !> @date February, 2015  
     1800   !> - add case to not return release number 
     1801   !> we assume release number only on one digit (ex : file_v3.5.nc) 
    17721802   ! 
    17731803   !> @param[in] cd_file   file name (without suffix) 
    … …  
    18031833         IF( .NOT. fct_is_num(file__get_number(2:)) )THEN 
    18041834            file__get_number='' 
     1835         ELSEIF( LEN(TRIM(file__get_number))-1 == 8 )THEN 
     1836            ! date case yyyymmdd 
     1837            file__get_number='' 
     1838         ELSEIF( LEN(TRIM(file__get_number))-1 == 1 )THEN 
     1839            ! release number case  
     1840            file__get_number='' 
    18051841         ENDIF 
    18061842      ELSE 
    … …  
    18161852   ! 
    18171853   !> @author J.Paul 
    1818    !> - November, 2013- Initial Version 
     1854   !> @date November, 2013 - Initial Version 
    18191855   ! 
    18201856   !> @param[in] td_file   file structure 
    … …  
    18791915   ! 
    18801916   !> @author J.Paul 
    1881    !> - November, 2013- Initial Version 
     1917   !> @date November, 2013 - Initial Version 
    18821918   ! 
    18831919   !> @param[in] td_file   file structure 
    … …  
    19061942   ! 
    19071943   !> @author J.Paul 
    1908    !> - November, 2013- Initial Version 
     1944   !> @date November, 2013 - Initial Version 
    19091945   ! 
    19101946   !> @param[in] td_file   file structure 
    … …  
    20192055   ! 
    20202056   !> @author J.Paul 
    2021    !> - November, 2013- Initial Version 
     2057   !> @date November, 2013 - Initial Version 
    20222058   ! 
    20232059   !> @param[in] td_file   array of file structure 
    … …  
    20572093   !>  
    20582094   !> @author J.Paul 
    2059    !> - September, 2014- Initial Version 
     2095   !> @date September, 2014 - Initial Version 
    20602096   ! 
    20612097   !> @param[in] td_file   array of file  
Note: See TracChangeset for help on using the changeset viewer.