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 7731 for branches/UKMO/dev_r5518_v3.6_asm_nemovar_community/NEMOGCM/TOOLS/SIREN/src/variable.f90 – NEMO

Ignore:
Timestamp:
2017-02-23T14:23:32+01:00 (7 years ago)
Author:
dford
Message:

Merge in revisions 6625:7726 of dev_r5518_v3.4_asm_nemovar_community, so this branch will be identical to revison 7726 of dev_r5518_v3.6_asm_nemovar_community.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_v3.6_asm_nemovar_community/NEMOGCM/TOOLS/SIREN/src/variable.f90

    r5037 r7731  
    281281!> @date November, 2014  
    282282!> - Fix memory leaks bug 
     283!> @date June, 2015 
     284!> - change way to get variable information in namelist 
     285!> @date July, 2015  
     286!> - add subroutine var_chg_unit to change unit of output variable 
    283287! 
    284288!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    293297   USE att                             ! attribute manager 
    294298   USE dim                             ! dimension manager 
     299   USE math                            ! mathematical function 
    295300   IMPLICIT NONE 
    296301   ! NOTE_avoid_public_variables_if_possible 
     
    318323   PUBLIC :: var_concat        !< concatenate two variables 
    319324   PUBLIC :: var_limit_value   !< forced min and max value 
     325   PUBLIC :: var_chg_unit      !< change variable unit and value 
    320326   PUBLIC :: var_max_dim       !< get array of maximum dimension use 
    321327   PUBLIC :: var_reorder       !< reorder table of value in variable structure 
     
    382388   PRIVATE :: var__get_max       ! get maximum value from namelist  
    383389   PRIVATE :: var__get_min       ! get minimum value from namelist 
     390   PRIVATE :: var__get_unf       ! get scale factor value from namelist 
     391   PRIVATE :: var__get_unt       ! get unit from namelist 
    384392   PRIVATE :: var__get_interp    ! get interpolation method from namelist 
    385393   PRIVATE :: var__get_extrap    ! get extrapolation method from namelist 
     
    401409      TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes 
    402410      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension 
    403        
     411  
    404412      LOGICAL           :: l_file = .FALSE.  !< variable read in a file 
    405413 
     
    414422      REAL(dp)          :: d_min = dp_fill      !< minimum value  
    415423      REAL(dp)          :: d_max = dp_fill      !< maximum value  
    416        
     424  
     425      CHARACTER(LEN=lc) :: c_unt = ''           !< new variables units (linked to units factor) 
     426      REAL(dp)          :: d_unf = 1._dp        !< units factor 
     427 
    417428      !!! netcdf4 
    418429      LOGICAL           :: l_contiguous = .FALSE. !< use contiguous storage or not 
     
    518529   !> 
    519530   !> @author J.Paul 
    520    !> - November, 2013- Initial Version 
     531   !> @date November, 2013 - Initial Version 
    521532   !> @date November, 2014 
    522533   !> - use function instead of overload assignment operator (to avoid memory leak) 
     
    548559      var__copy_unit%d_min      = td_var%d_min 
    549560      var__copy_unit%d_max      = td_var%d_max 
     561 
     562      var__copy_unit%c_unt      = TRIM(td_var%c_unt) 
     563      var__copy_unit%d_unf      = td_var%d_unf 
    550564 
    551565      var__copy_unit%i_type     = td_var%i_type 
     
    577591      var__copy_unit%c_units    = TRIM(td_var%c_units) 
    578592      var__copy_unit%c_axis     = TRIM(td_var%c_axis) 
     593      var__copy_unit%d_unf      = td_var%d_unf 
    579594      var__copy_unit%d_scf      = td_var%d_scf 
    580595      var__copy_unit%d_ofs      = td_var%d_ofs 
     
    627642   !> 
    628643   !> @author J.Paul 
    629    !> - November, 2013- Initial Version 
     644   !> @date November, 2013 - Initial Version 
    630645   !> @date November, 2014 
    631646   !> - use function instead of overload assignment operator  
     
    656671   !> 
    657672   !> @author J.Paul 
    658    !> - November, 2013- Initial Version 
     673   !> @date November, 2013 - Initial Version 
    659674   !> 
    660675   !> @param[inout] td_var variable strucutre 
     
    695710   ! 
    696711   !> @author J.Paul 
    697    !> - September, 2014- Initial Version 
     712   !> @date September, 2014 - Initial Version 
    698713   ! 
    699714   !> @param[inout] td_var array of variable strucutre 
     
    718733   ! 
    719734   !> @author J.Paul 
    720    !> - September, 2014- Initial Version 
     735   !> @date September, 2014 - Initial Version 
    721736   ! 
    722737   !> @param[inout] td_var array of variable strucutre 
     
    744759   ! 
    745760   !> @author J.Paul 
    746    !> - September, 2014- Initial Version 
     761   !> @date September, 2014 - Initial Version 
    747762   ! 
    748763   !> @param[inout] td_var array of variable strucutre 
     
    788803   !>   - id_id : variable id (read from a file). 
    789804   !>   - id_ew : number of point composing east west wrap band. 
     805   !>   - dd_unf : real(8) value for units factor attribute. 
    790806   !>   - dd_scf : real(8) value for scale factor attribute. 
    791807   !>   - dd_ofs : real(8) value for add offset attribute. 
     
    801817   !>   - cd_extrap  : a array of character defining extrapolation method. 
    802818   !>   - cd_filter  : a array of character defining filtering method. 
     819   !>   - cd_unt : a string character to define output unit 
     820   !>   - dd_unf : real(8) factor applied to change unit 
    803821   !> 
    804822   !>  @note most of these optionals arguments will be inform automatically, 
     
    806824   !> 
    807825   !> @author J.Paul 
    808    !> - November, 2013- Initial Version 
     826   !> @date November, 2013 - Initial Version 
     827   !> @date February, 2015  
     828   !> - Bug fix: conversion of the FillValue type (float case) 
     829   !> @date June, 2015  
     830   !> - add unit factor (to change unit) 
    809831   !> 
    810832   !> @param[in] cd_name         variable name 
     
    833855   !> @param[in] cd_extrap       extrapolation method 
    834856   !> @param[in] cd_filter       filter method 
     857   !> @param[in] cd_unt          new units (linked to units factor) 
     858   !> @param[in] dd_unf          units factor 
    835859   !> @return variable structure 
    836860   !------------------------------------------------------------------- 
     
    843867   &                              ld_contiguous, ld_shuffle,& 
    844868   &                              ld_fletcher32, id_deflvl, id_chunksz, & 
    845    &                              cd_interp, cd_extrap, cd_filter ) 
     869   &                              cd_interp, cd_extrap, cd_filter, & 
     870   &                              cd_unt, dd_unf ) 
    846871      IMPLICIT NONE 
    847872      ! Argument 
     
    871896      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
    872897      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     898      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     899      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    873900 
    874901 
     
    933960               tl_att=att_init('_FillValue', INT(dd_fill,i4) ) 
    934961            CASE(NF90_FLOAT) 
    935                tl_att=att_init('_FillValue', INT(dd_fill,sp) ) 
     962               tl_att=att_init('_FillValue', REAL(dd_fill,sp) ) 
    936963            CASE DEFAULT ! NF90_DOUBLE 
    937                      tl_att=att_init('_FillValue', dd_fill ) 
     964               tl_att=att_init('_FillValue', dd_fill ) 
    938965         END SELECT 
    939966         CALL var_move_att(var__init, tl_att) 
     
    10381065      ENDIF 
    10391066 
     1067      ! units factor 
     1068      IF( PRESENT(dd_unf) )THEN 
     1069         tl_att=att_init('units_factor',dd_unf) 
     1070         CALL var_move_att(var__init, tl_att) 
     1071      ENDIF 
     1072 
     1073      ! new units (linked to units factor) 
     1074      IF( PRESENT(cd_unt) )THEN 
     1075         tl_att=att_init('new_units',cd_units) 
     1076         CALL var_move_att(var__init, tl_att) 
     1077      ENDIF 
     1078 
    10401079      ! add extra information 
    10411080      CALL var__get_extra(var__init) 
     
    10471086      CALL var_del_att(var__init, 'filter') 
    10481087      CALL var_del_att(var__init, 'src_file') 
     1088      CALL var_del_att(var__init, 'src_i_indices') 
     1089      CALL var_del_att(var__init, 'src_j_indices') 
    10491090      CALL var_del_att(var__init, 'valid_min') 
    10501091      CALL var_del_att(var__init, 'valid_max') 
     
    10721113   ! 
    10731114   !> @author J.Paul 
    1074    !> - November, 2013- Initial Version 
    1075    ! 
     1115   !> @date November, 2013 - Initial Version 
     1116   !> @date June, 2015 
     1117   !> - add interp, extrap, and filter argument 
     1118   !> @date July, 2015 
     1119   !> - add unit factor (to change unit) 
     1120   !> 
    10761121   !> @param[in] cd_name         variable name 
    10771122   !> @param[in] dd_value        1D array of real(8) value 
     
    11001145   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use 
    11011146   !> @param[in] id_chunksz      chunk size 
     1147   !> @param[in] cd_interp       interpolation method 
     1148   !> @param[in] cd_extrap       extrapolation method 
     1149   !> @param[in] cd_filter       filter method 
     1150   !> @param[in] cd_unt          new units (linked to units factor) 
     1151   !> @param[in] dd_unf          units factor 
    11021152   !> @return variable structure 
    11031153   !------------------------------------------------------------------- 
     
    11101160   &                                    dd_min, dd_max,           & 
    11111161   &                                    ld_contiguous, ld_shuffle,& 
    1112    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1162   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1163   &                                    cd_interp, cd_extrap, cd_filter, & 
     1164   &                                    cd_unt, dd_unf) 
    11131165      IMPLICIT NONE 
    11141166      ! Argument 
     
    11381190      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    11391191      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1192      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1193      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1194      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1195      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1196      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    11401197 
    11411198      ! local variable 
     
    11931250      &                          ld_fletcher32=ld_fletcher32,        & 
    11941251      &                          id_deflvl=id_deflvl,                & 
    1195       &                          id_chunksz=id_chunksz(:)) 
     1252      &                          id_chunksz=id_chunksz(:),           & 
     1253      &                          cd_interp=cd_interp(:),             & 
     1254      &                          cd_extrap=cd_extrap(:),             & 
     1255      &                          cd_filter=cd_filter(:),             & 
     1256      &                          cd_unt=cd_unt, dd_unf=dd_unf ) 
    11961257    
    11971258      ! add value 
     
    12391300   ! 
    12401301   !> @author J.Paul 
    1241    !> - November, 2013- Initial Version 
     1302   !> @date November, 2013 - Initial Version 
     1303   !> @date February, 2015  
     1304   !> - bug fix: array initialise with dimension 
     1305   !> array not only one value 
     1306   !> @date June, 2015 
     1307   !> - add interp, extrap, and filter argument 
     1308   !> - Bux fix: dimension array initialise not only one value 
     1309   !> @date July, 2015 
     1310   !> - add unit factor (to change unit) 
    12421311   ! 
    12431312   !> @param[in] cd_name         variable name 
     
    12691338   !> no deflation is in use 
    12701339   !> @param[in] id_chunksz      chunk size 
     1340   !> @param[in] cd_interp       interpolation method 
     1341   !> @param[in] cd_extrap       extrapolation method 
     1342   !> @param[in] cd_filter       filter method 
     1343   !> @param[in] cd_unt          new units (linked to units factor) 
     1344   !> @param[in] dd_unf          units factor 
    12711345   !> @return variable structure 
    12721346   !------------------------------------------------------------------- 
     
    12791353   &                                    dd_min, dd_max,           & 
    12801354   &                                    ld_contiguous, ld_shuffle,& 
    1281    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1355   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1356   &                                    cd_interp, cd_extrap, cd_filter, & 
     1357   &                                    cd_unt, dd_unf) 
    12821358      IMPLICIT NONE 
    12831359      ! Argument 
     
    13071383      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    13081384      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1385      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1386      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1387      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1388      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1389      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    13091390 
    13101391      ! local variable 
     
    13501431      ENDIF 
    13511432 
    1352       il_count(:)=tl_dim(1)%i_len 
     1433      il_count(:)=tl_dim(:)%i_len 
    13531434      IF( PRESENT(id_count) )THEN 
    13541435         IF( SIZE(id_count(:)) /= 2 )THEN 
     
    13811462      &                          ld_fletcher32=ld_fletcher32,        & 
    13821463      &                          id_deflvl=id_deflvl,                & 
    1383       &                          id_chunksz=id_chunksz(:)) 
     1464      &                          id_chunksz=id_chunksz(:),           & 
     1465      &                          cd_interp=cd_interp(:),             & 
     1466      &                          cd_extrap=cd_extrap(:),             & 
     1467      &                          cd_filter=cd_filter(:),             & 
     1468      &                          cd_unt=cd_unt, dd_unf=dd_unf ) 
    13841469    
    13851470      ! add value 
     
    14311516   ! 
    14321517   !> @author J.Paul 
    1433    !> - November, 2013- Initial Version 
    1434    ! 
     1518   !> @date November, 2013 - Initial Version 
     1519   !> @date June, 2015 
     1520   !> - add interp, extrap, and filter argument 
     1521   !> @date July, 2015 
     1522   !> - add unit factor (to change unit) 
     1523   !> 
    14351524   !> @param[in] cd_name         variable name 
    14361525   !> @param[in] dd_value        1D array of real(8) value 
     
    14611550   !> deflation is in use 
    14621551   !> @param[in] id_chunksz      chunk size 
     1552   !> @param[in] cd_interp       interpolation method 
     1553   !> @param[in] cd_extrap       extrapolation method 
     1554   !> @param[in] cd_filter       filter method 
     1555   !> @param[in] cd_unt          new units (linked to units factor) 
     1556   !> @param[in] dd_unf          units factor 
    14631557   !> @return variable structure 
    14641558   !------------------------------------------------------------------- 
     
    14711565   &                                    dd_min, dd_max,           & 
    14721566   &                                    ld_contiguous, ld_shuffle,& 
    1473    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1567   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1568   &                                    cd_interp, cd_extrap, cd_filter, & 
     1569   &                                    cd_unt, dd_unf) 
    14741570      IMPLICIT NONE 
    14751571      ! Argument 
     
    14991595      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    15001596      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1597      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1598      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1599      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1600      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1601      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    15011602 
    15021603      ! local variable 
     
    15771678      &                          ld_fletcher32=ld_fletcher32,        & 
    15781679      &                          id_deflvl=id_deflvl,                & 
    1579       &                          id_chunksz=id_chunksz(:)) 
     1680      &                          id_chunksz=id_chunksz(:),           & 
     1681      &                          cd_interp=cd_interp(:),             & 
     1682      &                          cd_extrap=cd_extrap(:),             & 
     1683      &                          cd_filter=cd_filter(:),             & 
     1684      &                          cd_unt=cd_unt, dd_unf=dd_unf ) 
    15801685    
    15811686      ! add value 
     
    16231728   ! 
    16241729   !> @author J.Paul 
    1625    !> - November, 2013- Initial Version 
    1626    ! 
     1730   !> @date November, 2013 - Initial Version 
     1731   !> @date June, 2015 
     1732   !> - add interp, extrap, and filter argument 
     1733   !> @date July, 2015 
     1734   !> - add unit factor (to change unit) 
     1735   !> 
    16271736   !> @param[in] cd_name         variable name 
    16281737   !> @param[in] dd_value        4D array of real(8) value 
     
    16531762   !> deflation is in use 
    16541763   !> @param[in] id_chunksz      chunk size 
     1764   !> @param[in] cd_interp       interpolation method 
     1765   !> @param[in] cd_extrap       extrapolation method 
     1766   !> @param[in] cd_filter       filter method 
     1767   !> @param[in] cd_unt          new units (linked to units factor) 
     1768   !> @param[in] dd_unf          units factor 
    16551769   !> @return variable structure 
    16561770   !------------------------------------------------------------------- 
     
    16631777   &                                 dd_min, dd_max,           & 
    16641778   &                                 ld_contiguous, ld_shuffle,& 
    1665    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     1779   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     1780   &                                 cd_interp, cd_extrap, cd_filter, & 
     1781   &                                 cd_unt, dd_unf ) 
    16661782      IMPLICIT NONE 
    16671783      ! Argument 
     
    16911807      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    16921808      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1809      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1810      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1811      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1812      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1813      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    16931814 
    16941815      ! local variable 
     
    17231844      &                       ld_fletcher32=ld_fletcher32,        & 
    17241845      &                       id_deflvl=id_deflvl,                & 
    1725       &                       id_chunksz=id_chunksz(:)) 
     1846      &                       id_chunksz=id_chunksz(:),           & 
     1847      &                       cd_interp=cd_interp(:),             & 
     1848      &                       cd_extrap=cd_extrap(:),             & 
     1849      &                       cd_filter=cd_filter(:),             & 
     1850      &                       cd_unt=cd_unt, dd_unf=dd_unf ) 
    17261851  
    17271852      ! add value 
     
    17581883   ! 
    17591884   !> @author J.Paul 
    1760    !> - November, 2013- Initial Version 
     1885   !> @date November, 2013 - Initial Version 
     1886   !> @date June, 2015 
     1887   !> - add interp, extrap, and filter argument 
     1888   !> @date July, 2015 
     1889   !> - add unit factor (to change unit) 
    17611890   ! 
    17621891   !> @param[in] cd_name         variable name 
     
    17881917   !> deflation is in use 
    17891918   !> @param[in] id_chunksz      chunk size 
     1919   !> @param[in] cd_interp       interpolation method 
     1920   !> @param[in] cd_extrap       extrapolation method 
     1921   !> @param[in] cd_filter       filter method 
     1922   !> @param[in] cd_unt          new units (linked to units factor) 
     1923   !> @param[in] dd_unf          units factor 
    17901924   !> @return variable structure 
    17911925   !------------------------------------------------------------------- 
     
    17981932   &                                    dd_min, dd_max,           & 
    17991933   &                                    ld_contiguous, ld_shuffle,& 
    1800    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1934   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1935   &                                    cd_interp, cd_extrap, cd_filter, & 
     1936   &                                    cd_unt, dd_unf) 
    18011937 
    18021938      IMPLICIT NONE 
     
    18271963      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    18281964      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1965      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1966      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1967      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1968      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1969      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     1970 
    18291971 
    18301972      ! local variable 
     
    18702012      &                         ld_fletcher32=ld_fletcher32,        & 
    18712013      &                         id_deflvl=id_deflvl,                & 
    1872       &                         id_chunksz=id_chunksz(:)) 
     2014      &                         id_chunksz=id_chunksz(:),           & 
     2015      &                         cd_interp=cd_interp(:),             & 
     2016      &                         cd_extrap=cd_extrap(:),             & 
     2017      &                         cd_filter=cd_filter(:),             & 
     2018      &                         cd_unt=cd_unt, dd_unf=dd_unf ) 
    18732019  
    18742020      DEALLOCATE( dl_value ) 
     
    18922038   ! 
    18932039   !> @author J.Paul 
    1894    !> - November, 2013- Initial Version 
     2040   !> @date November, 2013 - Initial Version 
     2041   !> @date June, 2015 
     2042   !> - add interp, extrap, and filter argument 
     2043   !> @date July, 2015 
     2044   !> - add unit factor (to change unit) 
    18952045   ! 
    18962046   !> @param[in] cd_name         : variable name 
     
    19222072   !> deflation is in use 
    19232073   !> @param[in] id_chunksz      : chunk size 
     2074   !> @param[in] cd_interp       interpolation method 
     2075   !> @param[in] cd_extrap       extrapolation method 
     2076   !> @param[in] cd_filter       filter method 
     2077   !> @param[in] cd_unt          new units (linked to units factor) 
     2078   !> @param[in] dd_unf          units factor 
    19242079   !> @return variable structure 
    19252080   !------------------------------------------------------------------- 
     
    19322087   &                                    dd_min, dd_max,           & 
    19332088   &                                    ld_contiguous, ld_shuffle,& 
    1934    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2089   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2090   &                                    cd_interp, cd_extrap, cd_filter, & 
     2091   &                                    cd_unt, dd_unf) 
    19352092 
    19362093      IMPLICIT NONE 
     
    19612118      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    19622119      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2120      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2121      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2122      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2123      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2124      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    19632125 
    19642126      ! local variable 
     
    20062168      &                         ld_fletcher32=ld_fletcher32,        & 
    20072169      &                         id_deflvl=id_deflvl,                & 
    2008       &                         id_chunksz=id_chunksz(:)) 
     2170      &                         id_chunksz=id_chunksz(:),           & 
     2171      &                         cd_interp=cd_interp(:),             & 
     2172      &                         cd_extrap=cd_extrap(:),             & 
     2173      &                         cd_filter=cd_filter(:),             & 
     2174      &                         cd_unt=cd_unt, dd_unf=dd_unf ) 
    20092175       
    20102176      DEALLOCATE( dl_value ) 
     
    20282194   ! 
    20292195   !> @author J.Paul 
    2030    !> - November, 2013- Initial Version 
     2196   !> @date November, 2013 - Initial Version 
     2197   !> @date June, 2015 
     2198   !> - add interp, extrap, and filter argument 
     2199   !> @date July, 2015 
     2200   !> - add unit factor (to change unit) 
    20312201   ! 
    20322202   !> @param[in] cd_name         : variable name 
     
    20582228   !> deflation is in use 
    20592229   !> @param[in] id_chunksz      : chunk size 
     2230   !> @param[in] cd_interp       interpolation method 
     2231   !> @param[in] cd_extrap       extrapolation method 
     2232   !> @param[in] cd_filter       filter method 
     2233   !> @param[in] cd_unt          new units (linked to units factor) 
     2234   !> @param[in] dd_unf          units factor 
    20602235   !> @return variable structure 
    20612236   !------------------------------------------------------------------- 
     
    20682243   &                                    dd_min, dd_max,           & 
    20692244   &                                    ld_contiguous, ld_shuffle,& 
    2070    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2245   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2246   &                                    cd_interp, cd_extrap, cd_filter, & 
     2247   &                                    cd_unt, dd_unf) 
    20712248 
    20722249      IMPLICIT NONE 
     
    20972274      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    20982275      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2276      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2277      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2278      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2279      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2280      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    20992281 
    21002282      ! local variable 
     
    21432325      &                         ld_fletcher32=ld_fletcher32,        & 
    21442326      &                         id_deflvl=id_deflvl,                & 
    2145       &                         id_chunksz=id_chunksz(:)) 
     2327      &                         id_chunksz=id_chunksz(:),           & 
     2328      &                         cd_interp=cd_interp(:),             & 
     2329      &                         cd_extrap=cd_extrap(:),             & 
     2330      &                         cd_filter=cd_filter(:),             & 
     2331      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    21462332       
    21472333      DEALLOCATE( dl_value ) 
     
    21652351   ! 
    21662352   !> @author J.Paul 
    2167    !> - November, 2013- Initial Version 
     2353   !> @date November, 2013 - Initial Version 
     2354   !> @date June, 2015 
     2355   !> - add interp, extrap, and filter argument 
     2356   !> @date July, 2015 
     2357   !> - add unit factor (to change unit) 
    21682358   ! 
    21692359   !> @param[in] cd_name         variable name 
     
    21952385   !> deflation is in use 
    21962386   !> @param[in] id_chunksz      chunk size 
     2387   !> @param[in] cd_interp       interpolation method 
     2388   !> @param[in] cd_extrap       extrapolation method 
     2389   !> @param[in] cd_filter       filter method 
     2390   !> @param[in] cd_unt          new units (linked to units factor) 
     2391   !> @param[in] dd_unf          units factor 
    21972392   !> @return variable structure 
    21982393   !------------------------------------------------------------------- 
     
    22052400   &                                 dd_min, dd_max,           & 
    22062401   &                                 ld_contiguous, ld_shuffle,& 
    2207    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     2402   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     2403   &                                 cd_interp, cd_extrap, cd_filter, & 
     2404   &                                 cd_unt, dd_unf) 
    22082405 
    22092406      IMPLICIT NONE 
     
    22342431      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    22352432      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2433      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2434      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2435      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2436      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2437      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    22362438 
    22372439      ! local variable 
     
    22812483      &                      ld_fletcher32=ld_fletcher32,        & 
    22822484      &                      id_deflvl=id_deflvl,                & 
    2283       &                      id_chunksz=id_chunksz(:)) 
     2485      &                      id_chunksz=id_chunksz(:),           & 
     2486      &                      cd_interp=cd_interp(:),             & 
     2487      &                      cd_extrap=cd_extrap(:),             & 
     2488      &                      cd_filter=cd_filter(:),             & 
     2489      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    22842490       
    22852491      DEALLOCATE( dl_value ) 
     
    23032509   ! 
    23042510   !> @author J.Paul 
    2305    !> - November, 2013- Initial Version 
     2511   !> @date November, 2013 - Initial Version 
     2512   !> @date June, 2015 
     2513   !> - add interp, extrap, and filter argument 
     2514   !> @date July, 2015 
     2515   !> - add unit factor (to change unit) 
    23062516   ! 
    23072517   !> @param[in] cd_name         : variable name 
     
    23332543   !> deflation is in use 
    23342544   !> @param[in] id_chunksz      : chunk size 
     2545   !> @param[in] cd_interp       interpolation method 
     2546   !> @param[in] cd_extrap       extrapolation method 
     2547   !> @param[in] cd_filter       filter method 
     2548   !> @param[in] cd_unt          new units (linked to units factor) 
     2549   !> @param[in] dd_unf          units factor 
    23352550   !> @return variable structure 
    23362551   !------------------------------------------------------------------- 
     
    23432558   &                                    dd_min, dd_max,           & 
    23442559   &                                    ld_contiguous, ld_shuffle,& 
    2345    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2560   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2561   &                                    cd_interp, cd_extrap, cd_filter, & 
     2562   &                                    cd_unt, dd_unf) 
    23462563 
    23472564      IMPLICIT NONE 
     
    23722589      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    23732590      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2591      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2592      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2593      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2594      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2595      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    23742596 
    23752597      ! local variable 
     
    24152637      &                         ld_fletcher32=ld_fletcher32,        & 
    24162638      &                         id_deflvl=id_deflvl,                & 
    2417       &                         id_chunksz=id_chunksz(:)) 
     2639      &                         id_chunksz=id_chunksz(:),           & 
     2640      &                         cd_interp=cd_interp(:),             & 
     2641      &                         cd_extrap=cd_extrap(:),             & 
     2642      &                         cd_filter=cd_filter(:),             & 
     2643      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    24182644  
    24192645      DEALLOCATE( dl_value ) 
     
    24372663   ! 
    24382664   !> @author J.Paul 
    2439    !> - November, 2013- Initial Version 
     2665   !> @date November, 2013 - Initial Version 
     2666   !> @date June, 2015 
     2667   !> - add interp, extrap, and filter argument 
     2668   !> @date July, 2015 
     2669   !> - add unit factor (to change unit) 
    24402670   ! 
    24412671   !> @param[in] cd_name         variable name 
     
    24652695   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use 
    24662696   !> @param[in] id_chunksz      chunk size 
     2697   !> @param[in] cd_interp       interpolation method 
     2698   !> @param[in] cd_extrap       extrapolation method 
     2699   !> @param[in] cd_filter       filter method 
     2700   !> @param[in] cd_unt          new units (linked to units factor) 
     2701   !> @param[in] dd_unf          units factor 
    24672702   !> @return variable structure 
    24682703   !------------------------------------------------------------------- 
     
    24752710   &                                    dd_min, dd_max,           & 
    24762711   &                                    ld_contiguous, ld_shuffle,& 
    2477    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2712   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2713   &                                    cd_interp, cd_extrap, cd_filter, & 
     2714   &                                    cd_unt, dd_unf) 
    24782715 
    24792716      IMPLICIT NONE 
     
    25042741      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    25052742      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2743      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2744      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2745      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2746      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2747      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    25062748 
    25072749      ! local variable 
     
    25492791      &                         ld_fletcher32=ld_fletcher32,        & 
    25502792      &                         id_deflvl=id_deflvl,                & 
    2551       &                         id_chunksz=id_chunksz(:)) 
     2793      &                         id_chunksz=id_chunksz(:),           & 
     2794      &                         cd_interp=cd_interp(:),             & 
     2795      &                         cd_extrap=cd_extrap(:),             & 
     2796      &                         cd_filter=cd_filter(:),             & 
     2797      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    25522798       
    25532799      DEALLOCATE( dl_value ) 
     
    25712817   ! 
    25722818   !> @author J.Paul 
    2573    !> - November, 2013- Initial Version 
     2819   !> @date November, 2013 - Initial Version 
     2820   !> @date June, 2015 
     2821   !> - add interp, extrap, and filter argument 
     2822   !> @date July, 2015 
     2823   !> - add unit factor (to change unit) 
    25742824   ! 
    25752825   !> @param[in] cd_name         variable name 
     
    26012851   !> deflation is in use 
    26022852   !> @param[in] id_chunksz      chunk size 
     2853   !> @param[in] cd_interp       interpolation method 
     2854   !> @param[in] cd_extrap       extrapolation method 
     2855   !> @param[in] cd_filter       filter method 
     2856   !> @param[in] cd_unt          new units (linked to units factor) 
     2857   !> @param[in] dd_unf          units factor 
    26032858   !> @return variable structure 
    26042859   !------------------------------------------------------------------- 
     
    26112866   &                                    dd_min, dd_max,           & 
    26122867   &                                    ld_contiguous, ld_shuffle,& 
    2613    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2868   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2869   &                                    cd_interp, cd_extrap, cd_filter, & 
     2870   &                                    cd_unt, dd_unf) 
    26142871 
    26152872      IMPLICIT NONE 
     
    26402897      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    26412898      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2899      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2900      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2901      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2902      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2903      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    26422904 
    26432905      ! local variable 
     
    26862948      &                         ld_fletcher32=ld_fletcher32,        & 
    26872949      &                         id_deflvl=id_deflvl,                & 
    2688       &                         id_chunksz=id_chunksz(:)) 
     2950      &                         id_chunksz=id_chunksz(:),           & 
     2951      &                         cd_interp=cd_interp(:),             & 
     2952      &                         cd_extrap=cd_extrap(:),             & 
     2953      &                         cd_filter=cd_filter(:),             & 
     2954      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    26892955       
    26902956      DEALLOCATE( dl_value ) 
     
    27082974   ! 
    27092975   !> @author J.Paul 
    2710    !> - November, 2013- Initial Version 
     2976   !> @date November, 2013 - Initial Version 
     2977   !> @date June, 2015 
     2978   !> - add interp, extrap, and filter argument 
     2979   !> @date July, 2015 
     2980   !> - add unit factor (to change unit) 
    27112981   ! 
    27122982   !> @param[in] cd_name         variable name 
     
    27383008   !> deflation is in use 
    27393009   !> @param[in] id_chunksz      chunk size 
     3010   !> @param[in] cd_interp       interpolation method 
     3011   !> @param[in] cd_extrap       extrapolation method 
     3012   !> @param[in] cd_filter       filter method 
     3013   !> @param[in] cd_unt          new units (linked to units factor) 
     3014   !> @param[in] dd_unf          units factor 
    27403015   !> @return variable structure 
    27413016   !------------------------------------------------------------------- 
     
    27483023   &                                 dd_min, dd_max,           & 
    27493024   &                                 ld_contiguous, ld_shuffle,& 
    2750    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     3025   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     3026   &                                 cd_interp, cd_extrap, cd_filter, & 
     3027   &                                 cd_unt, dd_unf) 
    27513028 
    27523029      IMPLICIT NONE 
     
    27773054      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    27783055      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3056      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3057      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3058      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3059      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3060      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     3061 
    27793062 
    27803063      ! local variable 
     
    28243107      &                      ld_fletcher32=ld_fletcher32,        & 
    28253108      &                      id_deflvl=id_deflvl,                & 
    2826       &                      id_chunksz=id_chunksz(:)) 
     3109      &                      id_chunksz=id_chunksz(:),           & 
     3110      &                      cd_interp=cd_interp(:),             & 
     3111      &                      cd_extrap=cd_extrap(:),             & 
     3112      &                      cd_filter=cd_filter(:),             & 
     3113      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    28273114       
    28283115      DEALLOCATE( dl_value ) 
     
    28463133   ! 
    28473134   !> @author J.Paul 
    2848    !> - November, 2013- Initial Version 
     3135   !> @date November, 2013 - Initial Version 
     3136   !> @date June, 2015 
     3137   !> - add interp, extrap, and filter argument 
     3138   !> @date July, 2015 
     3139   !> - add unit factor (to change unit) 
    28493140   ! 
    28503141   !> @param[in] cd_name         variable name 
     
    28763167   !> deflation is in use 
    28773168   !> @param[in] id_chunksz      chunk size 
     3169   !> @param[in] cd_interp       interpolation method 
     3170   !> @param[in] cd_extrap       extrapolation method 
     3171   !> @param[in] cd_filter       filter method 
     3172   !> @param[in] cd_unt          new units (linked to units factor) 
     3173   !> @param[in] dd_unf          units factor 
    28783174   !> @return variable structure 
    28793175   !------------------------------------------------------------------- 
     
    28863182   &                                    dd_min, dd_max,           & 
    28873183   &                                    ld_contiguous, ld_shuffle,& 
    2888    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3184   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3185   &                                    cd_interp, cd_extrap, cd_filter, & 
     3186   &                                    cd_unt, dd_unf) 
    28893187 
    28903188      IMPLICIT NONE 
     
    29153213      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    29163214      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3215      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3216      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3217      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3218      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3219      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    29173220 
    29183221      ! local variable 
     
    29583261      &                         ld_fletcher32=ld_fletcher32,        & 
    29593262      &                         id_deflvl=id_deflvl,                & 
    2960       &                         id_chunksz=id_chunksz(:)) 
     3263      &                         id_chunksz=id_chunksz(:),           & 
     3264      &                         cd_interp=cd_interp(:),             & 
     3265      &                         cd_extrap=cd_extrap(:),             & 
     3266      &                         cd_filter=cd_filter(:),             & 
     3267      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    29613268  
    29623269      DEALLOCATE( dl_value ) 
     
    29803287   ! 
    29813288   !> @author J.Paul 
    2982    !> - November, 2013- Initial Version 
     3289   !> @date November, 2013 - Initial Version 
     3290   !> @date June, 2015 
     3291   !> - add interp, extrap, and filter argument 
     3292   !> @date July, 2015 
     3293   !> - add unit factor (to change unit) 
    29833294   ! 
    29843295   !> @param[in] cd_name         variable name 
     
    30103321   !> deflation is in use 
    30113322   !> @param[in] id_chunksz      chunk size 
     3323   !> @param[in] cd_interp       interpolation method 
     3324   !> @param[in] cd_extrap       extrapolation method 
     3325   !> @param[in] cd_filter       filter method 
     3326   !> @param[in] cd_unt          new units (linked to units factor) 
     3327   !> @param[in] dd_unf          units factor 
    30123328   !> @return variable structure 
    30133329   !------------------------------------------------------------------- 
     
    30203336   &                                    dd_min, dd_max,           & 
    30213337   &                                    ld_contiguous, ld_shuffle,& 
    3022    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3338   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3339   &                                    cd_interp, cd_extrap, cd_filter, & 
     3340   &                                    cd_unt, dd_unf) 
    30233341 
    30243342      IMPLICIT NONE 
     
    30493367      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    30503368      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3369      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3370      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3371      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3372      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3373      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    30513374 
    30523375      ! local variable 
     
    30943417      &                         ld_fletcher32=ld_fletcher32,        & 
    30953418      &                         id_deflvl=id_deflvl,                & 
    3096       &                         id_chunksz=id_chunksz(:)) 
     3419      &                         id_chunksz=id_chunksz(:),           & 
     3420      &                         cd_interp=cd_interp(:),             & 
     3421      &                         cd_extrap=cd_extrap(:),             & 
     3422      &                         cd_filter=cd_filter(:),             & 
     3423      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    30973424       
    30983425      DEALLOCATE( dl_value ) 
     
    31163443   ! 
    31173444   !> @author J.Paul 
    3118    !> - November, 2013- Initial Version 
     3445   !> @date November, 2013 - Initial Version 
     3446   !> @date June, 2015 
     3447   !> - add interp, extrap, and filter argument 
     3448   !> @date July, 2015 
     3449   !> - add unit factor (to change unit) 
    31193450   ! 
    31203451   !> @param[in] cd_name         variable name 
     
    31463477   !> deflation is in use 
    31473478   !> @param[in] id_chunksz      chunk size 
     3479   !> @param[in] cd_interp       interpolation method 
     3480   !> @param[in] cd_extrap       extrapolation method 
     3481   !> @param[in] cd_filter       filter method 
     3482   !> @param[in] cd_unt          new units (linked to units factor) 
     3483   !> @param[in] dd_unf          units factor 
    31483484   !> @return variable structure 
    31493485   !------------------------------------------------------------------- 
     
    31563492   &                                    dd_min, dd_max,           & 
    31573493   &                                    ld_contiguous, ld_shuffle,& 
    3158    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3494   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3495   &                                    cd_interp, cd_extrap, cd_filter, & 
     3496   &                                    cd_unt, dd_unf) 
    31593497 
    31603498      IMPLICIT NONE 
     
    31853523      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    31863524      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3525      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3526      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3527      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3528      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3529      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    31873530 
    31883531      ! local variable 
     
    32313574      &                         ld_fletcher32=ld_fletcher32,        & 
    32323575      &                         id_deflvl=id_deflvl,                & 
    3233       &                         id_chunksz=id_chunksz(:)) 
     3576      &                         id_chunksz=id_chunksz(:),           & 
     3577      &                         cd_interp=cd_interp(:),             & 
     3578      &                         cd_extrap=cd_extrap(:),             & 
     3579      &                         cd_filter=cd_filter(:),             & 
     3580      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    32343581       
    32353582      DEALLOCATE( dl_value ) 
     
    32533600   ! 
    32543601   !> @author J.Paul 
    3255    !> - November, 2013- Initial Version 
     3602   !> @date November, 2013 - Initial Version 
     3603   !> @date June, 2015 
     3604   !> - add interp, extrap, and filter argument 
     3605   !> @date July, 2015 
     3606   !> - add unit factor (to change unit) 
    32563607   ! 
    32573608   !> @param[in] cd_name         variable name 
     
    32833634   !> deflation is in use 
    32843635   !> @param[in] id_chunksz      chunk size 
     3636   !> @param[in] cd_interp       interpolation method 
     3637   !> @param[in] cd_extrap       extrapolation method 
     3638   !> @param[in] cd_filter       filter method 
     3639   !> @param[in] cd_unt          new units (linked to units factor) 
     3640   !> @param[in] dd_unf          units factor 
     3641 
    32853642   !> @return variable structure 
    32863643   !------------------------------------------------------------------- 
     
    32933650   &                                 dd_min, dd_max,           & 
    32943651   &                                 ld_contiguous, ld_shuffle,& 
    3295    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     3652   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     3653   &                                 cd_interp, cd_extrap, cd_filter, & 
     3654   &                                 cd_unt, dd_unf) 
    32963655 
    32973656      IMPLICIT NONE 
     
    33223681      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    33233682      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3683      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3684      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3685      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3686      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3687      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    33243688 
    33253689      ! local variable 
     
    33693733      &                      ld_fletcher32=ld_fletcher32,        & 
    33703734      &                      id_deflvl=id_deflvl,                & 
    3371       &                      id_chunksz=id_chunksz(:)) 
     3735      &                      id_chunksz=id_chunksz(:),           & 
     3736      &                      cd_interp=cd_interp(:),             & 
     3737      &                      cd_extrap=cd_extrap(:),             & 
     3738      &                      cd_filter=cd_filter(:),             & 
     3739      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    33723740       
    33733741      DEALLOCATE( dl_value ) 
     
    33913759   ! 
    33923760   !> @author J.Paul 
    3393    !> - November, 2013- Initial Version 
     3761   !> @date November, 2013 - Initial Version 
     3762   !> @date June, 2015 
     3763   !> - add interp, extrap, and filter argument 
     3764   !> @date July, 2015 
     3765   !> - add unit factor (to change unit) 
    33943766   ! 
    33953767   !> @param[in] cd_name         variable name 
     
    34213793   !> deflation is in use 
    34223794   !> @param[in] id_chunksz      chunk size 
     3795   !> @param[in] cd_interp       interpolation method 
     3796   !> @param[in] cd_extrap       extrapolation method 
     3797   !> @param[in] cd_filter       filter method 
     3798   !> @param[in] cd_unt          new units (linked to units factor) 
     3799   !> @param[in] dd_unf          units factor 
    34233800   !> @return variable structure 
    34243801   !------------------------------------------------------------------- 
     
    34313808   &                                    dd_min, dd_max,           & 
    34323809   &                                    ld_contiguous, ld_shuffle,& 
    3433    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3810   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3811   &                                    cd_interp, cd_extrap, cd_filter, & 
     3812   &                                    cd_unt, dd_unf) 
    34343813 
    34353814      IMPLICIT NONE 
     
    34603839      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    34613840      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3841      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3842      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3843      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3844      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3845      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     3846 
    34623847 
    34633848      ! local variable 
     
    35033888      &                         ld_fletcher32=ld_fletcher32,        & 
    35043889      &                         id_deflvl=id_deflvl,                & 
    3505       &                         id_chunksz=id_chunksz(:)) 
     3890      &                         id_chunksz=id_chunksz(:),           & 
     3891      &                         cd_interp=cd_interp(:),             & 
     3892      &                         cd_extrap=cd_extrap(:),             & 
     3893      &                         cd_filter=cd_filter(:),             & 
     3894      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    35063895  
    35073896      DEALLOCATE( dl_value ) 
     
    35253914   ! 
    35263915   !> @author J.Paul 
    3527    !> - November, 2013- Initial Version 
     3916   !> @date November, 2013 - Initial Version 
     3917   !> @date June, 2015 
     3918   !> - add interp, extrap, and filter argument 
     3919   !> @date July, 2015 
     3920   !> - add unit factor (to change unit) 
    35283921   ! 
    35293922   !> @param[in] cd_name         variable name 
     
    35553948   !> deflation is in use 
    35563949   !> @param[in] id_chunksz      chunk size 
     3950   !> @param[in] cd_interp       interpolation method 
     3951   !> @param[in] cd_extrap       extrapolation method 
     3952   !> @param[in] cd_filter       filter method 
     3953   !> @param[in] cd_unt          new units (linked to units factor) 
     3954   !> @param[in] dd_unf          units factor 
    35573955   !> @return variable structure 
    35583956   !------------------------------------------------------------------- 
     
    35653963   &                                    dd_min, dd_max,           & 
    35663964   &                                    ld_contiguous, ld_shuffle,& 
    3567    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3965   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3966   &                                    cd_interp, cd_extrap, cd_filter, & 
     3967   &                                    cd_unt, dd_unf) 
    35683968 
    35693969      IMPLICIT NONE 
     
    35943994      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    35953995      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3996      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3997      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3998      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3999      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4000      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     4001 
    35964002 
    35974003      ! local variable 
     
    36394045      &                         ld_fletcher32=ld_fletcher32,        & 
    36404046      &                         id_deflvl=id_deflvl,                & 
    3641       &                         id_chunksz=id_chunksz(:)) 
     4047      &                         id_chunksz=id_chunksz(:),           & 
     4048      &                         cd_interp=cd_interp(:),             & 
     4049      &                         cd_extrap=cd_extrap(:),             & 
     4050      &                         cd_filter=cd_filter(:),             & 
     4051      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    36424052       
    36434053      DEALLOCATE( dl_value ) 
     
    36614071   ! 
    36624072   !> @author J.Paul 
    3663    !> - November, 2013- Initial Version 
     4073   !> @date November, 2013 - Initial Version 
     4074   !> @date June, 2015 
     4075   !> - add interp, extrap, and filter argument 
     4076   !> @date July, 2015 
     4077   !> - add unit factor (to change unit) 
    36644078   ! 
    36654079   !> @param[in] cd_name         variable name 
     
    36914105   !> deflation is in use 
    36924106   !> @param[in] id_chunksz      chunk size 
     4107   !> @param[in] cd_interp       interpolation method 
     4108   !> @param[in] cd_extrap       extrapolation method 
     4109   !> @param[in] cd_filter       filter method 
     4110   !> @param[in] cd_unt          new units (linked to units factor) 
     4111   !> @param[in] dd_unf          units factor 
    36934112   !> @return variable structure 
    36944113   !------------------------------------------------------------------- 
     
    37014120   &                                    dd_min, dd_max,           & 
    37024121   &                                    ld_contiguous, ld_shuffle,& 
    3703    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4122   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4123   &                                    cd_interp, cd_extrap, cd_filter, & 
     4124   &                                    cd_unt, dd_unf) 
    37044125 
    37054126      IMPLICIT NONE 
     
    37304151      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    37314152      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4153      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4154      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4155      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4156      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4157      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    37324158 
    37334159      ! local variable 
     
    37764202      &                         ld_fletcher32=ld_fletcher32,        & 
    37774203      &                         id_deflvl=id_deflvl,                & 
    3778       &                         id_chunksz=id_chunksz(:)) 
     4204      &                         id_chunksz=id_chunksz(:),           & 
     4205      &                         cd_interp=cd_interp(:),             & 
     4206      &                         cd_extrap=cd_extrap(:),             & 
     4207      &                         cd_filter=cd_filter(:),             & 
     4208      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    37794209       
    37804210      DEALLOCATE( dl_value ) 
     
    37984228   ! 
    37994229   !> @author J.Paul 
    3800    !> - November, 2013- Initial Version 
     4230   !> @date November, 2013 - Initial Version 
     4231   !> @date June, 2015 
     4232   !> - add interp, extrap, and filter argument 
     4233   !> @date July, 2015 
     4234   !> - add unit factor (to change unit) 
    38014235   ! 
    38024236   !> @param[in] cd_name         variable name 
     
    38284262   !> deflation is in use 
    38294263   !> @param[in] id_chunksz      chunk size 
     4264   !> @param[in] cd_interp       interpolation method 
     4265   !> @param[in] cd_extrap       extrapolation method 
     4266   !> @param[in] cd_filter       filter method 
     4267   !> @param[in] cd_unt          new units (linked to units factor) 
     4268   !> @param[in] dd_unf          units factor 
    38304269   !> @return variable structure 
    38314270   !------------------------------------------------------------------- 
     
    38384277   &                                 dd_min, dd_max,           & 
    38394278   &                                 ld_contiguous, ld_shuffle,& 
    3840    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     4279   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     4280   &                                 cd_interp, cd_extrap, cd_filter, & 
     4281   &                                 cd_unt, dd_unf) 
    38414282 
    38424283      IMPLICIT NONE 
     
    38674308      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    38684309      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4310      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4311      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4312      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4313      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4314      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    38694315 
    38704316      ! local variable 
     
    39144360      &                      ld_fletcher32=ld_fletcher32,        & 
    39154361      &                      id_deflvl=id_deflvl,                & 
    3916       &                      id_chunksz=id_chunksz(:)) 
     4362      &                      id_chunksz=id_chunksz(:),           & 
     4363      &                      cd_interp=cd_interp(:),             & 
     4364      &                      cd_extrap=cd_extrap(:),             & 
     4365      &                      cd_filter=cd_filter(:),             & 
     4366      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    39174367       
    39184368      DEALLOCATE( dl_value ) 
     
    39364386   ! 
    39374387   !> @author J.Paul 
    3938    !> - November, 2013- Initial Version 
     4388   !> @date November, 2013 - Initial Version 
     4389   !> @date June, 2015 
     4390   !> - add interp, extrap, and filter argument 
     4391   !> @date July, 2015 
     4392   !> - add unit factor (to change unit) 
    39394393   ! 
    39404394   !> @param[in] cd_name         variable name 
     
    39664420   !> deflation is in use 
    39674421   !> @param[in] id_chunksz      chunk size 
     4422   !> @param[in] cd_interp       interpolation method 
     4423   !> @param[in] cd_extrap       extrapolation method 
     4424   !> @param[in] cd_filter       filter method 
     4425   !> @param[in] cd_unt          new units (linked to units factor) 
     4426   !> @param[in] dd_unf          units factor 
    39684427   !> @return variable structure 
    39694428   !------------------------------------------------------------------- 
     
    39764435   &                                    dd_min, dd_max,           & 
    39774436   &                                    ld_contiguous, ld_shuffle,& 
    3978    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4437   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4438   &                                    cd_interp, cd_extrap, cd_filter, & 
     4439   &                                    cd_unt, dd_unf) 
    39794440 
    39804441      IMPLICIT NONE 
     
    40054466      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    40064467      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4468      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4469      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4470      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4471      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4472      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    40074473 
    40084474      ! local variable 
     
    40484514      &                         ld_fletcher32=ld_fletcher32,        & 
    40494515      &                         id_deflvl=id_deflvl,                & 
    4050       &                         id_chunksz=id_chunksz(:)) 
     4516      &                         id_chunksz=id_chunksz(:),           & 
     4517      &                         cd_interp=cd_interp(:),             & 
     4518      &                         cd_extrap=cd_extrap(:),             & 
     4519      &                         cd_filter=cd_filter(:),             & 
     4520      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    40514521  
    40524522      DEALLOCATE( dl_value ) 
     
    40704540   ! 
    40714541   !> @author J.Paul 
    4072    !> - November, 2013- Initial Version 
     4542   !> @date November, 2013 - Initial Version 
     4543   !> @date June, 2015 
     4544   !> - add interp, extrap, and filter argument 
     4545   !> @date July, 2015 
     4546   !> - add unit factor (to change unit) 
    40734547   ! 
    40744548   !> @param[in] cd_name         variable name 
     
    41004574   !> deflation is in use 
    41014575   !> @param[in] id_chunksz      chunk size 
     4576   !> @param[in] cd_interp       interpolation method 
     4577   !> @param[in] cd_extrap       extrapolation method 
     4578   !> @param[in] cd_filter       filter method 
     4579   !> @param[in] cd_unt          new units (linked to units factor) 
     4580   !> @param[in] dd_unf          units factor 
    41024581   !> @return variable structure 
    41034582   !------------------------------------------------------------------- 
     
    41104589   &                                    dd_min, dd_max,           & 
    41114590   &                                    ld_contiguous, ld_shuffle,& 
    4112    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4591   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4592   &                                    cd_interp, cd_extrap, cd_filter, & 
     4593   &                                    cd_unt, dd_unf) 
    41134594 
    41144595      IMPLICIT NONE 
     
    41394620      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    41404621      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4622      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4623      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4624      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4625      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4626      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    41414627 
    41424628      ! local variable 
     
    41844670      &                         ld_fletcher32=ld_fletcher32,        & 
    41854671      &                         id_deflvl=id_deflvl,                & 
    4186       &                         id_chunksz=id_chunksz(:)) 
     4672      &                         id_chunksz=id_chunksz(:),           & 
     4673      &                         cd_interp=cd_interp(:),             & 
     4674      &                         cd_extrap=cd_extrap(:),             & 
     4675      &                         cd_filter=cd_filter(:),             & 
     4676      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    41874677       
    41884678      DEALLOCATE( dl_value ) 
     
    42064696   ! 
    42074697   !> @author J.Paul 
    4208    !> - November, 2013- Initial Version 
     4698   !> @date November, 2013 - Initial Version 
     4699   !> @date June, 2015 
     4700   !> - add interp, extrap, and filter argument 
     4701   !> @date July, 2015 
     4702   !> - add unit factor (to change unit) 
    42094703   ! 
    42104704   !> @param[in] cd_name         variable name 
     
    42364730   !> deflation is in use 
    42374731   !> @param[in] id_chunksz      chunk size 
     4732   !> @param[in] cd_interp       interpolation method 
     4733   !> @param[in] cd_extrap       extrapolation method 
     4734   !> @param[in] cd_filter       filter method 
     4735   !> @param[in] cd_unt          new units (linked to units factor) 
     4736   !> @param[in] dd_unf          units factor 
    42384737   !> @return variable structure 
    42394738   !------------------------------------------------------------------- 
     
    42464745   &                                    dd_min, dd_max,           & 
    42474746   &                                    ld_contiguous, ld_shuffle,& 
    4248    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4747   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4748   &                                    cd_interp, cd_extrap, cd_filter, & 
     4749   &                                    cd_unt, dd_unf) 
    42494750 
    42504751      IMPLICIT NONE 
     
    42754776      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    42764777      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4778      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4779      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4780      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4781      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4782      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    42774783 
    42784784      ! local variable 
     
    43214827      &                         ld_fletcher32=ld_fletcher32,        & 
    43224828      &                         id_deflvl=id_deflvl,                & 
    4323       &                         id_chunksz=id_chunksz(:)) 
     4829      &                         id_chunksz=id_chunksz(:),           & 
     4830      &                         cd_interp=cd_interp(:),             & 
     4831      &                         cd_extrap=cd_extrap(:),             & 
     4832      &                         cd_filter=cd_filter(:),             & 
     4833      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    43244834       
    43254835      DEALLOCATE( dl_value ) 
     
    43434853   ! 
    43444854   !> @author J.Paul 
    4345    !> - November, 2013- Initial Version 
     4855   !> @date November, 2013 - Initial Version 
     4856   !> @date June, 2015 
     4857   !> - add interp, extrap, and filter argument 
     4858   !> @date July, 2015 
     4859   !> - add unit factor (to change unit) 
    43464860   ! 
    43474861   !> @param[in] cd_name         variable name 
     
    43734887   !> deflation is in use 
    43744888   !> @param[in] id_chunksz      chunk size 
     4889   !> @param[in] cd_interp       interpolation method 
     4890   !> @param[in] cd_extrap       extrapolation method 
     4891   !> @param[in] cd_filter       filter method 
     4892   !> @param[in] cd_unt          new units (linked to units factor) 
     4893   !> @param[in] dd_unf          units factor 
    43754894   !> @return variable structure 
    43764895   !------------------------------------------------------------------- 
     
    43834902   &                                 dd_min, dd_max,           & 
    43844903   &                                 ld_contiguous, ld_shuffle,& 
    4385    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     4904   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     4905   &                                 cd_interp, cd_extrap, cd_filter, & 
     4906   &                                 cd_unt, dd_unf) 
    43864907 
    43874908      IMPLICIT NONE 
     
    44124933      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    44134934      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4935      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4936      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4937      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4938      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4939      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    44144940 
    44154941      ! local variable 
     
    44594985      &                      ld_fletcher32=ld_fletcher32,        & 
    44604986      &                      id_deflvl=id_deflvl,                & 
    4461       &                      id_chunksz=id_chunksz(:)) 
     4987      &                      id_chunksz=id_chunksz(:),           & 
     4988      &                      cd_interp=cd_interp(:),             & 
     4989      &                      cd_extrap=cd_extrap(:),             & 
     4990      &                      cd_filter=cd_filter(:),             & 
     4991      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    44624992       
    44634993      DEALLOCATE( dl_value ) 
     
    44735003   !> 
    44745004   !> @author J.Paul 
    4475    !> - November, 2013- Initial Version 
     5005   !> @date November, 2013 - Initial Version 
    44765006   ! 
    44775007   !> @param[in] td_var1   variable structure 
     
    45235053   !>  
    45245054   !> @author J.Paul 
    4525    !> - November, 2013- Initial Version 
     5055   !> @date November, 2013 - Initial Version 
    45265056   ! 
    45275057   !> @param[in] td_var1   variable structure 
     
    45955125   !>  
    45965126   !> @author J.Paul 
    4597    !> - November, 2013- Initial Version 
     5127   !> @date November, 2013 - Initial Version 
    45985128   ! 
    45995129   !> @param[in] td_var1   variable structure 
     
    46705200   !>  
    46715201   !> @author J.Paul 
    4672    !> - November, 2013- Initial Version 
     5202   !> @date November, 2013 - Initial Version 
    46735203   ! 
    46745204   !> @param[in] td_var1   variable structure 
     
    47455275   !>  
    47465276   !> @author J.Paul 
    4747    !> - November, 2013- Initial Version 
     5277   !> @date November, 2013 - Initial Version 
    47485278   ! 
    47495279   !> @param[in] td_var1   variable structure 
     
    48205350   !> 
    48215351   !> @author J.Paul 
    4822    !> - November, 2013- Initial Version 
     5352   !> @date November, 2013 - Initial Version 
     5353   !> @date June, 2015  
     5354   !> - add all element of the array in the same time 
    48235355   !> 
    48245356   !> @param[inout] td_var variable structure 
     
    48335365      ! local variable 
    48345366      INTEGER(i4) :: il_natt 
     5367      INTEGER(i4) :: il_status 
     5368      INTEGER(i4) :: il_ind 
     5369      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
    48355370 
    48365371      ! loop indices 
     
    48405375      il_natt=SIZE(td_att(:)) 
    48415376 
     5377      IF( td_var%i_natt > 0 )THEN 
     5378      ! already other attribute in variable structure 
     5379         ALLOCATE( tl_att(td_var%i_natt), stat=il_status ) 
     5380         IF(il_status /= 0 )THEN 
     5381 
     5382            CALL logger_error( & 
     5383            &  " VAR ADD ATT: not enough space to put attributes from "//& 
     5384            &  TRIM(td_var%c_name)//" in temporary attribute structure") 
     5385 
     5386         ELSE 
     5387 
     5388            ! save temporary global attribute's variable structure 
     5389            tl_att(:)=att_copy(td_var%t_att(:)) 
     5390 
     5391            CALL att_clean(td_var%t_att(:)) 
     5392            DEALLOCATE( td_var%t_att ) 
     5393            ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 
     5394            IF(il_status /= 0 )THEN 
     5395 
     5396               CALL logger_error( & 
     5397               &  " VAR ADD ATT: not enough space to put attributes "//& 
     5398               &  "in variable structure "//TRIM(td_var%c_name) ) 
     5399 
     5400            ENDIF 
     5401 
     5402            ! copy attribute in variable before 
     5403            td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 
     5404 
     5405            ! clean 
     5406            CALL att_clean(tl_att(:)) 
     5407            DEALLOCATE(tl_att) 
     5408             
     5409         ENDIF 
     5410      ELSE 
     5411      ! no attribute in variable structure 
     5412         IF( ASSOCIATED(td_var%t_att) )THEN 
     5413            CALL att_clean(td_var%t_att(:)) 
     5414            DEALLOCATE(td_var%t_att) 
     5415         ENDIF 
     5416         ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 
     5417         IF(il_status /= 0 )THEN 
     5418 
     5419            CALL logger_error( & 
     5420            &  " VAR ADD ATT: not enough space to put attributes "//& 
     5421            &  "in variable structure "//TRIM(td_var%c_name) ) 
     5422 
     5423         ENDIF 
     5424      ENDIF 
     5425 
     5426      ALLOCATE( tl_att(il_natt) ) 
     5427      tl_att(:)=att_copy(td_att(:)) 
     5428 
     5429      ! check if attribute already in variable structure 
    48425430      DO ji=1,il_natt 
    4843          CALL var_add_att(td_var, td_att(ji)) 
     5431         il_ind=0 
     5432         il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name ) 
     5433         IF( il_ind /= 0 )THEN 
     5434            CALL logger_error( & 
     5435            &  " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//& 
     5436            &  ", already in variable "//TRIM(td_var%c_name) ) 
     5437            CALL att_clean(tl_att(ji)) 
     5438         ENDIF 
    48445439      ENDDO 
     5440 
     5441      ! add new attributes 
     5442      td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:)) 
     5443 
     5444      DEALLOCATE(tl_att) 
     5445 
     5446      DO ji=1,il_natt 
     5447         ! highlight some attribute 
     5448         IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. & 
     5449           & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN 
     5450            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name)) 
     5451 
     5452               CASE("add_offset") 
     5453                  td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1) 
     5454               CASE("scale_factor") 
     5455                  td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1) 
     5456               CASE("_FillValue") 
     5457                  td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1) 
     5458               CASE("ew_overlap") 
     5459                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4)  
     5460               CASE("standard_name") 
     5461                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5462               CASE("long_name") 
     5463                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5464               CASE("units") 
     5465                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5466               CASE("grid_point") 
     5467                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5468 
     5469            END SELECT 
     5470         ENDIF 
     5471      ENDDO 
     5472 
     5473      ! update number of attribute 
     5474      td_var%i_natt=td_var%i_natt+il_natt 
     5475 
    48455476 
    48465477   END SUBROUTINE var__add_att_arr 
     
    48505481   ! 
    48515482   !> @author J.Paul 
    4852    !> - November, 2013- Initial Version 
     5483   !> @date November, 2013 - Initial Version 
     5484   !> @date June, 2015  
     5485   !> - use var__add_att_arr subroutine 
    48535486   ! 
    48545487   !> @param[inout] td_var variable structure 
     
    48625495 
    48635496      ! local variable 
    4864       INTEGER(i4) :: il_status 
    4865       INTEGER(i4) :: il_ind 
    4866       TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
     5497      TYPE(TATT), DIMENSION(1) :: tl_att 
    48675498 
    48685499      ! loop indices 
    4869       INTEGER(i4) :: ji 
    48705500      !---------------------------------------------------------------- 
    48715501 
    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 
     5502      ! copy structure in an array 
     5503      tl_att(1)=att_copy(td_att) 
     5504 
     5505      !  
     5506      CALL var_add_att( td_var, tl_att(:) ) 
    49775507 
    49785508   END SUBROUTINE var__add_att_unit 
     
    49825512   ! 
    49835513   !> @author J.Paul 
    4984    !> - November, 2013- Initial Version 
     5514   !> @date November, 2013 - Initial Version 
     5515   !> @date February, 2015  
     5516   !> - define local attribute structure to avoid mistake  
     5517   !> with pointer 
    49855518   ! 
    49865519   !> @param[inout] td_var variable structure 
     
    49965529      INTEGER(i4) :: il_ind 
    49975530 
     5531      TYPE(TATT)  :: tl_att 
    49985532      ! loop indices 
    49995533      !---------------------------------------------------------------- 
     
    50075541      IF( il_ind == 0 )THEN 
    50085542 
    5009          CALL logger_warn( & 
     5543         CALL logger_debug( & 
    50105544         &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//& 
    50115545         &  ", in variable "//TRIM(td_var%c_name) ) 
     
    50135547      ELSE 
    50145548          
    5015          CALL var_del_att(td_var, td_var%t_att(il_ind)) 
     5549         tl_att=att_copy(td_var%t_att(il_ind)) 
     5550         CALL var_del_att(td_var, tl_att) 
    50165551 
    50175552      ENDIF 
     
    50235558   ! 
    50245559   !> @author J.Paul 
    5025    !> - November, 2013- Initial Version 
     5560   !> @date November, 2013- Initial Version 
     5561   !> @date February, 2015  
     5562   !> - delete highlight attribute too, when attribute  
     5563   !> is deleted 
    50265564   ! 
    50275565   !> @param[inout] td_var variable structure 
     
    50405578 
    50415579      ! loop indices 
    5042       !INTEGER(i4) :: ji 
    50435580      !---------------------------------------------------------------- 
    50445581 
     
    50515588      IF( il_ind == 0 )THEN 
    50525589 
    5053          CALL logger_warn( & 
     5590         CALL logger_debug( & 
    50545591         &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//& 
    50555592         &  ", in variable "//TRIM(td_var%c_name) ) 
     
    51035640               td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 
    51045641 
    5105                !! change attribute id 
    5106                !DO ji=1,td_var%i_natt 
    5107                !   td_var%t_att(ji)%i_id=ji 
    5108                !ENDDO 
    5109  
    51105642               ! clean 
    51115643               CALL att_clean(tl_att(:)) 
     
    51135645            ENDIF  
    51145646         ENDIF 
     5647 
     5648         ! highlight attribute 
     5649         SELECT CASE( TRIM(td_att%c_name) ) 
     5650 
     5651            CASE("add_offset") 
     5652               td_var%d_ofs = 0._dp 
     5653            CASE("scale_factor") 
     5654               td_var%d_scf = 1._dp 
     5655            CASE("_FillValue") 
     5656               td_var%d_fill = 0._dp 
     5657            CASE("ew_overlap") 
     5658               td_var%i_ew = -1  
     5659            CASE("standard_name") 
     5660               td_var%c_stdname = '' 
     5661            CASE("long_name") 
     5662               td_var%c_longname = '' 
     5663            CASE("units") 
     5664               td_var%c_units = '' 
     5665            CASE("grid_point") 
     5666               td_var%c_point = '' 
     5667 
     5668         END SELECT 
     5669 
    51155670      ENDIF 
    51165671 
     
    51215676   ! 
    51225677   !> @author J.Paul 
    5123    !> - November, 2013- Initial Version 
     5678   !> @date November, 2013 - Initial Version 
    51245679   ! 
    51255680   !> @param[inout] td_var variable structure 
     
    51565711   ! 
    51575712   !> @author J.Paul 
    5158    !> - November, 2013- Initial Version 
     5713   !> @date November, 2013 - Initial Version 
    51595714   ! 
    51605715   !> @param[inout] td_var variable structure 
     
    51955750   ! 
    51965751   !> @author J.Paul 
    5197    !> - November, 2013- Initial Version 
     5752   !> @date November, 2013 - Initial Version 
    51985753   ! 
    51995754   !> @param[inout] td_var variable structure 
     
    52115766      !---------------------------------------------------------------- 
    52125767 
    5213       IF( td_var%i_ndim <= 4 )THEN 
     5768      IF( td_var%i_ndim <= ip_maxdim )THEN 
    52145769 
    52155770         ! check if dimension already used in variable structure 
     
    52275782         ELSE 
    52285783 
    5229          ! back to unorder dimension array  
    5230          CALL dim_unorder(td_var%t_dim(:)) 
     5784            ! back to disorder dimension array  
     5785            CALL dim_disorder(td_var%t_dim(:)) 
     5786 
    52315787            ! add new dimension 
    52325788            td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim) 
     
    52535809   ! 
    52545810   !> @author J.Paul 
    5255    !> - November, 2013- Initial Version 
     5811   !> @date November, 2013 - Initial Version 
    52565812   ! 
    52575813   !> @param[inout] td_var variable structure 
     
    52725828      !---------------------------------------------------------------- 
    52735829 
    5274       IF( td_var%i_ndim <= 4 )THEN 
     5830      IF( td_var%i_ndim <= ip_maxdim )THEN 
    52755831 
    52765832         CALL logger_trace( & 
     
    53175873   ! 
    53185874   !> @author J.Paul 
    5319    !> - November, 2013- Initial Version 
     5875   !> @date November, 2013 - Initial Version 
    53205876   ! 
    53215877   !> @param[inout] td_var variable structure 
     
    53605916   !> 
    53615917   !> @author J.Paul 
    5362    !> - June, 2014- Initial Version 
     5918   !> @date June, 2014 - Initial Version 
    53635919   ! 
    53645920   !> @param[in] td_var array of variables structure 
     
    53865942   !> 
    53875943   !> @author J.Paul 
    5388    !> - November, 2013- Initial Version 
     5944   !> @date November, 2013 - Initial Version 
    53895945   ! 
    53905946   !> @param[in] td_var    variable structure 
     
    54936049   !> 
    54946050   !> @author J.Paul 
    5495    !> - November, 2013- Initial Version 
     6051   !> @date November, 2013 - Initial Version 
    54966052   !> 
    54976053   !> @param[inout] td_var variable structure 
     
    56316187   !> 
    56326188   !> @author J.Paul 
    5633    !> - November, 2013- Initial Version 
     6189   !> @date November, 2013 - Initial Version 
    56346190   !> 
    56356191   !> @param[inout] td_var variable structure 
     
    56856241   !> 
    56866242   !> @author J.Paul 
    5687    !> - November, 2013- Initial Version 
     6243   !> @date November, 2013 - Initial Version 
    56886244   ! 
    56896245   !> @param[inout] td_var variable structure 
     
    57616317   ! 
    57626318   !> @author J.Paul 
    5763    !> - November, 2013- Initial Version 
     6319   !> @date November, 2013 - Initial Version 
    57646320   ! 
    57656321   !> @param[inout] td_var variabele structure 
     
    58376393   ! 
    58386394   !> @author J.Paul 
    5839    !> - November, 2013- Initial Version 
     6395   !> @date November, 2013 - Initial Version 
    58406396   ! 
    58416397   !> @param[inout] td_var variabele structure 
     
    59136469   ! 
    59146470   !> @author J.Paul 
    5915    !> - November, 2013- Initial Version 
     6471   !> @date November, 2013 - Initial Version 
    59166472   ! 
    59176473   !> @param[inout] td_var variabele structure 
     
    59876543   !> 
    59886544   !> @author J.Paul 
    5989    !> - November, 2013- Initial Version 
     6545   !> @date November, 2013 - Initial Version 
    59906546   ! 
    59916547   !> @param[inout] td_var variable structure 
     
    60576613   !> 
    60586614   !> @author J.Paul 
    6059    !> - November, 2013- Initial Version 
     6615   !> @date November, 2013 - Initial Version 
    60606616   !> 
    60616617   !> @param[inout] td_var variable structure 
     
    60806636   !> 
    60816637   !> @author J.Paul 
    6082    !> - September, 2014- Initial Version 
     6638   !> @date September, 2014 - Initial Version 
    60836639   !> 
    60846640   !> @param[in] td_var       array of variable structure 
     
    61456701   !> 
    61466702   !> @author J.Paul 
    6147    !> - November, 2013- Initial Version 
     6703   !> @date November, 2013 - Initial Version 
    61486704   ! 
    61496705   !> @param[in] td_var       array of variable structure 
     
    62006756   !> 
    62016757   !> @author J.Paul 
    6202    !> - November, 2013- Initial Version 
     6758   !> @date November, 2013 - Initial Version 
    62036759   ! 
    62046760   !> @param[in] td_var array of variable structure 
     
    62396795   !>  
    62406796   !> @author J.Paul 
    6241    !> - November, 2013- Initial Version 
     6797   !> @date November, 2013 - Initial Version 
    62426798   ! 
    62436799   !> @param[inout] td_var array of variable structure 
     
    63226878   !>  
    63236879   !> @author J.Paul 
    6324    !> - November, 2013- Initial Version 
     6880   !> @date November, 2013 - Initial Version 
     6881   !> @date June, 2015  
     6882   !> - new namelist format to get extra information (interpolation,...) 
    63256883   ! 
    63266884   !> @param[in] cd_file   configuration file of variable 
     
    63576915 
    63586916         il_fileid=fct_getunit() 
    6359          CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file)) 
    63606917         OPEN( il_fileid, FILE=TRIM(cd_file), & 
    63616918         &                FORM='FORMATTED',   & 
     
    63666923         CALL fct_err(il_status) 
    63676924         IF( il_status /= 0 )THEN 
    6368             CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file)) 
     6925            CALL logger_fatal("VAR DEF EXTRA: can not open file "//& 
     6926            &                 TRIM(cd_file)) 
    63696927         ENDIF 
    63706928 
     
    63756933         DO WHILE( il_status == 0 ) 
    63766934 
    6377          ! search line do not beginning with comment character 
     6935         ! search line not beginning with comment character 
    63786936            IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 
    63796937               il_nvar=il_nvar+1 
     
    64196977                  tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3)) 
    64206978                  tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4)) 
    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)) 
     6979 
     6980                  cl_interp='int='//TRIM(fct_split(cl_line,5)) 
    64256981                  tg_varextra(ji)%c_interp(:) = & 
    64266982                  &  var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp) 
    64276983                  CALL logger_debug("VAR DEF EXTRA: "//& 
    64286984                  &  TRIM(tg_varextra(ji)%c_name)//& 
    6429                   &  " "//TRIM(cl_interp)) 
     6985                  &  " "//TRIM(tg_varextra(ji)%c_interp(1))) 
     6986 
     6987                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6)) 
     6988                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7)) 
    64306989               ELSE 
    64316990                  ji=ji-1 
     
    64587017   !> @details  
    64597018   !> string character format must be : <br/> 
    6460    !> "varname:interp; filter; extrap; > min; < max"<br/> 
     7019   !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/> 
    64617020   !> you could specify only interpolation, filter or extrapolation method,  
    64627021   !> whatever the order. you could find more 
     
    64647023   !> \ref extrap module.<br/> 
    64657024   !> Examples:  
    6466    !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.' 
    6467    !> cn_varinfo='votemper:cubic; dist_weight; <40.' 
     7025   !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.' 
     7026   !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.' 
     7027   !> 
     7028   !> 
     7029   !> @warning variable should be define in tg_varextra (ie in configuration 
     7030   !> file, to be able to add information from namelist 
    64687031   !> 
    64697032   !> @note If you do not specify a method which is required, default one is 
     
    64717034   !> 
    64727035   !> @author J.Paul 
    6473    !> - November, 2013- Initial Version 
     7036   !> @date November, 2013 - Initial Version 
     7037   !> @date July, 2015  
     7038   !> - get unit and unit factor (to change unit)  
    64747039   ! 
    64757040   !> @param[in] cd_varinfo   variable information from namelist 
     
    64867051      CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap 
    64877052      CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter 
     7053      CHARACTER(LEN=lc)                            :: cl_unt 
    64887054 
    64897055      INTEGER(i4)                                  :: il_ind 
     
    64927058      REAL(dp)                                     :: dl_min 
    64937059      REAL(dp)                                     :: dl_max 
     7060      REAL(dp)                                     :: dl_unf 
    64947061 
    64957062      TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra 
     
    65087075            dl_min=var__get_min(cl_name, cl_method) 
    65097076            dl_max=var__get_max(cl_name, cl_method) 
     7077            dl_unf=var__get_unf(cl_name, cl_method) 
    65107078            cl_interp(:)=var__get_interp(cl_name, cl_method) 
    65117079            cl_extrap(:)=var__get_extrap(cl_name, cl_method) 
    65127080            cl_filter(:)=var__get_filter(cl_name, cl_method) 
     7081            cl_unt=var__get_unt(cl_name, cl_method) 
     7082 
    65137083 
    65147084            il_ind=var_get_index(tg_varextra(:), TRIM(cl_name)) 
     
    65167086               IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min 
    65177087               IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max 
     7088               IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf 
     7089               IF(cl_unt      /='') tg_varextra(il_ind)%c_unt      =cl_unt 
    65187090               IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:) 
    65197091               IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:) 
     
    65517123               &                               cd_filter=cl_filter(:), & 
    65527124               &                               dd_min = dl_min, & 
    6553                &                               dd_max = dl_max ) 
     7125               &                               dd_max = dl_max, & 
     7126               &                               cd_unt = cl_unt, & 
     7127               &                               dd_unf = dl_unf ) 
    65547128 
    65557129            ENDIF 
    65567130 
    65577131            ji=ji+1 
    6558             CALL logger_trace( "VAR CHG EXTRA: name       "//& 
     7132            CALL logger_debug( "VAR CHG EXTRA: name       "//& 
    65597133            &                  TRIM(tg_varextra(il_ind)%c_name) ) 
    6560             CALL logger_trace( "VAR CHG EXTRA: interp     "//& 
     7134            CALL logger_debug( "VAR CHG EXTRA: interp     "//& 
    65617135            &                  TRIM(tg_varextra(il_ind)%c_interp(1)) )          
    6562             CALL logger_trace( "VAR CHG EXTRA: filter     "//& 
     7136            CALL logger_debug( "VAR CHG EXTRA: filter     "//& 
    65637137            &                  TRIM(tg_varextra(il_ind)%c_filter(1)) )          
    6564             CALL logger_trace( "VAR CHG EXTRA: extrap     "//& 
     7138            CALL logger_debug( "VAR CHG EXTRA: extrap     "//& 
    65657139            &                  TRIM(tg_varextra(il_ind)%c_extrap(1)) ) 
    65667140            IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN 
    6567                CALL logger_trace( "VAR CHG EXTRA: min value  "//& 
     7141               CALL logger_debug( "VAR CHG EXTRA: min value  "//& 
    65687142               &                  TRIM(fct_str(tg_varextra(il_ind)%d_min)) ) 
    65697143            ENDIF 
    65707144            IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN 
    6571                CALL logger_trace( "VAR CHG EXTRA: max value  "//& 
     7145               CALL logger_debug( "VAR CHG EXTRA: max value  "//& 
    65727146               &                  TRIM(fct_str(tg_varextra(il_ind)%d_max)) ) 
     7147            ENDIF 
     7148            IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 
     7149               CALL logger_debug( "VAR CHG EXTRA: new unit  "//& 
     7150               &                  TRIM(tg_varextra(il_ind)%c_unt) ) 
     7151            ENDIF 
     7152            IF( tg_varextra(il_ind)%d_unf /= 1. )THEN 
     7153               CALL logger_debug( "VAR CHG EXTRA: new unit factor  "//& 
     7154               &                  TRIM(fct_str(tg_varextra(il_ind)%d_unf)) ) 
    65737155            ENDIF 
    65747156         ENDDO 
     
    65937175   !> 
    65947176   !> @author J.Paul 
    6595    !> - November, 2013- Initial Version 
     7177   !> @date November, 2013 - Initial Version 
    65967178   ! 
    65977179   !> @param[inout] td_var variable structure 
     
    66877269   !>  
    66887270   !> @author J.Paul 
    6689    !> - November, 2013- Initial Version 
     7271   !> @date November, 2013 - Initial Version 
    66907272   !> 
    66917273   !> @param[inout] td_var variable structure 
     
    68087390            ENDIF 
    68097391 
    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))) 
     7392            ! unt 
     7393            IF( TRIM(td_var%c_unt) == '' .AND. & 
     7394            &   TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 
     7395               td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt) 
     7396            ENDIF 
     7397 
     7398            ! units factor 
     7399            IF( td_var%d_unf == 1._dp .AND. & 
     7400            &   tg_varextra(il_ind)%d_unf /= 1._dp )THEN 
     7401               td_var%d_unf=tg_varextra(il_ind)%d_unf 
     7402            ENDIF 
     7403 
    68197404         ENDIF 
    68207405 
     
    68337418   !>  
    68347419   !> @details 
    6835    !> minimum value is assume to follow sign '>' 
     7420   !> minimum value is assume to follow string "min =" 
    68367421   !> 
    68377422   !> @author J.Paul 
    6838    !> - November, 2013- Initial Version 
     7423   !> @date November, 2013 - Initial Version 
     7424   !> @date June, 2015  
     7425   !> - change way to get information in namelist,  
     7426   !> value follows string "min =" 
    68397427   ! 
    68407428   !> @param[in] cd_name      variable name 
     
    68677455      cl_tmp=fct_split(cd_varinfo,ji,';') 
    68687456      DO WHILE( TRIM(cl_tmp) /= '' ) 
    6869          il_ind=SCAN(TRIM(cl_tmp),'>') 
     7457         il_ind=INDEX(TRIM(cl_tmp),'min') 
    68707458         IF( il_ind /= 0 )THEN 
    6871             cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 
     7459            cl_min=fct_split(cl_tmp,2,'=') 
    68727460            EXIT 
    68737461         ENDIF 
     
    68777465 
    68787466      IF( TRIM(cl_min) /= '' )THEN 
    6879          IF( fct_is_num(cl_min) )THEN 
     7467         IF( fct_is_real(cl_min) )THEN 
    68807468            READ(cl_min,*) var__get_min 
    68817469            CALL logger_debug("VAR GET MIN: will use minimum value of "//& 
     
    68947482   !>  
    68957483   !> @details 
    6896    !> maximum value is assume to follow sign '<' 
     7484   !> maximum value is assume to follow string "max =" 
    68977485   !> 
    68987486   !> @author J.Paul 
    6899    !> - November, 2013- Initial Version 
     7487   !> @date November, 2013 - Initial Version 
     7488   !> @date June, 2015  
     7489   !> - change way to get information in namelist,  
     7490   !> value follows string "max =" 
    69007491   ! 
    69017492   !> @param[in] cd_name      variable name 
     
    69287519      cl_tmp=fct_split(cd_varinfo,ji,';') 
    69297520      DO WHILE( TRIM(cl_tmp) /= '' ) 
    6930          il_ind=SCAN(TRIM(cl_tmp),'<') 
     7521         il_ind=INDEX(TRIM(cl_tmp),'max') 
    69317522         IF( il_ind /= 0 )THEN 
    6932             cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 
     7523            cl_max=fct_split(cl_tmp,2,'=') 
    69337524            EXIT 
    69347525         ENDIF 
     
    69387529 
    69397530      IF( TRIM(cl_max) /= '' )THEN 
    6940          IF( fct_is_num(cl_max) )THEN 
     7531         IF( fct_is_real(cl_max) )THEN 
    69417532            READ(cl_max,*) var__get_max 
    69427533            CALL logger_debug("VAR GET MAX: will use maximum value of "//& 
     
    69527543   !> @brief 
    69537544   !> This function check if variable information read in namelist contains  
     7545   !> units factor value and return it if true.  
     7546   !>  
     7547   !> @details 
     7548   !> units factor value is assume to follow string "unf =" 
     7549   !> 
     7550   !> @author J.Paul 
     7551   !> @date June, 2015 - Initial Version 
     7552   ! 
     7553   !> @param[in] cd_name      variable name 
     7554   !> @param[in] cd_varinfo   variable information read in namelist  
     7555   !> @return untis factor value to be used (FillValue if none) 
     7556   !------------------------------------------------------------------- 
     7557   FUNCTION var__get_unf( cd_name, cd_varinfo ) 
     7558      IMPLICIT NONE 
     7559      ! Argument 
     7560      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name 
     7561      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo 
     7562 
     7563      ! function 
     7564      REAL(dp) :: var__get_unf 
     7565 
     7566      ! local variable 
     7567      CHARACTER(LEN=lc) :: cl_tmp 
     7568      CHARACTER(LEN=lc) :: cl_unf 
     7569       
     7570      INTEGER(i4)       :: il_ind 
     7571 
     7572      REAL(dp)          :: rl_unf 
     7573 
     7574      ! loop indices 
     7575      INTEGER(i4) :: ji 
     7576      !---------------------------------------------------------------- 
     7577      ! init 
     7578      cl_unf='' 
     7579      var__get_unf=dp_fill 
     7580 
     7581      ji=1 
     7582      cl_tmp=fct_split(cd_varinfo,ji,';') 
     7583      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7584         il_ind=INDEX(TRIM(cl_tmp),'unf') 
     7585         IF( il_ind /= 0 )THEN 
     7586            cl_unf=fct_split(cl_tmp,2,'=') 
     7587            EXIT 
     7588         ENDIF 
     7589         ji=ji+1 
     7590         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7591      ENDDO 
     7592 
     7593      IF( TRIM(cl_unf) /= '' )THEN 
     7594         rl_unf=math_compute(cl_unf) 
     7595         IF( rl_unf /= dp_fill )THEN 
     7596            var__get_unf = rl_unf 
     7597            CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//& 
     7598               &  "value of "//TRIM(fct_str(var__get_unf))//" for variable "//& 
     7599               &   TRIM(cd_name) ) 
     7600         ELSE 
     7601            CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//& 
     7602               &  "value for variable "//TRIM(cd_name)//". check namelist." ) 
     7603         ENDIF 
     7604      ENDIF 
     7605 
     7606   END FUNCTION var__get_unf 
     7607   !------------------------------------------------------------------- 
     7608   !> @brief 
     7609   !> This function check if variable information read in namelist contains  
    69547610   !> interpolation method and return it if true.  
    69557611   !>  
    69567612   !> @details  
    6957    !> split namelist information, using ';' as separator. 
     7613   !> interpolation method is assume to follow string "int =" 
     7614   !> 
    69587615   !> compare method name with the list of interpolation method available (see 
    69597616   !> module global). 
    69607617   !> check if factor (*rhoi, /rhoj..) are present.<br/> 
    69617618   !> Example:<br/>  
    6962    !> - cubic/rhoi ; dist_weight 
    6963    !> - bilin 
     7619   !> - int=cubic/rhoi ; ext=dist_weight 
     7620   !> - int=bilin 
    69647621   !> see @ref interp module for more information. 
    69657622   !> 
    69667623   !> @author J.Paul 
    6967    !> - November, 2013- Initial Version 
     7624   !> @date November, 2013 - Initial Version 
     7625   !> @date June, 2015  
     7626   !> - change way to get information in namelist,  
     7627   !> value follows string "int =" 
    69687628   ! 
    69697629   !> @param[in] cd_name      variable name 
     
    69827642      ! local variable 
    69837643      CHARACTER(LEN=lc) :: cl_tmp 
     7644      CHARACTER(LEN=lc) :: cl_int 
    69847645      CHARACTER(LEN=lc) :: cl_factor 
    69857646       
     
    70007661      cl_tmp=fct_split(cd_varinfo,ji,';') 
    70017662      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7663         il_ind=INDEX(TRIM(cl_tmp),'int') 
     7664         IF( il_ind /= 0 )THEN 
     7665            cl_int=fct_split(cl_tmp,2,'=') 
     7666            EXIT 
     7667         ENDIF 
     7668         ji=ji+1 
     7669         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7670      ENDDO 
     7671 
     7672      IF( TRIM(cl_int) /= '' )THEN 
    70027673         DO jj=1,ip_ninterp 
    7003             il_ind= INDEX(fct_lower(cl_tmp),TRIM(cp_interp_list(jj))) 
     7674            il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj))) 
    70047675            IF( il_ind /= 0 )THEN 
    70057676 
     
    70097680               ! look for factor 
    70107681               IF( il_ind==1 )THEN 
    7011                   cl_factor=cl_tmp(il_len+1:) 
     7682                  cl_factor=cl_int(il_len+1:) 
    70127683               ELSE 
    7013                   cl_factor=cl_tmp(1:il_ind-1) 
     7684                  cl_factor=cl_int(1:il_ind-1) 
    70147685               ENDIF 
    70157686               il_mul=SCAN(TRIM(cl_factor),'*') 
     
    70527723            ENDIF 
    70537724         ENDDO 
    7054          IF( jj /= ip_ninterp + 1 ) EXIT 
    7055          ji=ji+1 
    7056          cl_tmp=fct_split(cd_varinfo,ji,';')          
    7057       ENDDO 
     7725      ENDIF 
    70587726 
    70597727   END FUNCTION var__get_interp 
     
    70647732   !>  
    70657733   !> @details  
    7066    !> split namelist information, using ';' as separator. 
     7734   !> extrapolation method is assume to follow string "ext =" 
     7735   !>  
    70677736   !> compare method name with the list of extrapolation method available (see 
    70687737   !> module global).<br/> 
    70697738   !> Example:<br/> 
    7070    !> - cubic ; dist_weight 
    7071    !> - min_error 
     7739   !> - int=cubic ; ext=dist_weight 
     7740   !> - ext=min_error 
    70727741   !> see @ref extrap module for more information. 
    70737742   !> 
    70747743   !> @author J.Paul 
    7075    !> - November, 2013- Initial Version 
     7744   !> @date November, 2013 - Initial Version 
     7745   !> @date June, 2015  
     7746   !> - change way to get information in namelist,  
     7747   !> value follows string "ext =" 
    70767748   ! 
    70777749   !> @param[in] cd_name      variable name 
     
    70907762      ! local variable 
    70917763      CHARACTER(LEN=lc) :: cl_tmp 
     7764      CHARACTER(LEN=lc) :: cl_ext 
     7765 
     7766      INTEGER(i4)       :: il_ind 
    70927767 
    70937768      ! loop indices 
     
    71017776      cl_tmp=fct_split(cd_varinfo,ji,';') 
    71027777      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7778         il_ind=INDEX(TRIM(cl_tmp),'ext') 
     7779         IF( il_ind /= 0 )THEN 
     7780            cl_ext=fct_split(cl_tmp,2,'=') 
     7781            EXIT 
     7782         ENDIF 
     7783         ji=ji+1 
     7784         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7785      ENDDO 
     7786 
     7787      IF( TRIM(cl_ext) /= '' )THEN 
    71037788         DO jj=1,ip_nextrap 
    7104             IF( TRIM(fct_lower(cl_tmp)) == TRIM(cp_extrap_list(jj)) )THEN 
     7789            IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN 
    71057790               var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 
    71067791 
     
    71117796            ENDIF 
    71127797         ENDDO 
    7113          IF( jj /= ip_nextrap + 1 ) EXIT 
    7114          ji=ji+1 
    7115          cl_tmp=fct_split(cd_varinfo,ji,';')          
    7116       ENDDO 
     7798      ENDIF 
    71177799 
    71187800 
     
    71247806   !>  
    71257807   !> @details  
    7126    !> split namelist information, using ';' as separator. 
     7808   !> filter method is assume to follow string "flt =" 
     7809   !> 
    71277810   !> compare method name with the list of filter method available (see 
    71287811   !> module global). 
    7129    !> look for the number of turn, using '*' separator, and method parameters inside 
     7812   !> look for the number of run, using '*' separator, and method parameters inside 
    71307813   !> bracket.<br/> 
    71317814   !> Example:<br/> 
    7132    !> - cubic ; 2*hamming(2,3) 
    7133    !> - hann 
     7815   !> - int=cubic ; flt=2*hamming(2,3) 
     7816   !> - flt=hann 
    71347817   !> see @ref filter module for more information. 
    71357818   !> 
    71367819   !> @author J.Paul 
    7137    !> - November, 2013- Initial Version 
    7138    ! 
     7820   !> @date November, 2013 - Initial Version 
     7821   !> @date June, 2015  
     7822   !> - change way to get information in namelist,  
     7823   !> value follows string "flt =" 
     7824   !> 
    71397825   !> @param[in] cd_name      variable name 
    71407826   !> @param[in] cd_varinfo   variable information read in namelist  
     
    71517837      ! local variable 
    71527838      CHARACTER(LEN=lc) :: cl_tmp 
     7839      CHARACTER(LEN=lc) :: cl_flt 
    71537840      INTEGER(i4)       :: il_ind 
    71547841 
     
    71637850      cl_tmp=fct_split(cd_varinfo,ji,';') 
    71647851      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7852         il_ind=INDEX(TRIM(cl_tmp),'flt') 
     7853         IF( il_ind /= 0 )THEN 
     7854            cl_flt=fct_split(cl_tmp,2,'=') 
     7855            EXIT 
     7856         ENDIF 
     7857         ji=ji+1 
     7858         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7859      ENDDO 
     7860       
     7861      IF( TRIM(cl_flt) /= '' )THEN 
    71657862         DO jj=1,ip_nfilter 
    7166             il_ind=INDEX(fct_lower(cl_tmp),TRIM(cp_filter_list(jj))) 
     7863            il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj))) 
    71677864            IF( il_ind /= 0 )THEN 
    71687865               var__get_filter(1)=TRIM(cp_filter_list(jj)) 
    71697866 
    7170                ! look for number of turn 
    7171                il_ind=SCAN(fct_lower(cl_tmp),'*') 
     7867               ! look for number of run 
     7868               il_ind=SCAN(fct_lower(cl_flt),'*') 
    71727869               IF( il_ind /=0 )THEN 
    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:)) 
     7870                  IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN 
     7871                     var__get_filter(2)=TRIM(cl_flt(1:il_ind-1)) 
     7872                  ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN 
     7873                     var__get_filter(2)=TRIM(cl_flt(il_ind+1:)) 
    71777874                  ELSE 
    71787875                     var__get_filter(2)='1' 
     
    71837880 
    71847881               ! look for filter parameter 
    7185                il_ind=SCAN(fct_lower(cl_tmp),'(') 
     7882               il_ind=SCAN(fct_lower(cl_flt),'(') 
    71867883               IF( il_ind /=0 )THEN 
    7187                   cl_tmp=TRIM(cl_tmp(il_ind+1:)) 
    7188                   il_ind=SCAN(fct_lower(cl_tmp),')') 
     7884                  cl_flt=TRIM(cl_flt(il_ind+1:)) 
     7885                  il_ind=SCAN(fct_lower(cl_flt),')') 
    71897886                  IF( il_ind /=0 )THEN 
    7190                      cl_tmp=TRIM(cl_tmp(1:il_ind-1)) 
     7887                     cl_flt=TRIM(cl_flt(1:il_ind-1)) 
    71917888                     ! look for cut-off frequency 
    7192                      var__get_filter(3)=fct_split(cl_tmp,1,',') 
     7889                     var__get_filter(3)=fct_split(cl_flt,1,',') 
    71937890                     ! look for halo size 
    7194                      var__get_filter(4)=fct_split(cl_tmp,2,',') 
     7891                     var__get_filter(4)=fct_split(cl_flt,2,',') 
    71957892                     ! look for alpha parameter 
    7196                      var__get_filter(5)=fct_split(cl_tmp,3,',') 
     7893                     var__get_filter(5)=fct_split(cl_flt,3,',') 
    71977894                  ELSE 
    71987895                     CALL logger_error("VAR GET FILTER: variable "//& 
     
    72157912            ENDIF 
    72167913         ENDDO 
    7217          IF( jj /= ip_nfilter + 1 ) EXIT 
     7914      ENDIF 
     7915 
     7916   END FUNCTION var__get_filter 
     7917   !------------------------------------------------------------------- 
     7918   !> @brief 
     7919   !> This function check if variable information read in namelist contains  
     7920   !> unit and return it if true.  
     7921   !>  
     7922   !> @details  
     7923   !> unit is assume to follow string "unt =" 
     7924   !> 
     7925   !> @author J.Paul 
     7926   !> @date June, 2015 - Initial Version 
     7927   ! 
     7928   !> @param[in] cd_name      variable name 
     7929   !> @param[in] cd_varinfo   variable information read in namelist 
     7930   !> @return unit string character  
     7931   !------------------------------------------------------------------- 
     7932   FUNCTION var__get_unt( cd_name, cd_varinfo ) 
     7933      IMPLICIT NONE 
     7934      ! Argument 
     7935      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name 
     7936      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo 
     7937 
     7938      ! function 
     7939      CHARACTER(LEN=lc)               :: var__get_unt 
     7940 
     7941      ! local variable 
     7942      CHARACTER(LEN=lc) :: cl_tmp 
     7943       
     7944      INTEGER(i4)       :: il_ind 
     7945 
     7946      ! loop indices 
     7947      INTEGER(i4) :: ji 
     7948      !---------------------------------------------------------------- 
     7949 
     7950      var__get_unt='' 
     7951 
     7952      ji=1 
     7953      cl_tmp=fct_split(cd_varinfo,ji,';') 
     7954      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7955         il_ind=INDEX(TRIM(cl_tmp),'unt') 
     7956         IF( il_ind /= 0 )THEN 
     7957            var__get_unt=fct_split(cl_tmp,2,'=') 
     7958            EXIT 
     7959         ENDIF 
    72187960         ji=ji+1 
    72197961         cl_tmp=fct_split(cd_varinfo,ji,';')          
    72207962      ENDDO 
    72217963 
    7222    END FUNCTION var__get_filter 
     7964      IF( TRIM(var__get_unt) /= '' )THEN 
     7965         CALL logger_debug("VAR GET UNIT: will use units "//& 
     7966            &  TRIM(var__get_unt)//" for variable "//& 
     7967            &  TRIM(cd_name) ) 
     7968      ENDIF 
     7969 
     7970   END FUNCTION var__get_unt 
    72237971   !------------------------------------------------------------------- 
    72247972   !> @brief  
     
    72277975   !> 
    72287976   !> @author J.Paul 
    7229    !> - November, 2013- Initial Version 
     7977   !> @date November, 2013 - Initial Version 
    72307978   ! 
    72317979   !> @param[in] td_var array of variable structure 
     
    72858033   !>  
    72868034   !> @author J.Paul 
    7287    !> - November, 2013- Initial Version 
     8035   !> @date November, 2013 - Initial Version 
    72888036   ! 
    72898037   !> @param[inout] td_var variable structure 
     
    73218069   !------------------------------------------------------------------- 
    73228070   !> @brief 
     8071   !> This subroutine replace unit name of the variable, 
     8072   !> and apply unit factor to the value of this variable. 
     8073   !>  
     8074   !> @details 
     8075   !> new unit name (unt) and unit factor (unf) are read from the namelist. 
     8076   !> 
     8077   !> @note the variable value should be already read. 
     8078   !> 
     8079   !> @author J.Paul 
     8080   !> @date June, 2015 - Initial Version 
     8081   ! 
     8082   !> @param[inout] td_var variable structure 
     8083   !------------------------------------------------------------------- 
     8084   SUBROUTINE var_chg_unit( td_var ) 
     8085      IMPLICIT NONE 
     8086      ! Argument 
     8087      TYPE(TVAR), INTENT(INOUT) :: td_var 
     8088 
     8089      ! local variable 
     8090      TYPE(TATT)                :: tl_att 
     8091 
     8092      ! loop indices 
     8093      !---------------------------------------------------------------- 
     8094 
     8095      IF( ASSOCIATED(td_var%d_value) )THEN 
     8096         !- change value 
     8097         IF( td_var%d_unf /= 1._dp )THEN 
     8098            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
     8099               td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf 
     8100            END WHERE 
     8101 
     8102            !- change scale factor and offset to avoid mistake 
     8103            tl_att=att_init('scale_factor',1) 
     8104            CALL var_move_att(td_var, tl_att) 
     8105 
     8106            tl_att=att_init('add_offset',0) 
     8107            CALL var_move_att(td_var, tl_att) 
     8108         ENDIF 
     8109 
     8110         !- change unit name  
     8111         IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. & 
     8112         &   TRIM(td_var%c_unt) /= '' )THEN 
     8113            tl_att=att_init('units',TRIM(td_var%c_unt)) 
     8114            CALL var_move_att(td_var,tl_att) 
     8115         ENDIF 
     8116 
     8117      ENDIF 
     8118 
     8119   END SUBROUTINE var_chg_unit 
     8120   !------------------------------------------------------------------- 
     8121   !> @brief 
    73238122   !> This subroutine check variable dimension expected, as defined in 
    73248123   !> file 'variable.cfg'. 
     
    73298128   !> 
    73308129   !> @author J.Paul 
    7331    !> - November, 2013- Initial Version 
     8130   !> @date November, 2013 - Initial Version 
    73328131   ! 
    73338132   !> @param[inout] td_var    variable structure 
     
    74148213   !>  
    74158214   !> @author J.Paul 
    7416    !> - August, 2014- Initial Version 
     8215   !> @date August, 2014 - Initial Version 
     8216   !> @date July 2015  
     8217   !> - do not use dim_disorder anymore 
    74178218   ! 
    74188219   !> @param[inout] td_var       variable structure 
     
    74388239      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 
    74398240 
     8241      CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//& 
     8242         &  " new dimension order "//TRIM(cl_dimorder)) 
     8243 
    74408244      tl_dim(:)=dim_copy(td_var%t_dim(:)) 
    74418245 
    7442       CALL dim_unorder(tl_dim(:)) 
    74438246      CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
    74448247 
     
    74678270   !>  
    74688271   !> @author J.Paul 
    7469    !> - September, 2014- Initial Version 
     8272   !> @date September, 2014 - Initial Version 
    74708273   ! 
    74718274   !> @param[in] td_var array of variable structure  
     
    74928295   !>  
    74938296   !> @author J.Paul 
    7494    !> - November, 2014- Initial Version 
     8297   !> @date November, 2014 - Initial Version 
    74958298   ! 
    74968299   !> @param[in] td_var time variable structure  
Note: See TracChangeset for help on using the changeset viewer.