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

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

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

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

Location:
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN
Files:
2 deleted
35 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg

    r10248 r10251  
    1 # name       | units          | axis | pt| interpolation   | long name                             | standard name                                   
    2 X            | 1              | X    |   |                 |                                       | projection_x_coordinate                
    3 Y            | 1              | Y    |   |                 |                                       | projection_y_coordinate                
    4 Z            | 1              | Z    |   |                 |                                       | projection_z_coordinate                
    5 T            | 1              | T    |   |                 |                                       | projection_t_coordinate                
    6 nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                    
    7 nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                          
    8 nav_lev      | model_levels   | Z    | T | cubic           | Model levels                          |                                   
    9 deptht       | m              | Z    | T |                 | Vertical T levels                     | depth                             
    10 time_counter |                | T    |   |                 | Time axis                             | time                              
    11 Bathymetry   | m              | XY   | T | cubic           | Bathymetry                            | bathymetry                        
    12 votemper     | degree_Celsius | XYZT | T | cubic           | Temperature                           | sea_water_potential_temperature   
    13 vozocrtx     | m s-1          | XYZT | U | cubic           | Zonal velocity                        |                                   
    14 vomecrty     | m s-1          | XYZT | V | cubic           | Meridional velocity                   |                                   
    15 vosaline     | PSU            | XYZT | T | cubic           | Salinity                              | sea_water_salinity                
    16 sossheig     | m              | XYT  | T | cubic           | Sea Surface Height                    | sea_surface_height                
    17 sotemper     | m              | XYT  | T | cubic           |                                       |                                   
    18 sossheig     | m              | XYT  | T | cubic           |                                       |                                   
    19 glamt        | degrees_east   | XY   | T | cubic           | Longitude_T                           |                                   
    20 glamu        | degrees_east   | XY   | U | cubic           | Longitude_U                           |                                    
    21 glamv        | degrees_east   | XY   | V | cubic           | Longitude_V                           |                                   
    22 glamf        | degrees_east   | XY   | F | cubic           | Longitude_F                           |                                   
    23 gphit        | degrees_north  | XY   | T | cubic           | Latitude_T                            |                                   
    24 gphiu        | degrees_north  | XY   | U | cubic           | Latitude_U                            |                                   
    25 gphiv        | degrees_north  | XY   | V | cubic           | Latitude_V                            |                                   
    26 gphif        | degrees_north  | XY   | F | cubic           | Latitude_F                            |                                   
    27 e1t          | m              | XY   | T | cubic/rhoi      |                                       |                                   
    28 e1u          | m              | XY   | U | cubic/rhoi      |                                       |                                   
    29 e1v          | m              | XY   | V | cubic/rhoi      |                                       |                                   
    30 e1f          | m              | XY   | F | cubic/rhoi      |                                       |                                   
    31 e2t          | m              | XY   | T | cubic/rhoj      |                                       |                                   
    32 e2u          | m              | XY   | U | cubic/rhoj      |                                       |                                   
    33 e2v          | m              | XY   | V | cubic/rhoj      |                                       |                                   
    34 e2f          | m              | XY   | F | cubic/rhoj      |                                       |                                   
    35 tmask        |                | XYZ  | T | nearest         |                                       |                                   
    36 umask        |                | XYZ  | U | nearest         |                                       |                                   
    37 vmask        |                | XYZ  | V | nearest         |                                       |                                   
    38 fmask        |                | XYZ  | F | nearest         |                                       |                                   
    39 weight       |                | XY   | T |                 |                                       |                                   
    40 kt           |                |      |   |                 |                                       |                                   
    41 ndastp       |                |      |   |                 |                                       |                                   
    42 adatrj       |                |      |   |                 |                                       |                                   
    43 kt           |                |      |   |                 |                                       |                                   
    44 rdt          |                |      |   |                 |                                       |                                   
    45 rdttra1      |                |      |   |                 |                                       |                                   
    46 utau_b       |                | XY   | U |                 |                                       |surface_downward_eastward_stress   
    47 vtau_b       |                | XY   | V |                 |                                       |surface_downward_northward_stress  
    48 qns_b        |                | XY   | T |                 |                                       |                                   
    49 emp_b        |                | XY   | T |                 |                                       |                                   
    50 sfx_b        |                | XY   | T |                 |                                       |                                   
    51 en           |                | XYZ  | T |                 |                                       |                                   
    52 avt          |                | XYZ  | T |                 | vertical eddy diffusivity             |                                   
    53 avm          |                | XYZ  | T |                 | vertical eddy viscosity               |                                   
    54 avmu         |                | XYZ  | T |                 |                                       |                                   
    55 avmv         |                | XYZ  | T |                 |                                       |                                   
    56 dissl        |                | XYZ  | T |                 |                                       |                                   
    57 sbc_hc_b     |                | XY   | T |                 |                                       |                                   
    58 sbc_sc_b     |                | XY   | T |                 |                                       |                                   
    59 gcx          |                | XY   | T |                 |                                       |                                   
    60 gcxb         |                | XY   | T |                 |                                       |                                   
    61 ub           |                | XYZ  | U |                 |                                       |                                   
    62 vb           |                | XYZ  | V |                 |                                       |                                   
    63 tb           |                | XYZ  | T |                 |                                       |                                   
    64 sb           |                | XYZ  | T |                 |                                       |                                   
    65 rotb         |                | XYZ  | T |                 |                                       |                                   
    66 hdivb        |                | XYZ  | T |                 |                                       |                                   
    67 sshb         |                | XY   | T |                 |                                       |                                   
    68 un           |                | XYZ  | U |                 |                                       |                                   
    69 vn           |                | XYZ  | V |                 |                                       |                                   
    70 tn           |                | XYZ  | T |                 |                                       |                                   
    71 sn           |                | XYZ  | T |                 |                                       |                                   
    72 rotn         |                | XYZ  | T |                 |                                       |                                   
    73 hdivn        |                | XYZ  | T |                 |                                       |                                   
    74 sshn         |                | XYT  | T |                 |                                       |                                   
    75 rhop         |                | XYZ  | T |                 |                                       |                                   
    76 dic          |                | XYZT | T |                 | Dissolved Inorganic Carbon            | mole_concentration_of_dissolved_inorganic_caron_in_sea_water 
    77 alkalini     |                | XYZT | T |                 | Total Alkalinity                      | sea_water_alkalinity_expressed_as_mole_equivalent 
    78 o2           |                | XYZT | T |                 | Dissolved Oxygen                      | mole_concentration_of_dissolved_molecular_oxygen_in_sea_water 
    79 caco3        |                | XYZT | T |                 | Calcite                               |                                   
    80 po4          |                | XYZT | T |                 | Phosphate                             | mole_concentration_of_phosphate_in_sea_water 
    81 poc          |                | XYZT | T |                 | Small Particulate Organic Carbon      |                                   
    82 si           |                | XYZT | T |                 | Dissolved Silicate                    | mole_concentration_of_silicate_in_sea_water 
    83 phy          |                | XYZT | T |                 | Nanophytoplankton                     |                                   
    84 zoo          |                | XYZT | T |                 | Microzooplankton                      | mole_concentration_of_microzooplankton_expressed_as_carbon_in_sea_water 
    85 doc          |                | XYZT | T |                 | Dissolved Organic Carbon              |                                   
    86 phy2         |                | XYZT | T |                 | Diatoms                               |                                   
    87 zoo2         |                | XYZT | T |                 | Mesozooplankton                       | mole_concentration_of_mesozooplankton_expressed_as_carbon_in_sea_water 
    88 gsi          |                | XYZT | T |                 | Sinking biogenic Silica               |                                   
    89 fer          |                | XYZT | T |                 | Dissolved Iron                        | mole_concentration_of_dissolved_iron_in_sea_water 
    90 bfe          |                | XYZT | T |                 | Iron in the big particles             |                                   
    91 goc          |                | XYZT | T |                 | Big Particulate Organic Carbon        |                                   
    92 sfe          |                | XYZT | T |                 | Iron in the small particles           |                                   
    93 dfe          |                | XYZT | T |                 | Iron content of the Diatoms           |                                   
    94 dsi          |                | XYZT | T |                 | Silicon content of the Diatoms        |                                   
    95 nfe          |                | XYZT | T |                 | Iron content of the Nanophytoplankton |                                   
    96 nchl         |                | XYZT | T |                 | Chlorophyll of the Nanophytoplankton  |                                   
    97 dchl         |                | XYZT | T |                 | Chlorophyll of the Diatoms            |                                   
    98 no3          |                | XYZT | T |                 | Nitrate                               | mole_concentration_of_nitrate_in_sea_water 
    99 nh4          |                | XYZT | T |                 | Ammonium                              | mole_concentration_of_ammonium_in_sea_water 
    100 ppd          |                | XYZT | T |                 |                                       |                                   
    101 ppn          |                | XYZT | T |                 |                                       |                                   
    102 ph           |                | XYZT | T |                 |                                       |                                   
    103 cflx         |                | XYZT | T |                 |                                       |                                   
    104 oflx         |                | XYZT | T |                 |                                       |                                   
    105 kg           |                | XYZT | T |                 |                                       |                                   
    106 dpco2        |                | XYZT | T |                 |                                       |                                   
    107 heup         |                | XYZT | T |                 |                                       |                                   
    108 kz           |                | XYZT | T |                 |                                       |                                   
    109 irondep      |                | XYZT | T |                 |                                       |                                   
    110 kt_ice       |                |      |   |                 |                                       |                                   
    111 hicif        |                |      |   |                 |                                       |                                   
    112 hsnif        |                |      |   |                 |                                       |                                   
    113 frld         |                |      |   |                 |                                       |                                   
    114 sist         |                |      |   |                 |                                       |                                   
    115 tbif1        |                |      |   |                 |                                       |                                   
    116 tbif2        |                |      |   |                 |                                       |                                   
    117 tbif3        |                |      |   |                 |                                       |                                   
    118 ui_ice       |                |      |   |                 |                                       |                                   
    119 vi_ice       |                |      |   |                 |                                       |                                   
    120 qstoif       |                |      |   |                 |                                       |                                   
    121 fsbbq        |                |      |   |                 |                                       |                                   
    122 stress1_i    |                |      |   |                 |                                       |                                   
    123 stress2_i    |                |      |   |                 |                                       |                                   
    124 stress12_i   |                |      |   |                 |                                       |                                   
    125 sxice        |                |      |   |                 |                                       |                                   
    126 syice        |                |      |   |                 |                                       |                                   
    127 sxxice       |                |      |   |                 |                                       |                                   
    128 syyice       |                |      |   |                 |                                       |                                   
    129 sxyice       |                |      |   |                 |                                       |                                   
    130 sxsn         |                |      |   |                 |                                       |                                   
    131 sysn         |                |      |   |                 |                                       |                                   
    132 sxxsn        |                |      |   |                 |                                       |                                   
    133 syysn        |                |      |   |                 |                                       |                                   
    134 sxysn        |                |      |   |                 |                                       |                                   
    135 sxa          |                |      |   |                 |                                       |                                   
    136 sya          |                |      |   |                 |                                       |                                   
    137 sxxa         |                |      |   |                 |                                       |                                   
    138 syya         |                |      |   |                 |                                       |                                   
    139 sxya         |                |      |   |                 |                                       |                                   
    140 sxc0         |                |      |   |                 |                                       |                                   
    141 syc0         |                |      |   |                 |                                       |                                   
    142 sxxc0        |                |      |   |                 |                                       |                                   
    143 syyc0        |                |      |   |                 |                                       |                                   
    144 sxyc0        |                |      |   |                 |                                       |                                   
    145 sxc1         |                |      |   |                 |                                       |                                   
    146 syc1         |                |      |   |                 |                                       |                                   
    147 sxxc1        |                |      |   |                 |                                       |                                   
    148 syyc1        |                |      |   |                 |                                       |                                   
    149 sxyc1        |                |      |   |                 |                                       |                                   
    150 sxc2         |                |      |   |                 |                                       |                                   
    151 syc2         |                |      |   |                 |                                       |                                   
    152 sxxc2        |                |      |   |                 |                                       |                                   
    153 syyc2        |                |      |   |                 |                                       |                                   
    154 sxyc2        |                |      |   |                 |                                       |                                   
    155 sxst         |                |      |   |                 |                                       |                                   
    156 syst         |                |      |   |                 |                                       |                                   
    157 sxxst        |                |      |   |                 |                                       |                                   
    158 syyst        |                |      |   |                 |                                       |                                   
    159 sxyst        |                |      |   |                 |                                       |                                   
     1# name       | units          | axis | point | standard name                | long name          | interpolation 
     2X            | 1              | X    |   | projection_x_coordinate          |                    |                       
     3Y            | 1              | Y    |   | projection_y_coordinate          |                    |                       
     4Z            | 1              | Z    |   | projection_z_coordinate          |                    |                       
     5T            | 1              | T    |   | projection_t_coordinate          |                    |                       
     6nav_lon      | degrees_east   | XY   | T | longitude                        | Longitude          | cubic                       
     7nav_lat      | degrees_north  | XY   | T | latitude                         | Latitude           | cubic          
     8nav_lev      | model_levels   | Z    | T |                                  | Model levels       | cubic         
     9deptht       | m              | Z    | T | depth                            | Vertical T levels  | 
     10time_counter |                | T    |   | time                             | Time axis          |  
     11Bathymetry   | m              | XY   | T | bathymetry                       | Bathymetry         | cubic          
     12votemper     | degree_Celsius | XYZT | T | sea_water_potential_temperature  | Temperature        | cubic          
     13vozocrtx     | m s-1          | XYZT | U |                                  | Zonal velocity     | cubic          
     14vomecrty     | m s-1          | XYZT | V |                                  | Meridional velocity| cubic          
     15vosaline     | PSU            | XYZT | T | sea_water_salinity               | Salinity           | cubic          
     16sossheig     | m              | XYT  | T | sea_surface_height               | Sea Surface Height | cubic          
     17glamt        | degrees_east   | XY   | T |                                  | Longitude_T        | cubic 
     18glamu        | degrees_east   | XY   | U |                                  | Longitude_U        | cubic             
     19glamv        | degrees_east   | XY   | V |                                  | Longitude_V        | cubic           
     20glamf        | degrees_east   | XY   | F |                                  | Longitude_F        | cubic          
     21gphit        | degrees_north  | XY   | T |                                  | Latitude_T         | cubic          
     22gphiu        | degrees_north  | XY   | U |                                  | Latitude_U         | cubic         
     23gphiv        | degrees_north  | XY   | V |                                  | Latitude_V         | cubic         
     24gphif        | degrees_north  | XY   | F |                                  | Latitude_F         | cubic         
     25e1t          | m              | XY   | T |                                  |                    | cubic/rhoi     
     26e1u          | m              | XY   | U |                                  |                    | cubic/rhoi      
     27e1v          | m              | XY   | V |                                  |                    | cubic/rhoi       
     28e1f          | m              | XY   | F |                                  |                    | cubic/rhoi     
     29e2t          | m              | XY   | T |                                  |                    | cubic/rhoj       
     30e2u          | m              | XY   | U |                                  |                    | cubic/rhoj       
     31e2v          | m              | XY   | V |                                  |                    | cubic/rhoj      
     32e2f          | m              | XY   | F |                                  |                    | cubic/rhoj       
     33tmask        |                | XYZ  | T |                                  |                    | nearest        
     34umask        |                | XYZ  | U |                                  |                    | nearest        
     35vmask        |                | XYZ  | V |                                  |                    | nearest        
     36fmask        |                | XYZ  | F |                                  |                    | nearest        
     37weight       |                | XY   | T |                                  |                    |                
     38kt           |                |      |   |                                  |                    |                
     39ndastp       |                |      |   |                                  |                    |                
     40adatrj       |                |      |   |                                  |                    |                
     41kt           |                |      |   |                                  |                    |                
     42rdt          |                |      |   |                                  |                    |                
     43rdttra1      |                |      |   |                                  |                    |                
     44utau_b       |                | XYT  | U |surface_downward_eastward_stress  |                    |                
     45vtau_b       |                | XYT  | V |surface_downward_northward_stress |                    |                
     46qns_b        |                | XYT  | T |                                  |                    |                
     47emp_b        |                | XYT  | T |                                  |                    |                
     48sfx_b        |                | XYT  | T |                                  |                    |                
     49en           |                | XYZT | T |                                  |                    |                
     50avt          |                | XYZT | T |                                  |                    |                
     51avm          |                | XYZT | T |                                  |                    |                
     52avmu         |                | XYZT | T |                                  |                    |                
     53avmv         |                | XYZT | T |                                  |                    |                
     54dissl        |                | XYZT | T |                                  |                    |                
     55sbc_hc_b     |                | XYT  | T |                                  |                    |                
     56sbc_sc_b     |                | XYT  | T |                                  |                    |                
     57gcx          |                | XYT  | T |                                  |                    |                
     58gcxb         |                | XYT  | T |                                  |                    |                
     59ub           |                | XYZT | U |                                  |                    |                
     60vb           |                | XYZT | V |                                  |                    |                
     61tb           |                | XYZT | T |                                  |                    |                
     62sb           |                | XYZT | T |                                  |                    |                
     63rotb         |                | XYZT | T |                                  |                    |                
     64hdivb        |                | XYZT | T |                                  |                    |                
     65sshb         |                | XYT  | T |                                  |                    |                
     66un           |                | XYZT | U |                                  |                    |                
     67vn           |                | XYZT | V |                                  |                    |                
     68tn           |                | XYZT | T |                                  |                    |                
     69sn           |                | XYZT | T |                                  |                    |                
     70rotn         |                | XYZT | T |                                  |                    |                
     71hdivn        |                | XYZT | T |                                  |                    |                
     72sshn         |                | XYT  | T |                                  |                    |                
     73rhop         |                | XYZT | T |                                  |                    |                

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90

    r10248 r10251  
    8181! REVISION HISTORY: 
    8282!> @date November, 2013 - Initial Version 
    83 !> @date November, 2014  
    84 !> - Fix memory leaks bug 
     83!> @date November, 2014 - Fix memory leaks bug 
    8584! 
    8685!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    131130      INTEGER(i4)       :: i_type = 0        !< attribute type 
    132131      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute 
    133       CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR 
     132      CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR 
    134133      REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE 
    135134   END TYPE TATT 
    136135 
    137136   INTERFACE att_init 
    138       MODULE PROCEDURE att__init_c     
     137      MODULE PROCEDURE att__init_c 
    139138      MODULE PROCEDURE att__init_dp 
    140139      MODULE PROCEDURE att__init_dp_0d 
    … …  
    182181   !> @date November, 2013 - Initial Version 
    183182   !> @date November, 2014 
    184    !> - use function instead of overload assignment operator  
     183   !>    - use function instead of overload assignment operator  
    185184   !> (to avoid memory leak)  
    186185   ! 
    … …  
    235234 
    236235      ! local variable 
    237       REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value 
     236      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value 
    238237      !---------------------------------------------------------------- 
    239238 
    … …  
    301300   !> @author J.Paul 
    302301   !> @date November, 2013 - Initial Version 
    303    !> @date September, 2014  
    304    !> - bug fix with use of id read from attribute structure 
    305    !> 
     302   !> @date September, 2014 - bug fix with use of id read from attribute structure 
     303   ! 
    306304   !> @param[in] td_att    array of attribute structure 
    307305   !> @param[in] cd_name   attribute name 
    … …  
    357355 
    358356      att__init_c%c_name=TRIM(ADJUSTL(cd_name)) 
     357 
    359358      att__init_c%i_type=NF90_CHAR 
    360  
    361359      att__init_c%c_value=TRIM(ADJUSTL(cd_value)) 
    362360      att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) ) 
    … …  
    370368   !> 
    371369   !> @author J.Paul 
    372    !> @date November, 2013 - Initial Version 
     370   !> @dtae November, 2013 - Initial Version 
    373371   ! 
    374372   !> @param[in] cd_name   attribute name 
    … …  
    10701068   !> @author J.Paul 
    10711069   !> @date November, 2013 - Initial Version 
    1072    !> @date September, 2014  
    1073    !> - take into account type of attribute. 
     1070   !> @date September, 2014 - take into account type of attribute. 
    10741071   ! 
    10751072   !> @param[in] td_att attribute structure 
    … …  
    11171114 
    11181115            CASE(NF90_CHAR) 
    1119  
    11201116               cl_value=td_att%c_value 
    11211117 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90

    r10248 r10251  
    2626!>       - ld_west  is logical to force used of north boundary [optional] 
    2727!>       - cd_north is string character description of north boundary [optional] 
    28 !>       - cd_south is string character description of south boundary [optional] 
    29 !>       - cd_east  is string character description of east boundary [optional] 
    30 !>       - cd_west  is string character description of west boundary [optional] 
     28!>       - cd_south is string character description of north boundary [optional] 
     29!>       - cd_east  is string character description of north boundary [optional] 
     30!>       - cd_west  is string character description of north boundary [optional] 
    3131!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional] 
    3232!> 
    … …  
    3636!>    to know if boundary is use:<br/> 
    3737!>    - tl_bdy\%l_use 
    38 !> 
    39 !>    to know if boundary come from namelist (cn_north,..):<br/> 
    40 !>    - tl_bdy\%l_nam 
    4138!> 
    4239!>    to get the number of segment in boundary:<br/> 
    … …  
    108105! REVISION HISTORY: 
    109106!> @date November, 2013 - Initial Version 
    110 !> @date September, 2014  
    111 !> - add boundary description 
    112 !> @date November, 2014  
    113 !> - Fix memory leaks bug 
    114 !> @date February, 2015  
    115 !> - Do not change indices read from namelist 
    116 !> - Change string character format of boundary read from namelist,  
    117 !>  see boundary__get_info 
     107!> @date September, 2014 - add boundary description 
     108!> @date November, 2014 - Fix memory leaks bug 
    118109!>  
    119110!> @todo add schematic to boundary structure description 
    … …  
    166157   PRIVATE :: seg__init       ! initialise segment structure 
    167158   PRIVATE :: seg__clean      ! clean segment structure 
    168    PRIVATE :: seg__clean_unit ! clean one segment structure 
     159   PRIVATE :: seg__clean_unit ! clean segment structure 
    169160   PRIVATE :: seg__clean_arr  ! clean array of segment structure 
    170161   PRIVATE :: seg__copy       ! copy segment structure in another 
    … …  
    182173      CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal 
    183174      LOGICAL           :: l_use  = .FALSE.     !< boundary use or not  
    184       LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist 
    185175      INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary 
    186176      TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure 
    187177   END TYPE TBDY 
    188178 
    189    ! module variable 
    190179   INTEGER(i4), PARAMETER :: im_width=10 
    191180 
    … …  
    234223   !> @date November, 2013 - Initial Version 
    235224   !> @date November, 2014 
    236    !> - use function instead of overload assignment operator  
     225   !>    - use function instead of overload assignment operator  
    237226   !> (to avoid memory leak) 
    238227   ! 
    … …  
    271260   !> @date November, 2013 - Initial Version 
    272261   !> @date November, 2014 
    273    !> - use function instead of overload assignment operator  
     262   !>    - use function instead of overload assignment operator  
    274263   !> (to avoid memory leak) 
    275264   ! 
    … …  
    364353   END SUBROUTINE boundary__clean_arr 
    365354   !-------------------------------------------------------------------  
    366    !> @brief This function put cardinal name and date inside file name. 
     355   !> @brief This function put cardinal name inside file name. 
    367356   !  
    368357   !> @details  
    369    !>    Examples : 
    370    !>       cd_file="boundary.nc" 
    371    !>       cd_card="west"  
    372    !>       id_seg =2 
    373    !>       cd_date=y2015m07d16 
    374    !>  
    375    !>       function return "boundary_west_2_y2015m07d16.nc" 
    376    !>  
    377    !>       cd_file="boundary.nc" 
    378    !>       cd_card="west"  
    379    !>  
    380    !>       function return "boundary_west.nc" 
    381    !>  
     358   !  
    382359   !> @author J.Paul  
    383360   !> @date November, 2013 - Initial Version  
    … …  
    408385      CHARACTER(LEN=lc) :: cl_date 
    409386      CHARACTER(LEN=lc) :: cl_name 
    410  
    411       INTEGER(i4)       :: il_ind 
    412       INTEGER(i4)       :: il_indend 
    413  
    414387      ! loop indices  
    415388      !----------------------------------------------------------------  
    … …  
    427400         cl_suffix=fct_split(TRIM(cl_basename),2,'.') 
    428401          
    429          ! add segment number 
    430402         IF( PRESENT(id_seg) )THEN 
    431             cl_segnum="_"//TRIM(fct_str(id_seg)) 
     403            cl_segnum="_"//TRIM(fct_str(id_seg))//"_" 
    432404         ELSE 
    433405            cl_segnum="" 
    434406         ENDIF 
    435407 
    436          ! add date 
    437408         IF( PRESENT(cd_date) )THEN 
    438             cl_date="_"//TRIM(ADJUSTL(cd_date)) 
     409            cl_date=TRIM(ADJUSTL(cd_date)) 
    439410         ELSE 
    440411            cl_date="" 
    441412         ENDIF 
    442413 
    443          ! special case for obcdta 
    444          il_ind=INDEX(cl_base,'_obcdta_') 
    445          IF( il_ind/=0 )THEN 
    446             il_ind=il_ind-1+8 
    447             il_indend=LEN_TRIM(cl_base) 
    448  
    449             cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//& 
    450                &     TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//& 
    451                &     TRIM(cl_date)//"."//TRIM(cl_suffix) 
    452          ELSE 
    453             cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 
    454                &     TRIM(cl_date)//"."//TRIM(cl_suffix) 
    455          ENDIF 
     414         cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 
     415         &        TRIM(cl_date)//"."//TRIM(cl_suffix) 
    456416 
    457417         boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) 
    … …  
    482442   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 
    483443   !> 
    484    !> @note Boundaries are compute on T point, but expressed on U,V point. 
    485    !> change will be done to get data on other point when need be.  
     444   !> @note boundaries are compute on T point. change will be done to get data 
     445   !> on other point when need be.  
    486446   !> 
    487447   !> @author J.Paul  
    … …  
    621581 
    622582               ! get namelist information 
    623                tl_tmp=boundary__get_info(cl_card(jk),jk) 
    624  
    625                ! get segments indices 
     583               tl_tmp=boundary__get_info(cl_card(jk)) 
    626584               DO ji=1,tl_tmp%i_nseg 
    627585                  CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji)) 
    628586               ENDDO 
    629                ! indices from namelist or not 
    630                tl_bdy(jk)%l_nam=tl_tmp%l_nam 
    631  
    632587               CALL boundary_clean(tl_tmp) 
    633588 
    … …  
    687642   !> @return boundary structure 
    688643   !-------------------------------------------------------------------  
    689    FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg )  
     644   FUNCTION boundary__init( cd_card, ld_use, td_seg )  
    690645      IMPLICIT NONE  
    691646      ! Argument 
    692647      CHARACTER(LEN=*), INTENT(IN) :: cd_card 
    693648      LOGICAL         , INTENT(IN), OPTIONAL :: ld_use  
    694       LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam  
    695649      TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg 
    696650 
    … …  
    710664            boundary__init%l_use=.TRUE. 
    711665            IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use 
    712  
    713             boundary__init%l_nam=.FALSE. 
    714             IF( PRESENT(ld_nam) ) boundary__init%l_nam=ld_nam 
    715666 
    716667            IF( PRESENT(td_seg) )THEN 
    … …  
    827778   !> orthogonal index, first and last indices, of each segment.  
    828779   !> And also the width of all segments of this boundary. 
    829    !>   cn_north='index1,first1:last1(width)|index2,first2:last2' 
     780   !>   cn_north='index1,first1,last1(width)|index2,first2,last2' 
    830781   !>  
    831782   !> @author J.Paul  
    832783   !> @date November, 2013 - Initial Version  
    833    !> @date february, 2015  
    834    !> - do not change indices read from namelist 
    835    !> - change format cn_north 
    836784   !  
    837785   !> @param[in] cd_card   boundary description 
    838    !> @param[in] id_jcard  boundary index 
    839786   !> @return boundary structure 
    840787   !-------------------------------------------------------------------  
    841    FUNCTION boundary__get_info(cd_card, id_jcard)  
     788   FUNCTION boundary__get_info(cd_card)  
    842789      IMPLICIT NONE  
    843790      ! Argument  
    844791      CHARACTER(LEN=lc), INTENT(IN) :: cd_card 
    845       INTEGER(i4)      , INTENT(IN) :: id_jcard 
    846792 
    847793      ! function  
    … …  
    856802      CHARACTER(LEN=lc) :: cl_index 
    857803      CHARACTER(LEN=lc) :: cl_width 
    858       CHARACTER(LEN=lc) :: cl_tmp 
    859804      CHARACTER(LEN=lc) :: cl_first 
    860805      CHARACTER(LEN=lc) :: cl_last  
    … …  
    873818      ! width should be the same for all segment of one boundary 
    874819      IF( TRIM(cl_seg)   /= '' )THEN 
    875  
    876          ! initialise boundary 
    877          ! temporaty boundary, so it doesn't matter which caridnal is used 
    878          boundary__get_info=boundary__init('north',ld_nam=.TRUE.) 
    879  
    880820         il_ind1=SCAN(fct_lower(cl_seg),'(') 
    881821         IF( il_ind1 /=0 )THEN 
    … …  
    891831            ENDIF 
    892832         ENDIF 
    893  
    894833      ENDIF  
    895834 
    … …  
    900839         il_ind1=SCAN(fct_lower(cl_index),'(') 
    901840         IF( il_ind1 /=0 )THEN 
    902             il_ind2=SCAN(fct_lower(cl_index),')') 
     841            il_ind2=SCAN(fct_lower(cl_index),'(') 
    903842            IF( il_ind2 /=0 )THEN 
    904843               cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:)) 
    … …  
    909848         ENDIF 
    910849       
    911           
    912          cl_tmp=fct_split(cl_seg,2,',') 
    913  
    914  
    915          cl_first=fct_split(cl_tmp,1,':') 
     850         cl_first=fct_split(cl_seg,2,',') 
    916851         ! remove potential width information 
    917852         il_ind1=SCAN(fct_lower(cl_first),'(') 
    918853         IF( il_ind1 /=0 )THEN 
    919             il_ind2=SCAN(fct_lower(cl_first),')') 
     854            il_ind2=SCAN(fct_lower(cl_first),'(') 
    920855            IF( il_ind2 /=0 )THEN 
    921856               cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:)) 
    … …  
    926861         ENDIF          
    927862          
    928          cl_last =fct_split(cl_tmp,2,':') 
     863         cl_last =fct_split(cl_seg,3,',') 
    929864         ! remove potential width information 
    930865         il_ind1=SCAN(fct_lower(cl_last),'(') 
    931866         IF( il_ind1 /=0 )THEN 
    932             il_ind2=SCAN(fct_lower(cl_last),')') 
     867            il_ind2=SCAN(fct_lower(cl_last),'(') 
    933868            IF( il_ind2 /=0 )THEN 
    934869               cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:)) 
    … …  
    944879         IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first 
    945880         IF( TRIM(cl_last)  /= '' ) READ(cl_last ,*) tl_seg%i_last 
    946  
    947          ! index expressed on U,V point, move on T point. 
    948          SELECT CASE(id_jcard) 
    949             CASE(jp_north, jp_east) 
    950                tl_seg%i_index=tl_seg%i_index+1 
    951          END SELECT 
    952881 
    953882         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. & 
    … …  
    1014943 
    1015944      DO jk=1,ip_ncard 
    1016          IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN 
     945         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%i_nseg > 1 )THEN 
    1017946            ! nothing to be done 
    1018947         ELSE 
    … …  
    15511480      il_max(jp_east )=td_var%t_dim(2)%i_len 
    15521481      il_max(jp_west )=td_var%t_dim(2)%i_len 
    1553   
     1482       
    15541483      il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 
    15551484      il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost 
    … …  
    15861515         ENDIF 
    15871516      ENDDO 
    1588   
     1517       
    15891518      CALL boundary_check_corner(td_bdy, td_var) 
    15901519 
    … …  
    17211650   !> @date November, 2013 - Initial Version 
    17221651   !> @date November, 2014 
    1723    !> - use function instead of overload assignment operator  
     1652   !>    - use function instead of overload assignment operator  
    17241653   !> (to avoid memory leak) 
    17251654   ! 
    … …  
    17581687   !> @date November, 2013 - Initial Version 
    17591688   !> @date November, 2014 
    1760    !> - use function instead of overload assignment operator  
     1689   !>    - use function instead of overload assignment operator  
    17611690   !> (to avoid memory leak) 
    17621691   ! 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90

    r10248 r10251  
    2020!>    ./SIREN/bin/create_bathy create_bathy.nam 
    2121!> @endcode 
    22 !> <br/>     
    23 !> \image html  bathy_40.png  
    24 !> \image latex bathy_30.png 
    25 !> 
    26 !> @note  
    27 !>    you could find a template of the namelist in templates directory. 
    28 !> 
     22!>     
    2923!>    create_bathy.nam comprise 7 namelists:<br/> 
    3024!>       - logger namelist (namlog) 
    … …  
    4337!>       - cn_logfile   : log filename 
    4438!>       - cn_verbosity : verbosity ('trace','debug','info', 
    45 !> 'warning','error','fatal','none') 
     39!> 'warning','error','fatal') 
    4640!>       - in_maxerror  : maximum number of error allowed 
    4741!> 
    … …  
    5852!>       - cn_coord1 : coordinate file 
    5953!>       - in_perio1 : periodicity index 
    60 !>       - ln_fillclosed : fill closed sea or not (default is .TRUE.) 
     54!>       - ln_fillclosed : fill closed sea or not 
    6155!> 
    6256!>    * _variable namelist (namvar)_:<br/> 
    6357!>       - cn_varinfo : list of variable and extra information about request(s)  
    6458!>       to be used.<br/> 
    65 !>          each elements of *cn_varinfo* is a string character 
    66 !>          (separated by ',').<br/> 
     59!>          each elements of *cn_varinfo* is a string character.<br/> 
    6760!>          it is composed of the variable name follow by ':',  
    6861!>          then request(s) to be used on this variable.<br/>  
    6962!>          request could be: 
    70 !>             - int = interpolation method 
    71 !>             - ext = extrapolation method 
    72 !>             - flt = filter method 
    73 !>             - min = minimum value 
    74 !>             - max = maximum value 
    75 !>             - unt = new units 
    76 !>             - unf = unit scale factor (linked to new units) 
     63!>             - interpolation method 
     64!>             - extrapolation method 
     65!>             - filter method 
     66!>             - > minimum value 
     67!>             - < maximum value 
    7768!> 
    7869!>                requests must be separated by ';'.<br/> 
    … …  
    8172!>          informations about available method could be find in @ref interp, 
    8273!>          @ref extrap and @ref filter modules.<br/> 
    83 !>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0' 
     74!>          Example: 'Bathymetry: 2*hamming(2,3); > 0' 
    8475!>          @note  
    8576!>             If you do not specify a method which is required,  
    … …  
    9990!>                - ',' for line 
    10091!>                - '/' for row 
     92!>                - '\' for level<br/> 
    10193!>                Example:<br/> 
    10294!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc} 
    … …  
    10799!>             - 'Bathymetry:gridT.nc' 
    108100!>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000' 
     101!> 
     102!>          \image html  bathy_40.png  
     103!>          \image latex bathy_30.png 
    109104!> 
    110105!>    * _nesting namelist (namnst)_:<br/> 
    … …  
    124119!> - add header for user 
    125120!> - Bug fix, compute offset depending of grid point 
    126 !> @date June, 2015 
    127 !> - extrapolate all land points. 
    128 !> - allow to change unit. 
    129121! 
    130 !> @todo 
    131 !> - use create_bathy_check_depth as in create_boundary 
    132 !> - use create_bathy_check_time  as in create_boundary 
    133 !> - check tl_multi is not empty 
    134 !> 
    135122!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    136123!---------------------------------------------------------------------- 
    … …  
    495482   ENDIF 
    496483 
    497    ! use additional request 
    498484   DO jk=1,tl_multi%i_nvar 
    499  
    500          ! change unit and apply factor 
    501          CALL var_chg_unit(tl_var(jk)) 
    502  
    503485         ! forced min and max value 
    504486         CALL var_limit_value(tl_var(jk)) 
    … …  
    575557 
    576558   ! add other variables 
    577    DO jk=tl_multi%i_nvar,1,-1 
     559   DO jk=1,tl_multi%i_nvar 
    578560      CALL file_add_var(tl_fileout, tl_var(jk)) 
    579561      CALL var_clean(tl_var(jk)) 
    … …  
    641623   !> 
    642624   !> @author J.Paul 
    643    !> @date November, 2013 - Initial Version 
     625   !> - November, 2013- Initial Version 
    644626   !> 
    645627   !> @param[in] td_var    variable structure  
    … …  
    777759   !>  
    778760   !> @author J.Paul 
    779    !> @date November, 2013 - Initial Version 
     761   !> - November, 2013- Initial Version 
    780762   !> 
    781763   !> @param[in] td_var    variable structure  
    … …  
    896878   !>  
    897879   !> @author J.Paul 
    898    !> @date November, 2013 - Initial Version 
     880   !> - November, 2013- Initial Version 
    899881   !> 
    900882   !> @param[in] td_var    variable structure 
    … …  
    915897      IMPLICIT NONE 
    916898      ! Argument 
    917       TYPE(TVAR)                 , INTENT(IN) :: td_var   
    918       TYPE(TMPP)                 , INTENT(IN) :: td_mpp  
    919       INTEGER(i4)                , INTENT(IN) :: id_imin 
    920       INTEGER(i4)                , INTENT(IN) :: id_imax 
    921       INTEGER(i4)                , INTENT(IN) :: id_jmin 
    922       INTEGER(i4)                , INTENT(IN) :: id_jmax 
     899      TYPE(TVAR) , INTENT(IN) :: td_var   
     900      TYPE(TMPP) , INTENT(IN) :: td_mpp  
     901      INTEGER(i4), INTENT(IN) :: id_imin 
     902      INTEGER(i4), INTENT(IN) :: id_imax 
     903      INTEGER(i4), INTENT(IN) :: id_jmin 
     904      INTEGER(i4), INTENT(IN) :: id_jmax 
    923905      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset 
    924906      INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho 
    … …  
    1007989   !>  
    1008990   !> @author J.Paul 
    1009    !> @date November, 2013 - Initial Version 
     991   !> - November, 2013- Initial Version 
    1010992   !> 
    1011993   !> @param[inout] td_var variable structure  
    … …  
    10911073 
    10921074      ! extrapolate variable 
    1093       CALL extrap_fill_value( td_var ) 
     1075      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), & 
     1076      &                               id_rho=id_rho(:),         & 
     1077      &                               id_iext=il_iext, id_jext=il_jext ) 
    10941078 
    10951079      ! interpolate Bathymetry 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90

    r10248 r10251  
    2323!>    ./SIREN/bin/create_boundary create_boundary.nam 
    2424!> @endcode 
    25 !>  <br/>  
    26 !> \image html  boundary_NEATL36_70.png  
    27 !> \image latex boundary_NEATL36_70.png 
    28 !> 
    29 !> @note  
    30 !>    you could find a template of the namelist in templates directory. 
    31 !> 
     25!>     
    3226!>    create_boundary.nam comprise 9 namelists:<br/> 
    3327!>       - logger namelist (namlog) 
    … …  
    4842!>       - cn_logfile   : log filename 
    4943!>       - cn_verbosity : verbosity ('trace','debug','info', 
    50 !> 'warning','error','fatal','none') 
     44!> 'warning','error','fatal') 
    5145!>       - in_maxerror  : maximum number of error allowed 
    5246!> 
    … …  
    8579!>    * _variable namelist (namvar)_:<br/> 
    8680!>       - cn_varinfo : list of variable and extra information about request(s) 
    87 !>          to be used (separated by ',').<br/> 
     81!> to be used.<br/> 
    8882!>          each elements of *cn_varinfo* is a string character.<br/> 
    8983!>          it is composed of the variable name follow by ':',  
    9084!>          then request(s) to be used on this variable.<br/>  
    9185!>          request could be: 
    92 !>             - int = interpolation method 
    93 !>             - ext = extrapolation method 
    94 !>             - flt = filter method 
    95 !>             - unt = new units 
    96 !>             - unf = unit scale factor (linked to new units) 
     86!>             - interpolation method 
     87!>             - extrapolation method 
     88!>             - filter method 
    9789!> 
    9890!>                requests must be separated by ';'.<br/> 
    … …  
    10294!>          @ref extrap and @ref filter.<br/> 
    10395!> 
    104 !>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 'vosaline:int=cubic' 
     96!>          Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic' 
    10597!>          @note  
    10698!>             If you do not specify a method which is required,  
    … …  
    144136!>          segments are separated by '|'.<br/> 
    145137!>          each segments of the boundary is composed of: 
    146 !>             - indice of velocity (orthogonal to boundary .ie.  
    147 !>                for north boundary, J-indice).  
    148 !>             - indice of segemnt start (I-indice for north boundary)  
    149 !>             - indice of segment end  (I-indice for north boundary)<br/> 
    150 !>                indices must be separated by ':' .<br/> 
     138!>             - orthogonal indice (.ie. for north boundary, 
     139!>             J-indice where boundary are).  
     140!>             - first indice of boundary (I-indice for north boundary)  
     141!>             - last  indice of boundary (I-indice for north boundary)<br/> 
     142!>                indices must be separated by ',' .<br/> 
    151143!>             - optionally, boundary size could be added between '(' and ')'  
    152144!>             in the first segment defined. 
    … …  
    155147!> 
    156148!>          Examples: 
    157 !>             - cn_north='index1,first1:last1(width)' 
    158 !>             - cn_north='index1(width),first1:last1|index2,first2:last2' 
    159 !>             \image html  boundary_50.png  
    160 !>             \image latex boundary_50.png 
     149!>             - cn_north='index1,first1,last1(width)' 
     150!>             - cn_north='index1(width),first1,last1|index2,first2,last2' 
     151!> 
     152!>          \image html  boundary_50.png  
     153!>          \image latex boundary_50.png 
     154!> 
    161155!>       - cn_south  : south boundary indices on fine grid 
    162156!>       - cn_east   : east  boundary indices on fine grid 
    163157!>       - cn_west   : west  boundary indices on fine grid 
    164158!>       - ln_oneseg : use only one segment for each boundary or not 
    165 !> 
    166 !>    * _output namelist (namout)_:<br/> 
     159!>       - in_extrap : number of mask point to be extrapolated 
     160!> 
     161!>   * _output namelist (namout)_:<br/> 
    167162!>       - cn_fileout : fine grid boundary basename 
    168163!>         (cardinal and segment number will be automatically added) 
    169 !>       - dn_dayofs  : date offset in day (change only ouput file name) 
    170 !>       - ln_extrap  : extrapolate land point or not 
    171 !> 
    172 !>          Examples:  
    173 !>             - cn_fileout=boundary.nc<br/> 
    174 !>                if time_counter (16/07/2015 00h) is read on input file (see varfile),  
    175 !>                west boundary will be named boundary_west_y2015m07d16 
    176 !>             - dn_dayofs=-2.<br/> 
    177 !>                if you use day offset you get boundary_west_y2015m07d14 
    178 !>        
    179164!> 
    180165!> @author J.Paul 
    … …  
    184169!> - add header for user 
    185170!> - take into account grid point to compue boundaries 
    186 !> - reorder output dimension for north and south boundaries 
    187 !> @date June, 2015 
    188 !> - extrapolate all land points, and add ln_extrap in namelist. 
    189 !> - allow to change unit. 
    190 !> @date July, 2015 
    191 !> - add namelist parameter to shift date of output file name.   
     171!> - reorder output dimension for north and south boundaries  
    192172!> 
    193173!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    211191   USE dom                             ! domain manager 
    212192   USE grid                            ! grid manager 
    213    USE vgrid                           ! vertical grid manager 
     193   USE vgrid                           ! vartical grid manager 
    214194   USE extrap                          ! extrapolation manager 
    215195   USE interp                          ! interpolation manager 
    … …  
    233213   INTEGER(i4)                                        :: il_status 
    234214   INTEGER(i4)                                        :: il_fileid 
     215   INTEGER(i4)                                        :: il_dim 
    235216   INTEGER(i4)                                        :: il_imin0 
    236217   INTEGER(i4)                                        :: il_imax0 
    … …  
    258239 
    259240   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim 
    260  
    261    TYPE(TDATE)                                        :: tl_date 
    262241    
    263242   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy 
    … …  
    286265   ! namelist variable 
    287266   ! namlog 
    288    CHARACTER(LEN=lc)  :: cn_logfile = 'create_boundary.log'  
    289    CHARACTER(LEN=lc)  :: cn_verbosity = 'warning'  
    290    INTEGER(i4)        :: in_maxerror = 5 
     267   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log'  
     268   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
     269   INTEGER(i4)                             :: in_maxerror = 5 
    291270 
    292271   ! namcfg 
    293    CHARACTER(LEN=lc)  :: cn_varcfg = 'variable.cfg'  
     272   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
    294273 
    295274   ! namcrs 
    296    CHARACTER(LEN=lc)  :: cn_coord0 = ''  
    297    INTEGER(i4)        :: in_perio0 = -1 
     275   CHARACTER(LEN=lc)                       :: cn_coord0 = ''  
     276   INTEGER(i4)                             :: in_perio0 = -1 
    298277 
    299278   ! namfin 
    300    CHARACTER(LEN=lc)  :: cn_coord1 = ''  
    301    CHARACTER(LEN=lc)  :: cn_bathy1 = ''  
    302    INTEGER(i4)        :: in_perio1 = -1 
     279   CHARACTER(LEN=lc)                       :: cn_coord1 = ''  
     280   CHARACTER(LEN=lc)                       :: cn_bathy1 = ''  
     281   INTEGER(i4)                             :: in_perio1 = -1 
    303282 
    304283   !namzgr 
    305    REAL(dp)          :: dn_pp_to_be_computed = 0._dp 
    306    REAL(dp)          :: dn_ppsur     = -3958.951371276829_dp 
    307    REAL(dp)          :: dn_ppa0      =   103.9530096000000_dp 
    308    REAL(dp)          :: dn_ppa1      =     2.4159512690000_dp 
    309    REAL(dp)          :: dn_ppa2      =   100.7609285000000_dp 
    310    REAL(dp)          :: dn_ppkth     =    15.3510137000000_dp 
    311    REAL(dp)          :: dn_ppkth2    =    48.0298937200000_dp 
    312    REAL(dp)          :: dn_ppacr     =     7.0000000000000_dp 
    313    REAL(dp)          :: dn_ppacr2    =    13.000000000000_dp 
    314    REAL(dp)          :: dn_ppdzmin   = 6._dp 
    315    REAL(dp)          :: dn_pphmax    = 5750._dp 
    316    INTEGER(i4)       :: in_nlevel    = 75 
    317  
    318    !namzps 
    319    REAL(dp)          :: dn_e3zps_min = 25._dp 
    320    REAL(dp)          :: dn_e3zps_rat = 0.2_dp 
     284   INTEGER(i4)                             :: in_nlevel = 75 
    321285 
    322286   ! namvar 
    … …  
    325289 
    326290   ! namnst 
    327    INTEGER(i4)       :: in_rhoi  = 0 
    328    INTEGER(i4)       :: in_rhoj  = 0 
     291   INTEGER(i4)                             :: in_rhoi  = 0 
     292   INTEGER(i4)                             :: in_rhoj  = 0 
    329293 
    330294   ! nambdy 
    331    LOGICAL           :: ln_north   = .TRUE. 
    332    LOGICAL           :: ln_south   = .TRUE. 
    333    LOGICAL           :: ln_east    = .TRUE. 
    334    LOGICAL           :: ln_west    = .TRUE. 
    335    CHARACTER(LEN=lc) :: cn_north   = '' 
    336    CHARACTER(LEN=lc) :: cn_south   = '' 
    337    CHARACTER(LEN=lc) :: cn_east    = '' 
    338    CHARACTER(LEN=lc) :: cn_west    = '' 
    339    LOGICAL           :: ln_oneseg  = .TRUE. 
     295   LOGICAL                                 :: ln_north   = .TRUE. 
     296   LOGICAL                                 :: ln_south   = .TRUE. 
     297   LOGICAL                                 :: ln_east    = .TRUE. 
     298   LOGICAL                                 :: ln_west    = .TRUE. 
     299   CHARACTER(LEN=lc)                       :: cn_north   = '' 
     300   CHARACTER(LEN=lc)                       :: cn_south   = '' 
     301   CHARACTER(LEN=lc)                       :: cn_east    = '' 
     302   CHARACTER(LEN=lc)                       :: cn_west    = '' 
     303   LOGICAL                                 :: ln_oneseg  = .TRUE. 
     304   INTEGER(i4)                             :: in_extrap  = 0 
    340305 
    341306   ! namout 
    342    CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc'  
    343    REAL(dp)          :: dn_dayofs  = 0._dp 
    344    LOGICAL           :: ln_extrap  = .FALSE. 
     307   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc'  
    345308   !------------------------------------------------------------------- 
    346309 
    … …  
    356319   &  cn_coord0,     &  !< coordinate file 
    357320   &  in_perio0         !< periodicity index 
    358   
     321    
    359322   NAMELIST /namfin/ &  !< fine grid namelist 
    360323   &  cn_coord1,     &  !< coordinate file 
    … …  
    363326  
    364327   NAMELIST /namzgr/ & 
    365    &  dn_pp_to_be_computed, & 
    366    &  dn_ppsur,     & 
    367    &  dn_ppa0,      & 
    368    &  dn_ppa1,      & 
    369    &  dn_ppa2,      & 
    370    &  dn_ppkth,     & 
    371    &  dn_ppkth2,    & 
    372    &  dn_ppacr,     & 
    373    &  dn_ppacr2,    & 
    374    &  dn_ppdzmin,   & 
    375    &  dn_pphmax,    & 
    376    &  in_nlevel         !< number of vertical level 
    377  
    378    NAMELIST /namzps/ & 
    379    &  dn_e3zps_min, & 
    380    &  dn_e3zps_rat 
     328   &  in_nlevel 
    381329 
    382330   NAMELIST /namvar/ &  !< variable namelist 
    383331   &  cn_varinfo,    &  !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) 
    384332   &  cn_varfile        !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' )  
    385   
     333    
    386334   NAMELIST /namnst/ &  !< nesting namelist 
    387335   &  in_rhoi,       &  !< refinement factor in i-direction 
    … …  
    397345   &  cn_east ,      &  !< east  boundary indices on fine grid 
    398346   &  cn_west ,      &  !< west  boundary indices on fine grid 
    399    &  ln_oneseg         !< use only one segment for each boundary or not 
     347   &  ln_oneseg,     &  !< use only one segment for each boundary or not 
     348   &  in_extrap         !< number of mask point to be extrapolated 
    400349 
    401350   NAMELIST /namout/ &  !< output namelist 
    402    &  cn_fileout,    &  !< fine grid boundary file basename    
    403    &  dn_dayofs,     &  !< date offset in day (change only ouput file name) 
    404    &  ln_extrap         !< extrapolate or not 
     351   &  cn_fileout    !< fine grid boundary file basename    
    405352   !------------------------------------------------------------------- 
    406353 
    … …  
    501448   ! check 
    502449   ! check output file do not already exist 
    503    ! WARNING: do not work when use time to create output file name 
    504450   DO jk=1,ip_ncard 
    505451      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    506452      &                                TRIM(cp_card(jk)), 1 ) 
    507       INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist) 
    508       IF( ll_exist )THEN 
    509          CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//& 
    510          &  " already exist.") 
    511       ENDIF 
    512  
    513       cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    514       &                                TRIM(cp_card(jk)) ) 
    515453      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist) 
    516454      IF( ll_exist )THEN 
    … …  
    552490 
    553491   CALL iom_mpp_open(tl_bathy1) 
    554   
     492    
    555493   tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry') 
    556   
     494    
    557495   CALL iom_mpp_close(tl_bathy1) 
    558496 
    559    ! get boundaries indices 
    560497   tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, & 
    561498   &                                cn_north, cn_south, cn_east, cn_west, & 
    … …  
    568505   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
    569506 
    570    ! get coordinate for each segment of each boundary 
     507   ! get coordinate on each segment of each boundary 
    571508   ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) ) 
    572509   ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) ) 
    573   
     510    
    574511   DO jl=1,ip_ncard 
    575512      IF( tl_bdy(jl)%l_use )THEN 
    … …  
    579516            tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, & 
    580517            &                                            tl_bdy(jl), jk ) 
    581  
    582             IF( .NOT. ln_extrap )THEN 
    583                ! get fine grid level 
    584                tl_seglvl1(:,jk,jl)= & 
    585                   & create_boundary_get_level( tl_level(:), & 
    586                   &                            tl_segdom1(:,jk,jl)) 
    587             ENDIF 
    588518 
    589519            ! add extra band to fine grid domain (if possible) 
    … …  
    593523               &                  il_rho(jp_I), il_rho(jp_J)) 
    594524            ENDDO 
     525 
     526            ! get fine grid level 
     527            tl_seglvl1(:,jk,jl)=create_boundary_get_level( tl_level(:), & 
     528                                                           tl_segdom1(:,jk,jl)) 
    595529 
    596530         ENDDO 
    … …  
    660594                        &                          in_nlevel ) 
    661595 
     596                        ! use mask 
     597                        CALL create_boundary_use_mask( tl_segvar1(jvar,jk,jl), & 
     598                        &                         tl_seglvl1(jpoint,jk,jl)) 
     599 
    662600                        !del extra 
    663601                        CALL dom_del_extra( tl_segvar1(jvar,jk,jl), & 
    … …  
    716654                  IF( tl_bdy(jl)%l_use )THEN 
    717655                      
    718                      WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 
    719                         &  ' boundary' 
     656                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 
    720657                     DO jk=1,tl_bdy(jl)%i_nseg 
    721658                        ! compute domain on fine grid 
    … …  
    725662                            
    726663                           cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 
    727                            WRITE(*,'(4x,a,a)') "work on (extract) variable "//& 
    728                               &  TRIM(cl_name) 
     664                           WRITE(*,'(4x,a,a)') "work on variable "//TRIM(cl_name) 
    729665 
    730666                           cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point 
    … …  
    742678 
    743679                           tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
     680                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 
    744681 
    745682                           ! open mpp files 
    … …  
    750687                           &                     tl_mpp, TRIM(cl_name), tl_dom1) 
    751688 
     689                           ! use mask 
     690                           CALL create_boundary_use_mask( & 
     691                           &                 tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 
     692 
    752693                           ! del extra point 
    753694                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
    … …  
    758699 
    759700                           ! add attribute to variable 
    760                            tl_att=att_init('src_file', & 
    761                               &  TRIM(fct_basename(tl_mpp%c_name))) 
     701                           tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
    762702                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    763703 
    764                            tl_att=att_init('src_i_indices', & 
    765                               &  (/tl_dom1%i_imin, tl_dom1%i_imax/)) 
     704                           tl_att=att_init('src_i_indices',(/tl_dom1%i_imin, tl_dom1%i_imax/)) 
    766705                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    767706 
    768                            tl_att=att_init('src_j_indices', & 
    769                               &  (/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 
     707                           tl_att=att_init('src_j_indices',(/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 
    770708                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    771709 
    … …  
    798736                  IF( tl_bdy(jl)%l_use )THEN 
    799737 
    800                      WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 
    801                         &  ' boundary' 
     738                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 
    802739                     DO jk=1,tl_bdy(jl)%i_nseg 
    803740                         
    804741                        ! for each variable of this file 
    805742                        DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    806   
    807                            WRITE(*,'(4x,a,a)') "work on (interp) variable "//& 
     743                            
     744                           WRITE(*,'(4x,a,a)') "work on variable "//& 
    808745                           &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    809746 
    … …  
    822759 
    823760                           tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
     761                           tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 
    824762 
    825763                           CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 
    … …  
    857795                           &                 il_jmin0, il_jmax0 ) 
    858796 
    859                            ! add extra band (if possible) to compute  
    860                            ! interpolation 
     797                           ! add extra band (if possible) to compute interpolation 
    861798                           CALL dom_add_extra(tl_dom0) 
    862799 
    … …  
    878815                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
    879816                           &                   tl_dom0, il_rho(:) ) 
     817 
     818                           ! use mask 
     819                           CALL create_boundary_use_mask( & 
     820                           &     tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 
    880821 
    881822                           ! del extra point on fine grid 
    … …  
    948889 
    949890   IF( jvar /= tl_multi%i_nvar )THEN 
    950       CALL logger_error("CREATE BOUNDARY: it seems some variable "//& 
    951          &  "can not be read") 
     891      CALL logger_error("CREATE BOUNDARY: it seems some variable can not be read") 
    952892   ENDIF 
     893 
     894   CALL var_clean(tl_seglvl1(:,:,:)) 
     895   DEALLOCATE( tl_seglvl1 ) 
    953896 
    954897   ! write file for each segment of each boundary 
    955898   DO jl=1,ip_ncard 
    956899      IF( tl_bdy(jl)%l_use )THEN 
     900 
     901         SELECT CASE(TRIM(tl_bdy(jk)%c_card)) 
     902         CASE('north','south') 
     903            il_dim=1 
     904         CASE('east','west') 
     905            il_dim=2 
     906         END SELECT    
    957907 
    958908         DO jk=1,tl_bdy(jl)%i_nseg 
    … …  
    961911            &                               'T', tl_lon1, tl_lat1 ) 
    962912 
    963             ! force to use nav_lon, nav_lat as variable name 
    964             tl_lon1%c_name='nav_lon' 
    965             tl_lat1%c_name='nav_lat' 
    966  
    967913            ! del extra point on fine grid 
    968914            CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) ) 
    … …  
    978924            CALL boundary_swap(tl_lat1, tl_bdy(jl)) 
    979925            DO jvar=1,tl_multi%i_nvar 
     926               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl)) 
    980927 
    981928               ! use additional request 
    982                ! change unit and apply factor 
    983                CALL var_chg_unit(tl_segvar1(jvar,jk,jl)) 
    984  
    985929               ! forced min and max value 
    986930               CALL var_limit_value(tl_segvar1(jvar,jk,jl)) 
    … …  
    989933               CALL filter_fill_value(tl_segvar1(jvar,jk,jl)) 
    990934 
    991                IF( .NOT. ln_extrap )THEN 
    992                   ! use mask 
    993                   SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point)) 
    994                   CASE DEFAULT !'T' 
    995                      jpoint=jp_T 
    996                   CASE('U') 
    997                      jpoint=jp_U 
    998                   CASE('V') 
    999                      jpoint=jp_V 
    1000                   CASE('F') 
    1001                      jpoint=jp_F 
    1002                   END SELECT 
    1003  
    1004                   CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), & 
    1005                   &                             tl_seglvl1(jpoint,jk,jl)) 
    1006                ENDIF 
    1007  
    1008                ! swap dimension order 
    1009                CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl)) 
     935               ! extrapolate 
     936               CALL extrap_fill_value( tl_segvar1(jvar,jk,jl), & 
     937               &                       id_iext=in_extrap,      & 
     938               &                       id_jext=in_extrap,      & 
     939               &                       id_kext=in_extrap ) 
    1010940 
    1011941            ENDDO 
    … …  
    1014944            ! create file structure 
    1015945            ! set file namearray of level variable structure 
    1016             IF( tl_bdy(jl)%i_nseg > 1 )THEN 
    1017                IF( ASSOCIATED(tl_time%d_value) )THEN 
    1018                   cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" 
    1019                   tl_date=var_to_date(tl_time) 
    1020                   tl_date=tl_date+dn_dayofs 
    1021                   cl_date=date_print( tl_date, cl_fmt )  
    1022  
    1023                   cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    1024                   &                                TRIM(tl_bdy(jl)%c_card), jk,& 
    1025                   &                                cd_date=TRIM(cl_date) ) 
    1026                ELSE 
    1027                   cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    1028                   &                                TRIM(tl_bdy(jl)%c_card), jk ) 
    1029                ENDIF 
     946            IF( ASSOCIATED(tl_time%d_value) )THEN 
     947               cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" 
     948               cl_date=date_print( var_to_date(tl_time), cl_fmt )  
     949 
     950               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
     951               &                                TRIM(tl_bdy(jl)%c_card), jk, TRIM(cl_date) ) 
    1030952            ELSE 
    1031                IF( ASSOCIATED(tl_time%d_value) )THEN 
    1032                   cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" 
    1033                   tl_date=var_to_date(tl_time) 
    1034                   tl_date=tl_date+dn_dayofs 
    1035                   cl_date=date_print( tl_date, cl_fmt ) 
    1036  
    1037                   cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    1038                   &                                TRIM(tl_bdy(jl)%c_card), & 
    1039                   &                                cd_date=TRIM(cl_date) ) 
    1040                ELSE 
    1041                   cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    1042                   &                                TRIM(tl_bdy(jl)%c_card) ) 
    1043                ENDIF 
     953               cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
     954               &                                TRIM(tl_bdy(jl)%c_card), jk ) 
    1044955            ENDIF 
    1045956            !  
    … …  
    1049960            tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl)) 
    1050961 
     962            CALL dim_unorder(tl_dim(:)) 
    1051963            SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 
    1052964               CASE DEFAULT ! 'north','south' 
    1053965                  cl_dimorder='xyzt' 
     966                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
    1054967               CASE('east','west') 
    1055968                  cl_dimorder='yxzt' 
     969                  CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
     970                  ! reorder coordinates dimension 
     971                  CALL var_reorder(tl_lon1,TRIM(cl_dimorder)) 
     972                  CALL var_reorder(tl_lat1,TRIM(cl_dimorder)) 
     973                  ! reorder other variable dimension 
     974                  DO jvar=1,tl_multi%i_nvar 
     975                     CALL var_reorder(tl_segvar1(jvar,jk,jl),TRIM(cl_dimorder)) 
     976                  ENDDO 
    1056977            END SELECT 
    1057978 
    … …  
    1071992            ENDIF 
    1072993             
    1073  
    1074  
    1075994            IF( tl_dim(3)%l_use )THEN 
    1076                IF( ASSOCIATED(tl_depth%d_value) )THEN 
    1077                   ! add depth 
    1078                   CALL file_add_var(tl_fileout, tl_depth) 
    1079                ENDIF 
     995               ! add depth 
     996               CALL file_add_var(tl_fileout, tl_depth) 
    1080997            ENDIF 
    1081998 
    1082999            IF( tl_dim(4)%l_use )THEN 
    1083                IF( ASSOCIATED(tl_time%d_value) )THEN 
    1084                   ! add time 
    1085                   CALL file_add_var(tl_fileout, tl_time) 
    1086                ENDIF 
     1000               ! add time 
     1001               CALL file_add_var(tl_fileout, tl_time) 
    10871002            ENDIF 
    10881003 
    10891004            ! add other variable 
    1090             DO jvar=tl_multi%i_nvar,1,-1 
     1005            DO jvar=1,tl_multi%i_nvar 
    10911006               CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl)) 
    10921007               CALL var_clean(tl_segvar1(jvar,jk,jl)) 
    … …  
    11331048 
    11341049            ! write file 
    1135             CALL iom_write_file(tl_fileout, cl_dimorder) 
     1050            CALL iom_write_file(tl_fileout) 
    11361051 
    11371052            ! close file 
    … …  
    11511066   DEALLOCATE( tl_segdom1 ) 
    11521067   DEALLOCATE( tl_segvar1 ) 
    1153    CALL var_clean(tl_seglvl1(:,:,:)) 
    1154    DEALLOCATE( tl_seglvl1 ) 
    1155  
    11561068 
    11571069   CALL mpp_clean(tl_coord1) 
    … …  
    11701082   !>  
    11711083   !> @author J.Paul 
    1172    !> @date November, 2013 - Initial Version 
     1084   !> - November, 2013- Initial Version 
    11731085   !> @date September, 2014 
    11741086   !> - take into account grid point to compute boundary indices 
    … …  
    12741186   !------------------------------------------------------------------- 
    12751187   !> @brief 
    1276    !> This subroutine get coordinates over boundary domain 
     1188   !> This subroutine get coordinates over boudnary domain 
    12771189   !>  
    12781190   !> @author J.Paul 
    1279    !> @date November, 2013 - Initial Version 
    1280    !> @date September, 2014  
    1281    !> - take into account grid point 
     1191   !> - November, 2013- Initial Version 
     1192   !> @date September, 2014 - take into account grid point 
    12821193   !> 
    12831194   !> @param[in] td_coord1 coordinates file structure 
    … …  
    13261237   !------------------------------------------------------------------- 
    13271238   !> @brief 
    1328    !> This subroutine interpolate variable on boundary 
     1239   !> This subroutine interpolate variable over boundary 
    13291240   !>  
    13301241   !> @details  
    13311242   !> 
    13321243   !> @author J.Paul 
    1333    !> @date November, 2013 - Initial Version 
     1244   !> - Nov, 2013- Initial Version 
    13341245   !> 
    13351246   !> @param[inout] td_var variable structure  
    … …  
    13851296 
    13861297      ! extrapolate variable 
    1387       CALL extrap_fill_value( td_var ) 
     1298      CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext ) 
    13881299 
    13891300      ! interpolate Bathymetry 
    … …  
    13921303 
    13931304      ! remove extraband 
    1394       CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), & 
    1395          &                               il_jext*id_rho(jp_J)) 
     1305      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
    13961306 
    13971307   END SUBROUTINE create_boundary_interp 
    … …  
    14071317   !> 
    14081318   !> @author J.Paul 
    1409    !> @date November, 2013 - Initial Version 
     1319   !> - November, 2013- Initial Version 
    14101320   !> 
    14111321   !> @param[in] td_var    variable structure  
    … …  
    15121422   !> 
    15131423   !> @author J.Paul 
    1514    !> @date November, 2013 - Initial Version 
     1424   !> - November, 2013- Initial Version 
    15151425   !> 
    15161426   !> @param[inout] td_var variable structure  
    … …  
    15651475   !> 
    15661476   !> @author J.Paul 
    1567    !> @date November, 2013 - Initial Version 
     1477   !> - November, 2013- Initial Version 
    15681478   !> 
    15691479   !> @param[in] td_level  array of level variable structure 
    … …  
    16271537   !> 
    16281538   !> @author J.Paul 
    1629    !> @date November, 2014 - Initial Version 
     1539   !> - November, 2014- Initial Version 
    16301540   !> 
    16311541   !> @param[in] td_mpp       mpp structure 
    … …  
    16781588   !> 
    16791589   !> @author J.Paul 
    1680    !> @date November, 2014 - Initial Version 
     1590   !> - November, 2014- Initial Version 
    16811591   !> 
    16821592   !> @param[in] td_mpp      mpp structure 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_coord.f90

    r10248 r10251  
    2424!> @endcode 
    2525!>     
    26 !> @note  
    27 !>    you could find a template of the namelist in templates directory. 
    28 !> 
    2926!>    create_coord.nam comprise 6 namelists:<br/> 
    3027!>       - logger namelist (namlog) 
    … …  
    4239!>       - cn_logfile   : log filename 
    4340!>       - cn_verbosity : verbosity ('trace','debug','info', 
    44 !> 'warning','error','fatal','none') 
     41!> 'warning','error','fatal') 
    4542!>       - in_maxerror  : maximum number of error allowed 
    4643!> 
    … …  
    5754!>       - cn_varinfo : list of variable and extra information about request(s) 
    5855!> to be used.<br/> 
    59 !>          each elements of *cn_varinfo* is a string character  
    60 !>          (separated by ',').<br/> 
     56!>          each elements of *cn_varinfo* is a string character.<br/> 
    6157!>          it is composed of the variable name follow by ':',  
    6258!>          then request(s) to be used on this variable.<br/>  
    6359!>          request could be: 
    64 !>             - int = interpolation method 
    65 !>             - ext = extrapolation method 
    66 !>             - flt = filter method 
     60!>             - interpolation method 
     61!>             - extrapolation method 
     62!>             - filter method 
    6763!>  
    6864!>                requests must be separated by ';' .<br/> 
    … …  
    7268!>          @ref extrap and @ref filter modules.<br/> 
    7369!> 
    74 !>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight',  
    75 !>          'vosaline: int=cubic'<br/> 
     70!>          Example: 'votemper: linear; hann(2,3); dist_weight',  
     71!>          'vosaline: cubic'<br/> 
    7672!>          @note  
    7773!>             If you do not specify a method which is required,  
    … …  
    9490!> 
    9591!>    * _output namelist (namout)_: 
    96 !>       - cn_fileout : output coordinate file name 
     92!>       - cn_fileout : output coordinate file 
    9793!> 
    9894!> @author J.Paul 
    … …  
    156152   TYPE(TFILE)                                          :: tl_fileout 
    157153 
     154   ! check  
     155!   INTEGER(i4)                                          :: il_imin0 
     156!   INTEGER(i4)                                          :: il_imax0 
     157!   INTEGER(i4)                                          :: il_jmin0 
     158!   INTEGER(i4)                                          :: il_jmax0 
     159!   INTEGER(i4)      , DIMENSION(2,2)                    :: il_ind2 
     160!   TYPE(TMPP)                                           :: tl_mppout 
     161 
    158162   ! loop indices 
    159163   INTEGER(i4) :: ji 
    … …  
    161165 
    162166   ! namelist variable 
    163    ! namlog 
    164167   CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log'  
    165168   CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    166169   INTEGER(i4)       :: in_maxerror = 5 
    167170 
    168    ! namcfg 
    169    CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
    170  
    171    ! namcrs 
    172171   CHARACTER(LEN=lc) :: cn_coord0 = ''  
    173172   INTEGER(i4)       :: in_perio0 = -1 
    174173 
    175    ! namvar 
     174   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
     175 
    176176   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    177177 
    178    !namnst 
    179178   INTEGER(i4)       :: in_imin0 = 0 
    180179   INTEGER(i4)       :: in_imax0 = 0 
    … …  
    184183   INTEGER(i4)       :: in_rhoj  = 1 
    185184 
    186    !namout 
    187185   CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc' 
    188186   !------------------------------------------------------------------- 
    … …  
    307305 
    308306      il_offset(:,:,:)=create_coord_get_offset(il_rho(:)) 
     307 
    309308   ENDIF 
    310309 
    … …  
    349348      CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. ) 
    350349 
     350      ! do not add ghost cell.  
     351      ! ghost cell already replace by value for coordinates  
     352      ! CALL grid_add_ghost(tl_var(ji),tl_dom%i_ghost(:,:)) 
     353 
    351354      ! filter 
    352355      CALL filter_fill_value(tl_var(ji))       
    … …  
    372375 
    373376   ! add variables 
    374    DO ji=il_nvar,1,-1 
     377   DO ji=1,il_nvar 
    375378      CALL file_add_var(tl_fileout, tl_var(ji)) 
    376       CALL var_clean(tl_var(ji)) 
    377379   ENDDO 
     380 
     381   ! recompute some attribute 
    378382 
    379383   ! add some attribute 
    … …  
    436440 
    437441   CALL file_clean(tl_fileout) 
     442 
     443!   ! check domain 
     444!   tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 
     445!   tl_mppout=mpp_init( file_init(TRIM(cn_fileout)) ) 
     446!   CALL grid_get_info(tl_coord0) 
     447!   CALL iom_mpp_open(tl_mppout) 
     448! 
     449!   il_ind2(:,:)=grid_get_coarse_index( tl_coord0, tl_mppout, & 
     450!   &                                   id_rho=il_rho(:) ) 
     451! 
     452!   il_imin0=il_ind2(1,1) ; il_imax0=il_ind2(1,2) 
     453!   il_jmin0=il_ind2(2,1) ; il_jmax0=il_ind2(2,2) 
     454! 
     455!   IF( il_imin0 /= in_imin0 .OR. & 
     456!   &   il_imax0 /= in_imax0 .OR. & 
     457!   &   il_jmin0 /= in_jmin0 .OR. & 
     458!   &   il_jmax0 /= in_jmax0 )THEN 
     459!      CALL logger_debug("CREATE COORD: output indices ("//& 
     460!      &                 TRIM(fct_str(il_imin0))//","//& 
     461!      &                 TRIM(fct_str(il_imax0))//") ("//& 
     462!      &                 TRIM(fct_str(il_jmin0))//","//& 
     463!      &                 TRIM(fct_str(il_jmax0))//")" )  
     464!      CALL logger_debug("CREATE COORD: input indices ("//& 
     465!      &                 TRIM(fct_str(in_imin0))//","//& 
     466!      &                 TRIM(fct_str(in_imax0))//") ("//& 
     467!      &                 TRIM(fct_str(in_jmin0))//","//& 
     468!      &                 TRIM(fct_str(in_jmax0))//")" )  
     469!      CALL logger_fatal("CREATE COORD: output domain not confrom "//& 
     470!      &                 "with input indices") 
     471!   ENDIF 
     472! 
     473!   CALL iom_mpp_close(tl_coord0) 
     474!   CALL iom_mpp_close(tl_mppout) 
    438475 
    439476   ! close log file 
    … …  
    502539   !> @param[in] id_iext   number of points to be extrapolated in i-direction 
    503540   !> @param[in] id_jext   number of points to be extrapolated in j-direction 
    504    !> 
    505    !> @todo check if mask is really needed 
    506541   !------------------------------------------------------------------- 
    507542   SUBROUTINE create_coord_interp( td_var,          & 
    … …  
    591626 
    592627         ! extrapolate variable 
    593          CALL extrap_fill_value( td_var ) 
     628         CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext ) 
    594629 
    595630         ! interpolate variable 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90

    r10248 r10251  
    2525!> @endcode 
    2626!>     
    27 !> @note  
    28 !>    you could find a template of the namelist in templates directory. 
    29 !> 
    3027!>    create_restart.nam comprise 9 namelists:<br/> 
    3128!>       - logger namelist (namlog) 
    … …  
    4643!>       - cn_logfile   : log filename 
    4744!>       - cn_verbosity : verbosity ('trace','debug','info', 
    48 !> 'warning','error','fatal','none') 
     45!> 'warning','error','fatal') 
    4946!>       - in_maxerror  : maximum number of error allowed 
    5047!> 
    … …  
    6259!>       - cn_bathy1 : bathymetry file 
    6360!>       - in_perio1 : NEMO periodicity index 
     61!>       - in_extrap : number of land point to be extrapolated  
     62!>       before writing file 
    6463!> 
    6564!>    * _vertical grid namelist (namzgr)_:<br/> 
    … …  
    8483!>       - cn_varinfo : list of variable and extra information about request(s)  
    8584!>       to be used.<br/> 
    86 !>          each elements of *cn_varinfo* is a string character 
    87 !>          (separated by ',').<br/> 
     85!>          each elements of *cn_varinfo* is a string character.<br/> 
    8886!>          it is composed of the variable name follow by ':',  
    8987!>          then request(s) to be used on this variable.<br/>  
    9088!>          request could be: 
    91 !>             - int = interpolation method 
    92 !>             - ext = extrapolation method 
    93 !>             - flt = filter method 
    94 !>             - min = minimum value 
    95 !>             - max = maximum value 
    96 !>             - unt = new units 
    97 !>             - unf = unit scale factor (linked to new units) 
     89!>             - interpolation method 
     90!>             - extrapolation method 
     91!>             - filter method 
     92!>             - > minimum value 
     93!>             - < maximum value 
    9894!> 
    9995!>             requests must be separated by ';'.<br/> 
    … …  
    10298!>          informations about available method could be find in @ref interp, 
    10399!>          @ref extrap and @ref filter.<br/> 
    104 !>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic' 
     100!>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic' 
    105101!>          @note  
    106102!>             If you do not specify a method which is required,  
    … …  
    140136!>    * _output namelist (namout)_:<br/> 
    141137!>       - cn_fileout : output file 
    142 !>       - ln_extrap : extrapolate land point or not 
     138!>       - in_nproc  : total number of processor to be used 
    143139!>       - in_niproc : i-direction number of processor 
    144140!>       - in_njproc : j-direction numebr of processor 
    145 !>       - in_nproc  : total number of processor to be used 
    146141!>       - cn_type   : output format ('dimg', 'cdf') 
    147142!> 
    … …  
    153148!> - offset computed considering grid point 
    154149!> - add attributes in output variable 
    155 !> @date June, 2015 
    156 !> - extrapolate all land points, and add ln_extrap in namelist. 
    157 !> - allow to change unit. 
    158150!> 
    159151!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    173165   USE iom                             ! I/O manager 
    174166   USE grid                            ! grid manager 
    175    USE vgrid                            ! vertical grid manager 
     167   USE vgrid                           ! vertical grid manager 
    176168   USE extrap                          ! extrapolation manager 
    177169   USE interp                          ! interpolation manager 
    … …  
    257249   CHARACTER(LEN=lc) :: cn_bathy1 = '' 
    258250   INTEGER(i4)       :: in_perio1 = -1 
     251   INTEGER(i4)       :: in_extrap = 0 
    259252 
    260253   !namzgr 
    … …  
    286279   ! namout 
    287280   CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'  
    288    LOGICAL           :: ln_extrap  = .FALSE. 
    289281   INTEGER(i4)       :: in_nproc   = 0 
    290282   INTEGER(i4)       :: in_niproc  = 0 
    … …  
    309301   &  cn_coord1,   &    !< coordinate file 
    310302   &  cn_bathy1,   &    !< bathymetry file 
    311    &  in_perio1         !< periodicity index 
     303   &  in_perio1,   &    !< periodicity index 
     304   &  in_extrap 
    312305  
    313306   NAMELIST /namzgr/ & 
    … …  
    339332   NAMELIST /namout/ &  !< output namlist 
    340333   &  cn_fileout, &     !< fine grid bathymetry file 
    341    &  ln_extrap,  &     !< extrapolate or not 
     334   &  in_nproc,   &     !< number of processor to be used 
    342335   &  in_niproc,  &     !< i-direction number of processor 
    343336   &  in_njproc,  &     !< j-direction numebr of processor 
    344    &  in_nproc,   &     !< number of processor to be used 
    345337   &  cn_type           !< output type format (dimg, cdf) 
    346338   !------------------------------------------------------------------- 
    … …  
    355347      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 
    356348   ENDIF 
    357  
     349    
    358350   ! read namelist 
    359351   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
    … …  
    442434   ! check 
    443435   ! check output file do not already exist 
    444    IF( in_nproc > 0 )THEN 
    445       cl_fileout=file_rename(cn_fileout,1) 
    446    ELSE 
    447       cl_fileout=file_rename(cn_fileout) 
    448    ENDIF 
     436   cl_fileout=file_rename(cn_fileout,1) 
    449437   INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 
    450438   IF( ll_exist )THEN 
    … …  
    480468   &                            il_rho(:) ) 
    481469 
    482    ! fine grid ghost cell 
     470   ! compute level 
     471   ALLOCATE(tl_level(ip_npoint)) 
     472   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
     473 
     474   ! remove ghost cell 
    483475   il_xghost(:,:)=grid_get_ghost(tl_bathy1) 
     476   DO ji=1,ip_npoint 
     477      CALL grid_del_ghost(tl_level(ji), il_xghost(:,:)) 
     478   ENDDO 
     479 
     480   ! clean 
     481   CALL mpp_clean(tl_bathy1) 
    484482 
    485483   ! work on variables 
    … …  
    516514               tl_var(jvar) = create_restart_matrix( & 
    517515               &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, & 
    518                &  in_nlevel, il_xghost(:,:) ) 
    519  
    520                ! add ghost cell 
    521                CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 
     516               &  in_nlevel, tl_level(:) ) 
    522517 
    523518            ENDDO 
    … …  
    540535            ! open mpp file 
    541536            CALL iom_mpp_open(tl_mpp) 
    542  
    543537 
    544538            ! get or check depth value 
    … …  
    585579               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    586580 
    587                   WRITE(*,'(2x,a,a)') "work on (extract) variable "//& 
     581                  WRITE(*,'(2x,a,a)') "work on variable "//& 
    588582                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    589583 
    … …  
    606600                  CALL att_clean(tl_att) 
    607601 
     602                  ! use mask 
     603                  CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
     604 
    608605                  ! add ghost cell 
    609                   CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:)) 
     606                  CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:) ) 
    610607 
    611608               ENDDO 
    … …  
    634631               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    635632 
    636                   WRITE(*,'(2x,a,a)') "work on (interp) variable "//& 
     633                  WRITE(*,'(2x,a,a)') "work on variable "//& 
    637634                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    638635 
    … …  
    649646                  &                                   id_rho=il_rho(:), & 
    650647                  &                                   cd_point=TRIM(tl_var(jvar)%c_point)) 
     648                   
    651649 
    652650                  ! interpolate variable 
    653                   CALL create_restart_interp(tl_var(jvar), &  
     651                  CALL create_restart_interp(tl_var(jvar), tl_level(:), & 
    654652                  &                          il_rho(:), & 
    655653                  &                          id_offset=il_offset(:,:)) 
    … …  
    677675                  CALL att_clean(tl_att) 
    678676 
     677                  ! use mask 
     678                  CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
     679 
    679680                  ! add ghost cell 
    680                   CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 
     681                  CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) ) 
     682 
     683 
    681684               ENDDO 
    682685 
    … …  
    702705   CALL mpp_clean(tl_coord0) 
    703706 
    704    IF( .NOT. ln_extrap )THEN 
    705       ! compute level 
    706       ALLOCATE(tl_level(ip_npoint)) 
    707       tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
    708    ENDIF 
    709  
    710    ! clean 
    711    CALL mpp_clean(tl_bathy1) 
    712  
    713707   ! use additional request 
    714708   DO jvar=1,il_nvar 
    715709 
    716       ! change unit and apply factor 
    717       CALL var_chg_unit(tl_var(jvar)) 
    718  
    719710      ! forced min and max value 
    720711      CALL var_limit_value(tl_var(jvar)) 
    … …  
    723714      CALL filter_fill_value(tl_var(jvar)) 
    724715 
    725       IF( .NOT. ln_extrap )THEN 
    726          ! use mask 
    727          CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    728       ENDIF 
     716      ! extrapolate 
     717      CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, & 
     718      &                                    id_jext=in_extrap, & 
     719      &                                    id_kext=in_extrap) 
    729720 
    730721   ENDDO 
    … …  
    733724   IF( in_niproc == 0 .AND. & 
    734725   &   in_njproc == 0 .AND. & 
    735    &   in_nproc == 0 )THEN 
     726   &   in_nproc  == 0 )THEN 
    736727      in_niproc = 1 
    737728      in_njproc = 1 
    … …  
    791782         CALL mpp_add_var(tl_mppout, tl_depth) 
    792783      ELSE 
    793          CALL logger_warn("CREATE RESTART: no value for depth variable.") 
     784         CALL logger_error("CREATE RESTART: no value for depth variable.") 
    794785      ENDIF 
    795786   ENDIF 
    … …  
    801792         CALL mpp_add_var(tl_mppout, tl_time) 
    802793      ELSE 
    803          CALL logger_warn("CREATE RESTART: no value for time variable.") 
     794         CALL logger_error("CREATE RESTART: no value for time variable.") 
    804795      ENDIF 
    805796   ENDIF 
    … …  
    807798 
    808799   ! add other variable 
    809    DO jvar=il_nvar,1,-1 
     800   DO jvar=1,il_nvar 
    810801      ! check if variable already add 
    811802      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) 
    … …  
    816807   ENDDO 
    817808 
     809!   DO ji=1,4 
     810!      CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) ) 
     811!      CALL var_clean(tl_level(ji)) 
     812!   ENDDO 
     813 
    818814   ! add some attribute 
    819815   tl_att=att_init("Created_by","SIREN create_restart") 
    … …  
    843839   ENDIF 
    844840 
    845    ! print 
    846    CALL mpp_print(tl_mppout) 
    847  
    848841   ! create file 
    849842   CALL iom_mpp_create(tl_mppout) 
    … …  
    854847   CALL iom_mpp_close(tl_mppout) 
    855848 
     849   ! print 
     850   CALL mpp_print(tl_mppout) 
     851 
    856852   ! clean 
    857853   CALL att_clean(tl_att) 
    858854   CALL var_clean(tl_var(:)) 
    859855   DEALLOCATE(tl_var) 
    860    IF( .NOT. ln_extrap )THEN 
    861       CALL var_clean(tl_level(:)) 
    862       DEALLOCATE(tl_level) 
    863    ENDIF 
     856   CALL var_clean(tl_level(:)) 
     857   DEALLOCATE(tl_level) 
    864858 
    865859   CALL mpp_clean(tl_mppout) 
    … …  
    882876   !> 
    883877   !> @author J.Paul 
    884    !> @date November, 2013 - Initial Version 
    885    !> @date June, 2015 
    886    !> - do not use level anymore  
     878   !> - November, 2013- Initial Version 
    887879   !> 
    888880   !> @param[in] td_var    variable structure  
    889881   !> @param[in] td_coord  coordinate file structure  
    890882   !> @param[in] id_nlevel number of vertical level   
    891    !> @param[in] id_xghost ghost cell array 
     883   !> @param[in] td_level  array of level on T,U,V,F point (variable structure)  
    892884   !> @return variable structure  
    893885   !------------------------------------------------------------------- 
    894    FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost) 
     886   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level) 
    895887      IMPLICIT NONE 
    896888      ! Argument 
    897       TYPE(TVAR)                 , INTENT(IN) :: td_var 
    898       TYPE(TMPP)                 , INTENT(IN) :: td_coord 
    899       INTEGER(i4)                , INTENT(IN) :: id_nlevel 
    900       INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost 
     889      TYPE(TVAR)              , INTENT(IN) :: td_var 
     890      TYPE(TMPP)              , INTENT(IN) :: td_coord 
     891      INTEGER(i4)             , INTENT(IN) :: id_nlevel 
     892      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 
    901893 
    902894      ! function 
    … …  
    907899      INTEGER(i4)      , DIMENSION(3)                    :: il_size 
    908900      INTEGER(i4)      , DIMENSION(3)                    :: il_rest 
     901      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost 
    909902 
    910903      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape 
    … …  
    922915      !---------------------------------------------------------------- 
    923916 
     917      ! look for ghost cell 
     918      il_xghost(:,:)=grid_get_ghost( td_coord ) 
     919 
    924920      ! write value on grid 
    925921      ! get matrix dimension 
    … …  
    933929 
    934930      ! remove ghost cell 
    935       tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost 
    936       tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost 
     931      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(il_xghost(jp_I,:))*ip_ghost 
     932      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(il_xghost(jp_J,:))*ip_ghost 
    937933 
    938934      ! split output domain in N subdomain depending of matrix dimension  
    … …  
    996992      DEALLOCATE(dl_value) 
    997993 
     994      ! use mask 
     995      CALL create_restart_mask(create_restart_matrix, td_level(:)) 
     996 
     997      ! add ghost cell 
     998      CALL grid_add_ghost( create_restart_matrix, il_xghost(:,:) ) 
     999 
    9981000      ! clean  
    9991001      DEALLOCATE(il_ishape) 
    … …  
    10071009   !>  
    10081010   !> @author J.Paul 
    1009    !> @date November, 2013 - Initial Version 
     1011   !> - November, 2013- Initial Version 
    10101012   !> 
    10111013   !> @param[inout] td_var variable structure 
    … …  
    10691071   !>  
    10701072   !> @author J.Paul 
    1071    !> @date November, 2013 - Initial Version 
    1072    !> @date June, 2015 
    1073    !> - do not use level anymore (for extrapolation) 
     1073   !> - Nov, 2013- Initial Version 
    10741074   !> 
    10751075   !> @param[inout] td_var    variable structure  
     1076   !> @param[inout] td_level  fine grid level, array of variable structure 
    10761077   !> @param[in] id_rho       array of refinment factor 
    10771078   !> @param[in] id_offset    array of offset between fine and coarse grid 
    … …  
    10791080   !> @param[in] id_jext      j-direction size of extra bands (default=im_minext) 
    10801081   !------------------------------------------------------------------- 
    1081    SUBROUTINE create_restart_interp( td_var, &  
     1082   SUBROUTINE create_restart_interp( td_var, td_level,& 
    10821083   &                                 id_rho,          & 
    10831084   &                                 id_offset,       & 
    … …  
    10881089      ! Argument 
    10891090      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
     1091      TYPE(TVAR) , DIMENSION(:)  , INTENT(INOUT) :: td_level 
    10901092      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho 
    10911093      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset 
    … …  
    11171119         il_jext=2 
    11181120      ENDIF 
     1121 
    11191122      ! work on variable 
    11201123      ! add extraband 
    … …  
    11221125 
    11231126      ! extrapolate variable 
    1124       CALL extrap_fill_value( td_var ) 
     1127      CALL extrap_fill_value( td_var, td_level(:),    & 
     1128      &                               id_offset(:,:), & 
     1129      &                               id_rho(:),      & 
     1130      &                               id_iext=il_iext, id_jext=il_jext ) 
    11251131 
    11261132      ! interpolate variable 
    … …  
    11401146   !> 
    11411147   !> @author J.Paul 
    1142    !> @date November, 2014 - Initial Version 
     1148   !> - November, 2014- Initial Version 
    11431149   !> 
    11441150   !> @param[in] td_mpp       mpp structure 
    … …  
    11911197   !> 
    11921198   !> @author J.Paul 
    1193    !> @date November, 2014 - Initial Version 
     1199   !> - November, 2014- Initial Version 
    11941200   !> 
    11951201   !> @param[in] td_mpp      mpp structure 
    … …  
    12141220 
    12151221      ! get or check depth value 
    1216  
    12171222      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
    12181223 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r10248 r10251  
    7878!> 
    7979!>    This subroutine filled dimension structure with unused dimension,  
    80 !>    then switch from "disordered" dimension to "ordered" dimension.<br/> 
     80!>    then switch from "unordered" dimension to "ordered" dimension.<br/> 
    8181!>    The dimension structure return will be:<br/> 
    8282!>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/> 
    … …  
    9494!>    - cl_neworder : character(len=4) (example: 'yxzt') 
    9595!> 
    96 !>    to switch dimension array from ordered dimension to disordered 
     96!>    to switch dimension array from ordered dimension to unordered 
    9797!> dimension:<br/> 
    9898!> @code 
    99 !>    CALL dim_disorder(tl_dim(:)) 
     99!>    CALL dim_unorder(tl_dim(:)) 
    100100!> @endcode 
    101101!> 
    … …  
    111111!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:)) 
    112112!> @endcode 
    113 !>       - value must be a 4D array of real(8) value "disordered" 
    114 !> 
    115 !>    to reshape array of value in "disordered" dimension:<br/> 
     113!>       - value must be a 4D array of real(8) value "unordered" 
     114!> 
     115!>    to reshape array of value in "unordered" dimension:<br/> 
    116116!> @code 
    117117!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:)) 
    … …  
    123123!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 
    124124!> @endcode 
    125 !>       - tab must be a 1D array with 4 elements "disordered". 
     125!>       - tab must be a 1D array with 4 elements "unordered". 
    126126!>       It could be composed of character, integer(4), or logical 
    127127!>  
    128 !>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/> 
    129 !> @code 
    130 !>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:)) 
     128!>    to reorder a 1D array of 4 elements in "unordered" dimension:<br/> 
     129!> @code 
     130!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 
    131131!> @endcode 
    132132!>       - tab must be a 1D array with 4 elements "ordered". 
    … …  
    173173   PUBLIC :: dim_print         !< print dimension information 
    174174   PUBLIC :: dim_copy          !< copy dimension structure 
    175    PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension 
    176    PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension 
     175   PUBLIC :: dim_reorder       !< filled dimension structure to switch from unordered to ordered dimension 
     176   PUBLIC :: dim_unorder       !< switch dimension array from ordered to unordered dimension 
    177177   PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension  
    178178   PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t') 
    … …  
    321321   !> @author J.Paul 
    322322   !> @date November, 2013 - Initial Version 
    323    !> @date September, 2014  
    324    !> - do not check if dimension used 
     323   !> @date September, 2014 - do not check if dimension used 
    325324   !> 
    326325   !> @param[in] td_dim    array of dimension structure 
    … …  
    503502   !> Optionally length could be inform, as well as short name and if dimension 
    504503   !> is unlimited or not.<br/> 
    505    !> By default, define dimension is supposed to be used. 
    506    !> Optionally you could force a defined dimension to be unused.  
    507    !> 
    508    !> @author J.Paul 
    509    !> @date November, 2013 - Initial Version 
    510    !> @date February, 2015  
    511    !> - add optional argument to define dimension unused 
    512    !> @date July, 2015 
    513    !> - Bug fix: inform order to disorder table instead of disorder to order 
    514    !> table 
     504   !> define dimension is supposed to be used. 
     505   !> 
     506   !> @author J.Paul 
     507   !> @date November, 2013 - Initial Version 
    515508   ! 
    516509   !> @param[in] cd_name   dimension name 
    … …  
    518511   !> @param[in] ld_uld    dimension unlimited 
    519512   !> @param[in] cd_sname  dimension short name 
    520    !> @param[in] ld_uld    dimension use or not 
    521513   !> @return dimension structure 
    522514   !------------------------------------------------------------------- 
    523    TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use) 
     515   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname) 
    524516      IMPLICIT NONE 
    525517 
    … …  
    529521      LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld 
    530522      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname 
    531       LOGICAL,          INTENT(IN), OPTIONAL :: ld_use 
    532523 
    533524      ! local variable 
    … …  
    552543 
    553544      ! define dimension is supposed to be used 
    554       IF( PRESENT(ld_use) )THEN 
    555          dim_init%l_use=ld_use 
    556       ELSE 
    557          dim_init%l_use=.TRUE. 
    558       ENDIF 
     545      dim_init%l_use=.TRUE. 
    559546 
    560547      IF( PRESENT(cd_sname) )THEN 
    … …  
    603590      ENDIF 
    604591       
    605       ! get dimension order indices 
    606       dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
     592      ! get dimension orderer index 
     593      dim_init%i_2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
    607594 
    608595   END FUNCTION dim_init 
    … …  
    668655   !> @author J.Paul 
    669656   !> @date November, 2013 - Initial Version 
    670    !> @date July, 2015  
    671    !> - Bug fix: use order to disorder table (see dim_init) 
    672657   !> 
    673658   !> @param[in] td_dim array of dimension structure 
    … …  
    701686         ! search missing dimension 
    702687         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN 
    703             ! search first empty dimension (see dim_init) 
    704             il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 ) 
     688            ! search first empty dimension 
     689            il_ind(:)=MINLOC( tl_dim(:)%i_2xyzt, tl_dim(:)%i_2xyzt == 0 ) 
    705690 
    706691            ! put missing dimension instead of empty one 
    … …  
    708693            ! update output structure 
    709694            tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 
    710             tl_dim(il_ind(1))%i_xyzt2=ji 
     695            tl_dim(il_ind(1))%i_2xyzt=ji 
    711696            tl_dim(il_ind(1))%i_len=1 
    712697            tl_dim(il_ind(1))%l_use=.FALSE. 
    … …  
    726711   !> This subroutine switch element of an array (4 elts) of dimension  
    727712   !> structure  
    728    !> from disordered dimension to ordered dimension <br/> 
     713   !> from unordered dimension to ordered dimension <br/> 
    729714   !> 
    730715   !> @details 
    … …  
    737722   !> @author J.Paul 
    738723   !> @date November, 2013 - Initial Version 
    739    !> @date September, 2014  
    740    !> - allow to choose ordered dimension to be output 
     724   !> @date September, 2014 - allow to choose ordered dimension to be output 
    741725   !> 
    742726   !> @param[inout] td_dim    array of dimension structure 
    … …  
    827811   !------------------------------------------------------------------- 
    828812   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t') 
    829    !> to disordered dimension. <br/> 
     813   !> to unordered dimension. <br/> 
    830814   !> @details 
    831815   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/> 
    … …  
    838822   !> @param[inout] td_dim array of dimension structure 
    839823   !------------------------------------------------------------------- 
    840    SUBROUTINE dim_disorder(td_dim) 
     824   SUBROUTINE dim_unorder(td_dim) 
    841825      IMPLICIT NONE 
    842826      ! Argument       
    … …  
    851835 
    852836      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    853          CALL logger_error("DIM DISORDER: invalid dimension of array dimension.") 
     837         CALL logger_error("DIM UNORDER: invalid dimension of array dimension.") 
    854838      ELSE       
    855839         ! add dummy xyzt2 id to unused dimension 
    … …  
    884868      ENDIF 
    885869 
    886    END SUBROUTINE dim_disorder 
     870   END SUBROUTINE dim_unorder 
    887871   !------------------------------------------------------------------- 
    888872   !> @brief This function reshape real(8) 4D array    
    … …  
    924908 
    925909      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    926          CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//& 
    927             &  "array dimension.") 
     910         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of array dimension.") 
    928911      ELSE       
    929912 
    … …  
    931914 
    932915            CALL logger_fatal( & 
    933             &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// & 
    934             &  "   before running RESHAPE" ) 
     916            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder & 
     917            &     before running RESHAPE" ) 
    935918 
    936919         ENDIF 
    … …  
    989972   !------------------------------------------------------------------- 
    990973   !> @brief This function reshape ordered real(8) 4D array with dimension  
    991    !> (/'x','y','z','t'/) to an "disordered" array.<br/> 
     974   !> (/'x','y','z','t'/) to an "unordered" array.<br/> 
    992975   !> @details 
    993976   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/) 
    … …  
    10261009 
    10271010      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    1028          CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//& 
    1029             &  "array dimension.") 
     1011         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of array dimension.") 
    10301012      ELSE 
    10311013 
    … …  
    10331015 
    10341016            CALL logger_fatal( & 
    1035             &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// & 
    1036             &  "   before running RESHAPE" ) 
     1017            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder & 
     1018            &     before running RESHAPE" ) 
    10371019 
    10381020         ENDIF         
    … …  
    11221104 
    11231105            CALL logger_error( & 
    1124             &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//& 
    1125             &  "   before running REORDER" ) 
     1106            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
     1107            &     before running REORDER" ) 
    11261108 
    11271109         ENDIF         
    … …  
    11341116   END FUNCTION dim__reorder_2xyzt_i4 
    11351117   !------------------------------------------------------------------- 
    1136    !> @brief This function disordered integer(4) 1D array to be suitable with 
     1118   !> @brief This function unordered integer(4) 1D array to be suitable with 
    11371119   !> initial dimension order (ex: dimension read in file). 
    11381120   !> @note you must have run dim_reorder before use this subroutine 
    … …  
    11611143      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    11621144      &   SIZE(id_arr(:)) /= ip_maxdim )THEN 
    1163          CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//& 
    1164             &  "array dimension or of array of value.") 
     1145         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//& 
     1146         &              " or of array of value.") 
    11651147      ELSE       
    11661148         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    11671149 
    11681150            CALL logger_error( & 
    1169             &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// & 
    1170             &  "   before running REORDER" ) 
     1151            &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
     1152            &     before running REORDER" ) 
    11711153 
    11721154         ENDIF         
    … …  
    11841166   ! 
    11851167   !> @author J.Paul 
    1186    !> @date November, 2013 - Initial Version 
     1168   !> @date Nov, 2013 - Initial Version 
    11871169   ! 
    11881170   !> @param[in] td_dim array of dimension structure 
    … …  
    12111193 
    12121194            CALL logger_error( & 
    1213             &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// & 
    1214             &  "   before running REORDER" ) 
     1195            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
     1196            &     before running REORDER" ) 
    12151197 
    12161198         ENDIF         
    … …  
    12231205   END FUNCTION dim__reorder_2xyzt_l 
    12241206   !------------------------------------------------------------------- 
    1225    !> @brief This function disordered logical 1D array to be suitable with 
     1207   !> @brief This function unordered logical 1D array to be suitable with 
    12261208   !> initial dimension order (ex: dimension read in file). 
    12271209   !> @note you must have run dim_reorder before use this subroutine 
    … …  
    12561238 
    12571239            CALL logger_error( & 
    1258             &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//& 
    1259             &  "  before running REORDER" ) 
     1240            &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
     1241            &     before running REORDER" ) 
    12601242 
    12611243         ENDIF         
    … …  
    13121294   END FUNCTION dim__reorder_2xyzt_c 
    13131295   !------------------------------------------------------------------- 
    1314    !> @brief This function disordered string 1D array to be suitable with 
     1296   !> @brief This function unordered string 1D array to be suitable with 
    13151297   !> initial dimension order (ex: dimension read in file). 
    13161298   !> @note you must have run dim_reorder before use this subroutine 
    13171299   ! 
    13181300   !> @author J.Paul 
    1319    !> @date November, 2013 - Initial Version 
     1301   !> @date Nov, 2013 - Initial Version 
    13201302   ! 
    13211303   !> @param[in] td_dim array of dimension structure 
    … …  
    13441326         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    13451327            CALL logger_error( & 
    1346             &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// & 
    1347             &  "   before running REORDER" ) 
     1328            &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
     1329            &     before running REORDER" ) 
    13481330 
    13491331         ENDIF         

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md

    r10248 r10251  
    1313# Fortran Compiler 
    1414   SIREN codes were succesfully tested with : 
    15    - ifort (version 15.0.1) 
    16    - gfortran (version 4.8.2 20140120)  
     15   - ifort (version 12.0.4) 
     16   - gfortran (version 4.7.2 20121109) 
    1717<!--   - pgf95 (version 13.9-0) --> 
    1818 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md

    r10248 r10251  
    8080 
    8181# Implicit none {#implicit} 
    82 All subroutines and functions will include an IMPLICIT NONE statement. 
     82All subroutines and functions will include an IMPLICTI NONE statement. 
    8383 
    8484# Header {#header} 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/domain.f90

    r10248 r10251  
    246246   ! 
    247247   !> @author J.Paul 
    248    !> @date November, 2013 - Initial Version 
     248   !> - Nov, 2013- Initial Version 
    249249   ! 
    250250   !> @param[inout] td_dom dom structure 
    … …  
    294294   ! 
    295295   !> @author J.Paul 
    296    !> @date June, 2013 - Initial Version 
     296   !> - June, 2013- Initial Version 
    297297   !> @date September, 2014 
    298298   !> - add boundary index 
    … …  
    362362 
    363363         IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN 
    364             CALL logger_error("DOM INIT: invalid grid periodicity ("//& 
    365             &  TRIM(fct_str(td_mpp%i_perio))//& 
    366             &  ") you should use grid_get_perio to compute it") 
     364            CALL logger_error("DOM INIT: invalid grid periodicity. "//& 
     365            &  "you should use grid_get_perio to compute it") 
    367366         ELSE 
    368367            dom__init_mpp%i_perio0=td_mpp%i_perio 
    … …  
    425424   ! 
    426425   !> @author J.Paul 
    427    !> @date June, 2013 - Initial Version 
     426   !> - June, 2013- Initial Version 
    428427   !> @date September, 2014 
    429428   !> - add boundary index 
    … …  
    490489 
    491490         IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN 
    492             CALL logger_error("DOM INIT: invalid grid periodicity ("//& 
    493             &  TRIM(fct_str(td_file%i_perio))//& 
    494             &  ") you should use grid_get_perio to compute it") 
     491            CALL logger_error("DOM INIT: invalid grid periodicity. "//& 
     492            &  "you should use grid_get_perio to compute it") 
    495493         ELSE 
    496494            dom__init_file%i_perio0=td_file%i_perio 
    … …  
    550548   !> 
    551549   !> @author J.Paul 
    552    !> @date November, 2013 - Initial version 
     550   !> - November, 2013- Subroutine written 
    553551   ! 
    554552   !> @param[inout] td_dom domain structure 
    … …  
    655653   !> 
    656654   !> @author J.Paul 
    657    !> @date November, 2013 - Initial version 
     655   !> - November, 2013- Subroutine written 
    658656   !> @date September, 2014 
    659657   !> - use zero indice to defined cyclic or global domain 
    … …  
    723721   !> 
    724722   !> @author J.Paul 
    725    !> @date November, 2013 - Initial verison 
     723   !> - November, 2013- Subroutine written 
    726724   ! 
    727725   !> @param[inout] td_dom domain strcuture 
    … …  
    757755   !> 
    758756   !> @author J.Paul 
    759    !> @date November, 2013 - Initial version 
     757   !> - November, 2013- Subroutine written 
    760758   ! 
    761759   !> @param[inout] td_dom domain strcuture 
    … …  
    776774   !> 
    777775   !> @author J.Paul 
    778    !> @date November, 2013 - Initial version 
     776   !> - November, 2013- Subroutine written 
    779777   ! 
    780778   !> @param[inout] td_dom domain strcuture 
    … …  
    808806   !> 
    809807   !> @author J.Paul 
    810    !> @date November, 2013 - Initial version 
     808   !> - November, 2013- Subroutine written 
    811809   ! 
    812810   !> @param[inout] td_dom domain strcuture 
    … …  
    826824   !> 
    827825   !> @author J.Paul 
    828    !> @date November, 2013 - Initial version 
     826   !> - November, 2013- Subroutine written 
    829827   ! 
    830828   !> @param[inout] td_dom domain strcuture 
    … …  
    864862   !> 
    865863   !> @author J.Paul 
    866    !> @date November, 2013 - Initial version 
     864   !> - November, 2013- Subroutine written 
    867865   ! 
    868866   !> @param[inout] td_dom domain strcuture 
    … …  
    914912   !> 
    915913   !> @author J.Paul 
    916    !> @date November, 2013 - Initial version 
     914   !> - November, 2013- Subroutine written 
    917915   ! 
    918916   !> @param[inout] td_dom domain strcuture 
    … …  
    953951   !> 
    954952   !> @author J.Paul 
    955    !> @date April, 2013 - Initial version 
     953   !> - April, 2013- Subroutine written 
    956954   ! 
    957955   !> @param[inout] td_dom domain strcuture 
    … …  
    981979   !> 
    982980   !> @author J.Paul 
    983    !> @date November, 2013 - Initial version 
     981   !> - November, 2013- Subroutine written 
    984982   ! 
    985983   !> @param[inout] td_dom domain strcuture 
    … …  
    10431041   !> 
    10441042   !> @author J.Paul 
    1045    !> @date November, 2013 - Initial version 
     1043   !> - November, 2013- Subroutine written 
    10461044   ! 
    10471045   !> @param[inout] td_dom domain strcuture 
    … …  
    10841082   !> 
    10851083   !> @author J.Paul 
    1086    !> @date November, 2013 - Initial version 
     1084   !> - November, 2013- Subroutine written 
    10871085   ! 
    10881086   !> @param[inout] td_dom domain strcuture 
    … …  
    11821180   !> 
    11831181   !> @author J.Paul 
    1184    !> @date November, 2013 - Initial version 
     1182   !> - November, 2013- Subroutine written 
    11851183   ! 
    11861184   !> @param[inout] td_dom domain strcuture 
    … …  
    12941292   !> 
    12951293   !> @author J.Paul 
    1296    !> @date November, 2013 - Initial version 
     1294   !> @date November, 2013 
    12971295   !> @date September, 2014 
    12981296   !> - take into account number of ghost cell 
    … …  
    14351433   ! 
    14361434   !> @author J.Paul 
    1437    !> @date November, 2013 - Initial version 
     1435   !> @date November, 2013 
    14381436   ! 
    14391437   !> @param[inout] td_dom domain strcuture 
    … …  
    14781476   !>  
    14791477   !> @author J.Paul 
    1480    !> @date November, 2013 - Initial version 
     1478   !> @date November, 2013 
    14811479   !> @date September, 2014 
    14821480   !> - take into account boundary for one point size domain 
    … …  
    17171715   ! 
    17181716   !> @author J.Paul 
    1719    !> @date November, 2013 - Initial version 
     1717   !> @date November, 2013 
    17201718   ! 
    17211719   !> @param[inout] td_dom domain strcuture 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/extrap.f90

    r10248 r10251  
    1919!>    defining string character _cn\_varinfo_. By default _dist_weight_.<br/> 
    2020!>    Example: 
    21 !>       - cn_varinfo='varname1:ext=dist_weight', 'varname2:ext=min_error' 
     21!>       - cn_varinfo='varname1:dist_weight', 'varname2:min_error' 
    2222!> 
    2323!>    to detect point to be extrapolated:<br/> 
    2424!> @code 
    25 !>    il_detect(:,:,:)=extrap_detect(td_var) 
     25!>    il_detect(:,:,:)=extrap_detect(td_var, [td_level], [id_offset,] [id_rho,] [id_ext])  
    2626!> @endcode 
    2727!>       - il_detect(:,:,:) is 3D array of point to be extrapolated 
    2828!>       - td_var  is coarse grid variable to be extrapolated 
     29!>       - td_level is fine grid array of level (see vgrid_get_level) [optional] 
     30!>       - id_offset is array of offset between fine and coarse grid [optional] 
     31!>       - id_rho    is array of refinment factor [optional] 
     32!>       - id_ext    is array of number of points to be extrapolated [optional] 
    2933!> 
    3034!>    to extrapolate variable:<br/> 
    3135!> @code 
    32 !>    CALL extrap_fill_value( td_var, [id_radius]) 
     36!>    CALL extrap_fill_value( td_var, [td_level], [id_offset], [id_rho], [id_iext], [id_jext], [id_kext], [id_radius], [id_maxiter]) 
    3337!> @endcode 
    3438!>       - td_var  is coarse grid variable to be extrapolated 
     39!>       - td_level is fine grid array of level (see vgrid_get_level) [optional] 
     40!>       - id_offset is array of offset between fine and coarse grid [optional] 
     41!>       - id_rho    is array of refinment factor [optional] 
     42!>       - id_iext   is number of points to be extrapolated in i-direction [optional] 
     43!>       - id_jext   is number of points to be extrapolated in j-direction [optional] 
     44!>       - id_kext   is number of points to be extrapolated in k-direction [optional] 
    3545!>       - id_radius is radius of the halo used to compute extrapolation [optional] 
     46!>       - id_maxiter is maximum number of iteration [optional] 
    3647!> 
    3748!>    to add extraband to the variable (to be extrapolated):<br/> 
    … …  
    5162!>       - id_jsize : j-direction size of extra bands [optional] 
    5263!> 
     64!>    to compute first derivative of 1D array:<br/> 
     65!> @code 
     66!>    dl_value(:)=extrap_deriv_1D( dd_value(:), dd_fill, [ld_discont] ) 
     67!> @endcode 
     68!>       - dd_value is 1D array of variable 
     69!>       - dd_fill is FillValue of variable 
     70!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional] 
     71!> 
     72!>    to compute first derivative of 2D array:<br/> 
     73!> @code 
     74!>    dl_value(:,:)=extrap_deriv_2D( dd_value(:,:), dd_fill, cd_dim, [ld_discont] ) 
     75!> @endcode 
     76!>       - dd_value is 2D array of variable 
     77!>       - dd_fill is FillValue of variable 
     78!>       - cd_dim is character to compute derivative on first (I) or second (J) dimension 
     79!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional] 
     80!> 
     81!>    to compute first derivative of 3D array:<br/> 
     82!> @code 
     83!>    dl_value(:,:,:)=extrap_deriv_3D( dd_value(:,:,:), dd_fill, cd_dim, [ld_discont] ) 
     84!> @endcode 
     85!>       - dd_value is 3D array of variable 
     86!>       - dd_fill is FillValue of variable 
     87!>       - cd_dim is character to compute derivative on first (I), second (J), or third (K) dimension 
     88!>       - ld_discont is logical to take into account longitudinal East-West discontinuity [optional] 
     89!> 
    5390!> @warning _FillValue must not be zero (use var_chg_FillValue()) 
    5491!> 
    … …  
    5693!> J.Paul 
    5794! REVISION HISTORY: 
    58 !> @date November, 2013 - Initial Version 
     95!> @date Nov, 2013 - Initial Version 
    5996!> @date September, 2014 
    6097!> - add header 
    61 !> @date June, 2015 
    62 !> - extrapolate all land points (_FillValue) 
    63 !> - move deriv function to math module 
    64 !> @date July, 2015 
    65 !> - compute extrapolation from north west to south east,  
    66 !> and from south east to north west 
    6798!> 
    6899!> @todo 
    69100!> - create module for each extrapolation method 
    70 !> - smooth extrapolated points 
    71101!> 
    72102!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    80110   USE date                            ! date manager 
    81111   USE logger                          ! log file manager 
    82    USE math                            ! mathematical function 
    83112   USE att                             ! attribute manager 
    84113   USE dim                             ! dimension manager 
    … …  
    89118 
    90119   ! type and variable 
     120   PRIVATE :: im_maxiter   !< default maximum number of iteration  
    91121   PRIVATE :: im_minext    !< default minumum number of point to extrapolate 
    92122   PRIVATE :: im_mincubic  !< default minumum number of point to extrapolate for cubic interpolation 
    … …  
    97127   PUBLIC :: extrap_add_extrabands !< add extraband to the variable (to be extrapolated)  
    98128   PUBLIC :: extrap_del_extrabands !< delete extraband of the variable  
     129   PUBLIC :: extrap_deriv_1D       !< compute first derivative of 1D array  
     130   PUBLIC :: extrap_deriv_2D       !< compute first derivative of 2D array  
     131   PUBLIC :: extrap_deriv_3D       !< compute first derivative of 3D array 
    99132 
    100133   PRIVATE :: extrap__detect_wrapper      ! detected point to be extrapolated wrapper 
    … …  
    108141   PRIVATE :: extrap__3D_dist_weight_fill !  
    109142 
     143   INTEGER(i4), PARAMETER :: im_maxiter = 10 !< default maximum number of iteration 
    110144   INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of point to extrapolate 
    111145   INTEGER(i4), PARAMETER :: im_mincubic= 4  !< default minumum number of point to extrapolate for cubic interpolation 
    … …  
    137171   !>  
    138172   !> @author J.Paul 
    139    !> @date November, 2013 - Initial Version 
    140    !> @date June, 2015 
    141    !> - do not use level to select points to be extrapolated 
     173   !> - November, 2013- Initial Version 
    142174   ! 
    143175   !> @param[in] td_var0   coarse grid variable to extrapolate 
     176   !> @param[in] td_level1 fine grid array of level 
     177   !> @param[in] id_offset array of offset between fine and coarse grid  
     178   !> @param[in] id_rho    array of refinment factor  
     179   !> @param[in] id_ext    array of number of points to be extrapolated 
    144180   !> @return array of point to be extrapolated 
    145181   !------------------------------------------------------------------- 
    146    FUNCTION extrap__detect( td_var0 )  
     182   FUNCTION extrap__detect( td_var0, td_level1, & 
     183   &                        id_offset, id_rho, id_ext ) 
    147184      IMPLICIT NONE 
    148185      ! Argument 
    149186      TYPE(TVAR) ,                 INTENT(IN   ) :: td_var0 
     187      TYPE(TVAR) , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level1 
     188      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset 
     189      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho 
     190      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_ext 
    150191 
    151192      ! function 
    … …  
    155196 
    156197      ! local variable 
     198      CHARACTER(LEN=lc)                                :: cl_level 
     199 
     200      INTEGER(i4)                                      :: il_ind 
     201      INTEGER(i4)      , DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
     202      INTEGER(i4)      , DIMENSION(:,:,:), ALLOCATABLE :: il_tmp 
     203      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_offset 
     204      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_level1 
     205      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_level1_G0 
     206      INTEGER(i4)      , DIMENSION(:,:)  , ALLOCATABLE :: il_extra 
     207      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_ext 
     208      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_rho 
     209      INTEGER(i4)      , DIMENSION(:)    , ALLOCATABLE :: il_dim0 
     210 
     211      TYPE(TVAR)                                       :: tl_var1 
     212 
    157213      ! loop indices 
    158214      INTEGER(i4) :: ji0 
    159215      INTEGER(i4) :: jj0 
    160216      INTEGER(i4) :: jk0 
     217      INTEGER(i4) :: ji1 
     218      INTEGER(i4) :: jj1 
     219      INTEGER(i4) :: ji1m 
     220      INTEGER(i4) :: jj1m 
     221      INTEGER(i4) :: ji1p 
     222      INTEGER(i4) :: jj1p 
    161223      !---------------------------------------------------------------- 
    162224 
    163       ! force to extrapolated all points 
    164       extrap__detect(:,:,:)=1 
     225      ! init 
     226      extrap__detect(:,:,:)=0 
     227 
     228      ALLOCATE( il_dim0(3) ) 
     229      il_dim0(:)=td_var0%t_dim(1:3)%i_len 
     230 
     231      ! optional argument 
     232      ALLOCATE( il_rho(ip_maxdim) ) 
     233      il_rho(:)=1 
     234      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:) 
     235 
     236      ALLOCATE( il_offset(ip_maxdim,2) ) 
     237      il_offset(:,:)=0 
     238      IF( PRESENT(id_offset) )THEN 
     239         il_offset(1:SIZE(id_offset(:,:),DIM=1),& 
     240         &         1:SIZE(id_offset(:,:),DIM=2) )= id_offset(:,:) 
     241      ELSE 
     242         il_offset(jp_I,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5) 
     243         il_offset(jp_J,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5) 
     244      ENDIF 
     245 
     246      ALLOCATE( il_ext(ip_maxdim) ) 
     247      il_ext(:)=im_minext 
     248      IF( PRESENT(id_ext) ) il_ext(1:SIZE(id_ext(:)))=id_ext(:) 
     249 
     250      ALLOCATE( il_detect(il_dim0(1),& 
     251      &                   il_dim0(2),& 
     252      &                   il_dim0(3)) ) 
     253      il_detect(:,:,:)=0 
     254 
     255      ! select point already inform 
     256      DO jk0=1,td_var0%t_dim(3)%i_len 
     257         DO jj0=1,td_var0%t_dim(2)%i_len 
     258            DO ji0=1,td_var0%t_dim(1)%i_len 
     259               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill ) il_detect(ji0,jj0,jk0)=1 
     260            ENDDO 
     261         ENDDO 
     262      ENDDO 
     263  
     264      IF( PRESENT(td_level1) )THEN 
     265         SELECT CASE(TRIM(td_var0%c_point)) 
     266            CASE DEFAULT !'T' 
     267               cl_level='tlevel' 
     268            CASE('U') 
     269               cl_level='ulevel' 
     270            CASE('V') 
     271               cl_level='vlevel' 
     272            CASE('F') 
     273               cl_level='flevel' 
     274         END SELECT 
     275 
     276         il_ind=var_get_index(td_level1(:),TRIM(cl_level)) 
     277         IF( il_ind == 0 )THEN 
     278            CALL logger_error("EXTRAP DETECT: can not compute point to be "//& 
     279            &     "extrapolated for variable "//TRIM(td_var0%c_name)//& 
     280            &      ". can not find "//& 
     281            &     "level for variable point "//TRIM(TRIM(td_var0%c_point))) 
     282         ELSE 
     283            tl_var1=var_copy(td_level1(il_ind)) 
     284 
     285            ALLOCATE( il_level1_G0( il_dim0(1), il_dim0(2)) ) 
     286            IF( ALL(tl_var1%t_dim(1:2)%i_len == il_dim0(1:2)) )THEN 
     287 
     288               ! variable to be extrapolated use same resolution than level 
     289               il_level1_G0(:,:)=INT(tl_var1%d_value(:,:,1,1),i4) 
     290                
     291            ELSE 
     292               ! variable to be extrapolated do not use same resolution than level 
     293               ALLOCATE( il_level1(tl_var1%t_dim(1)%i_len, & 
     294               &                   tl_var1%t_dim(2)%i_len) ) 
     295               ! match fine grid vertical level with coarse grid 
     296               il_level1(:,:)=INT(tl_var1%d_value(:,:,1,1),i4)/il_rho(jp_K) 
     297 
     298               ALLOCATE( il_extra(ip_maxdim,2) ) 
     299               ! coarsening fine grid level 
     300               il_extra(jp_I,1)=CEILING(REAL(il_rho(jp_I)-1,dp)*0.5_dp) 
     301               il_extra(jp_I,2)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5_dp) 
     302 
     303               il_extra(jp_J,1)=CEILING(REAL(il_rho(jp_J)-1,dp)*0.5_dp) 
     304               il_extra(jp_J,2)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5_dp) 
     305 
     306               DO jj0=1,td_var0%t_dim(2)%i_len 
     307                   
     308                  jj1=(jj0-1)*il_rho(jp_J)+1-il_offset(jp_J,1) 
     309 
     310                  jj1m=MAX( jj1-il_extra(jp_J,1), 1 ) 
     311                  jj1p=MIN( jj1+il_extra(jp_J,2), & 
     312                  &         tl_var1%t_dim(2)%i_len-il_offset(jp_J,2) ) 
     313                   
     314                  DO ji0=1,td_var0%t_dim(1)%i_len 
     315 
     316                     ji1=(ji0-1)*il_rho(jp_I)+1-id_offset(jp_I,1) 
     317 
     318                     ji1m=MAX( ji1-il_extra(jp_I,1), 1 ) 
     319                     ji1p=MIN( ji1+il_extra(jp_I,2), & 
     320                     &         tl_var1%t_dim(1)%i_len-id_offset(jp_I,2) ) 
     321                
     322                     il_level1_G0(ji0,jj0)=MAXVAL(il_level1(ji1m:ji1p,jj1m:jj1p)) 
     323 
     324                  ENDDO 
     325               ENDDO 
     326 
     327               ! clean 
     328               DEALLOCATE( il_extra ) 
     329               DEALLOCATE( il_level1 ) 
     330 
     331            ENDIF 
     332 
     333            ! look for sea point 
     334            DO jk0=1,td_var0%t_dim(3)%i_len 
     335               WHERE( il_level1_G0(:,:) >= jk0) 
     336                  il_detect(:,:,jk0)=1 
     337               END WHERE 
     338            ENDDO 
     339 
     340            ! clean 
     341            DEALLOCATE( il_level1_G0 ) 
     342            CALL var_clean(tl_var1) 
     343 
     344         ENDIF 
     345      ENDIF 
     346 
     347      ! clean 
     348      DEALLOCATE( il_offset ) 
     349  
     350      ALLOCATE( il_tmp(il_dim0(1),& 
     351      &                il_dim0(2),& 
     352      &                il_dim0(3)) ) 
     353      il_tmp(:,:,:)=il_detect(:,:,:) 
     354      ! select extra point depending on interpolation method 
     355      ! compute point near grid point already inform 
     356      DO jk0=1,il_dim0(3) 
     357         DO jj0=1,il_dim0(2) 
     358            DO ji0=1,il_dim0(1) 
     359 
     360               IF( il_tmp(ji0,jj0,jk0) == 1 )THEN 
     361                  il_detect( & 
     362                  &  MAX(1,ji0-il_ext(jp_I)):MIN(ji0+il_ext(jp_I),il_dim0(1)),& 
     363                  &  MAX(1,jj0-il_ext(jp_J)):MIN(jj0+il_ext(jp_J),il_dim0(2)),& 
     364                  &  MAX(1,jk0-il_ext(jp_K)):MIN(jk0+il_ext(jp_K),il_dim0(3)) & 
     365                  &  ) = 1  
     366               ENDIF 
     367 
     368            ENDDO 
     369         ENDDO 
     370      ENDDO 
     371       
     372      ! clean 
     373      DEALLOCATE( il_tmp ) 
    165374 
    166375      ! do not compute grid point already inform 
    … …  
    168377         DO jj0=1,td_var0%t_dim(2)%i_len 
    169378            DO ji0=1,td_var0%t_dim(1)%i_len 
    170                IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill )THEN 
    171                   extrap__detect(ji0,jj0,jk0)=0 
    172                ENDIF 
     379               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill ) il_detect(ji0,jj0,jk0)=0 
    173380            ENDDO 
    174381         ENDDO 
    175382      ENDDO 
     383 
     384      ! save result 
     385      extrap__detect(:,:,:)=il_detect(:,:,:) 
     386 
     387      ! clean 
     388      DEALLOCATE( il_dim0 ) 
     389      DEALLOCATE( il_ext ) 
     390      DEALLOCATE( il_detect ) 
     391      DEALLOCATE( il_rho ) 
    176392 
    177393   END FUNCTION extrap__detect 
    … …  
    182398   !>  
    183399   !> @author J.Paul 
    184    !> @date November, 2013 - Initial Version 
    185    !> @date June, 2015 
    186    !> - select all land points for extrapolation 
     400   !> - November, 2013- Initial Version 
    187401   !> 
    188402   !> @param[in] td_var    coarse grid variable to extrapolate 
     403   !> @param[in] td_level  fine grid array of level 
     404   !> @param[in] id_offset array of offset between fine and coarse grid  
     405   !> @param[in] id_rho    array of refinment factor  
     406   !> @param[in] id_ext    array of number of points to be extrapolated 
    189407   !> @return 3D array of point to be extrapolated 
    190408   !------------------------------------------------------------------- 
    191    FUNCTION extrap__detect_wrapper( td_var ) 
     409   FUNCTION extrap__detect_wrapper( td_var, td_level, & 
     410   &                                id_offset, id_rho, id_ext ) 
    192411 
    193412      IMPLICIT NONE 
    194413      ! Argument 
    195414      TYPE(TVAR) ,                 INTENT(IN   ) :: td_var 
     415      TYPE(TVAR) , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level 
     416      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset 
     417      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho 
     418      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_ext 
    196419 
    197420      ! function 
    … …  
    216439         &              " for variable "//TRIM(td_var%c_name) ) 
    217440          
    218          extrap__detect_wrapper(:,:,:)=extrap__detect( td_var ) 
     441         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var, td_level, & 
     442         &                                             id_offset, & 
     443         &                                             id_rho,    & 
     444         &                                             id_ext     ) 
    219445 
    220446      ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    … …  
    224450         &              " for variable "//TRIM(td_var%c_name) ) 
    225451          
    226          extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var ) 
     452         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var , td_level,& 
     453         &                                               id_offset, & 
     454         &                                               id_rho,    & 
     455         &                                               id_ext     ) 
    227456 
    228457      ELSE IF( td_var%t_dim(3)%l_use )THEN 
    … …  
    232461         &              " for variable "//TRIM(td_var%c_name) ) 
    233462          
    234          extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var ) 
     463         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var , td_level, & 
     464         &                                                 id_offset, & 
     465         &                                                 id_rho,    & 
     466         &                                                 id_ext     ) 
    235467 
    236468      ENDIF               
    … …  
    257489   !> 
    258490   !> @author J.Paul 
    259    !> @date November, 2013 - Initial Version 
    260    !> @date June, 2015 
    261    !> - select all land points for extrapolation 
     491   !> - Nov, 2013- Initial Version 
    262492   ! 
    263493   !> @param[inout] td_var    variable structure 
     494   !> @param[in] td_level     fine grid array of level 
     495   !> @param[in] id_offset    array of offset between fine and coarse grid  
     496   !> @param[in] id_rho       array of refinment factor  
     497   !> @param[in] id_iext      number of points to be extrapolated in i-direction 
     498   !> @param[in] id_jext      number of points to be extrapolated in j-direction 
     499   !> @param[in] id_kext      number of points to be extrapolated in k-direction 
    264500   !> @param[in] id_radius    radius of the halo used to compute extrapolation  
    265    !------------------------------------------------------------------- 
    266    SUBROUTINE extrap__fill_value_wrapper( td_var, &  
    267    &                                      id_radius ) 
     501   !> @param[in] id_maxiter   maximum number of iteration 
     502   !------------------------------------------------------------------- 
     503   SUBROUTINE extrap__fill_value_wrapper( td_var, td_level, & 
     504   &                                      id_offset,        & 
     505   &                                      id_rho,           & 
     506   &                                      id_iext, id_jext, id_kext, & 
     507   &                                      id_radius, id_maxiter ) 
    268508      IMPLICIT NONE 
    269509      ! Argument 
    270510      TYPE(TVAR) ,                  INTENT(INOUT) :: td_var 
     511      TYPE(TVAR) ,  DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level 
     512      INTEGER(i4),  DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset 
     513      INTEGER(i4),  DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho 
     514      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_iext 
     515      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_jext 
     516      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_kext 
    271517      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_radius 
     518      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_maxiter 
    272519 
    273520      ! local variable 
     521      INTEGER(i4) :: il_iext 
     522      INTEGER(i4) :: il_jext 
     523      INTEGER(i4) :: il_kext 
    274524      INTEGER(i4) :: il_radius 
     525      INTEGER(i4) :: il_maxiter 
    275526 
    276527      CHARACTER(LEN=lc) :: cl_method 
    … …  
    293544         END SELECT 
    294545 
    295          ! number of point use to compute box 
    296          il_radius=1 
    297          IF( PRESENT(id_radius) ) il_radius=id_radius 
    298          IF( il_radius < 0 )THEN 
     546         il_iext=im_minext 
     547         IF( PRESENT(id_iext) ) il_iext=id_iext 
     548         il_jext=im_minext 
     549         IF( PRESENT(id_jext) ) il_jext=id_jext 
     550         il_kext=0 
     551         IF( PRESENT(id_kext) ) il_kext=id_kext 
     552 
     553         IF( TRIM(td_var%c_interp(1)) == 'cubic')THEN 
     554            IF( il_iext > 0 .AND. il_iext < im_mincubic ) il_iext=im_mincubic 
     555            IF( il_jext > 0 .AND. il_jext < im_mincubic ) il_jext=im_mincubic 
     556         ENDIF 
     557 
     558         IF( il_iext < 0 )THEN 
    299559            CALL logger_error("EXTRAP FILL VALUE: invalid "//& 
    300             &  " radius of the box used to compute extrapolation "//& 
    301             &  "("//TRIM(fct_str(il_radius))//")") 
     560            &  " number of points to be extrapolated in i-direction "//& 
     561            &  "("//TRIM(fct_str(il_iext))//")") 
    302562         ENDIF 
    303563 
    304          CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//& 
    305          &  " using "//TRIM(cl_method)//" method." ) 
    306  
    307          CALL extrap__fill_value( td_var, cl_method, & 
    308          &                        il_radius ) 
     564         IF( il_jext < 0 )THEN 
     565            CALL logger_error("EXTRAP FILL VALUE: invalid "//& 
     566            &  " number of points to be extrapolated in j-direction "//& 
     567            &  "("//TRIM(fct_str(il_jext))//")") 
     568         ENDIF 
     569 
     570         IF( il_kext < 0 )THEN 
     571            CALL logger_error("EXTRAP FILL VALUE: invalid "//& 
     572            &  " number of points to be extrapolated in k-direction "//& 
     573            &  "("//TRIM(fct_str(il_kext))//")") 
     574         ENDIF 
     575 
     576         IF( (il_iext /= 0 .AND. td_var%t_dim(1)%l_use) .OR. & 
     577         &   (il_jext /= 0 .AND. td_var%t_dim(2)%l_use) .OR. & 
     578         &   (il_kext /= 0 .AND. td_var%t_dim(3)%l_use) )THEN 
     579 
     580            ! number of point use to compute box 
     581            il_radius=1 
     582            IF( PRESENT(id_radius) ) il_radius=id_radius 
     583            IF( il_radius < 0 )THEN 
     584               CALL logger_error("EXTRAP FILL VALUE: invalid "//& 
     585               &  " radius of the box used to compute extrapolation "//& 
     586               &  "("//TRIM(fct_str(il_radius))//")") 
     587            ENDIF 
     588 
     589            ! maximum number of iteration 
     590            il_maxiter=im_maxiter 
     591            IF( PRESENT(id_maxiter) ) il_maxiter=id_maxiter 
     592            IF( il_maxiter < 0 )THEN 
     593               CALL logger_error("EXTRAP FILL VALUE: invalid "//& 
     594               &  " maximum nuber of iteration "//& 
     595               &  "("//TRIM(fct_str(il_maxiter))//")") 
     596            ENDIF 
     597 
     598            CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//& 
     599            &  " using "//TRIM(cl_method)//" method." ) 
     600 
     601            CALL extrap__fill_value( td_var, cl_method, & 
     602            &                        il_iext, il_jext, il_kext,   & 
     603            &                        il_radius, il_maxiter,       & 
     604            &                        td_level,                    & 
     605            &                        id_offset, id_rho ) 
     606  
     607         ENDIF 
    309608  
    310609      ENDIF 
    … …  
    322621   !> 
    323622   !> @author J.Paul 
    324    !> @date November, 2013 - Initial Version 
    325    !> @date June, 2015 
    326    !> - select all land points for extrapolation 
     623   !> - November, 2013- Initial Version 
    327624   ! 
    328625   !> @param[inout] td_var    variable structure 
    329626   !> @param[in] cd_method    extrapolation method 
     627   !> @param[in] id_iext      number of points to be extrapolated in i-direction 
     628   !> @param[in] id_jext      number of points to be extrapolated in j-direction 
     629   !> @param[in] id_kext      number of points to be extrapolated in k-direction 
    330630   !> @param[in] id_radius    radius of the halo used to compute extrapolation 
     631   !> @param[in] id_maxiter   maximum number of iteration 
     632   !> @param[in] td_level     fine grid array of level 
     633   !> @param[in] id_offset    array of offset between fine and coarse grid  
     634   !> @param[in] id_rho       array of refinment factor 
    331635   !------------------------------------------------------------------- 
    332636   SUBROUTINE extrap__fill_value( td_var, cd_method, & 
    333    &                              id_radius ) 
     637   &                              id_iext, id_jext, id_kext, & 
     638   &                              id_radius, id_maxiter, & 
     639   &                              td_level,          & 
     640   &                              id_offset,         & 
     641   &                              id_rho ) 
    334642      IMPLICIT NONE 
    335643      ! Argument 
    336644      TYPE(TVAR)      ,                 INTENT(INOUT) :: td_var 
    337645      CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_method 
     646      INTEGER(i4)     ,                 INTENT(IN   ) :: id_iext 
     647      INTEGER(i4)     ,                 INTENT(IN   ) :: id_jext 
     648      INTEGER(i4)     ,                 INTENT(IN   ) :: id_kext 
    338649      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius 
     650      INTEGER(i4)     ,                 INTENT(IN   ) :: id_maxiter 
     651      TYPE(TVAR)      , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: td_level 
     652      INTEGER(i4)     , DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset 
     653      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho 
    339654 
    340655      ! local variable 
    … …  
    353668      &                    td_var%t_dim(3)%i_len) ) 
    354669 
    355       il_detect(:,:,:) = extrap_detect( td_var ) 
    356  
     670      il_detect(:,:,:) = extrap_detect( td_var, td_level, & 
     671      &                                 id_offset,        & 
     672      &                                 id_rho,           & 
     673      &                                 id_ext=(/id_iext, id_jext, id_kext/) ) 
    357674      !2- add attribute to variable 
    358675      cl_extrap=fct_concat(td_var%c_extrap(:)) 
    … …  
    362679      CALL att_clean(tl_att) 
    363680 
    364       IF( ALL(il_detect(:,:,:)==1) )THEN 
    365          CALL logger_warn(" EXTRAP FILL: "//& 
    366             &  " can not extrapolate "//TRIM(td_var%c_name)//& 
    367             &  ". no value inform." ) 
    368       ELSE 
    369          CALL logger_info(" EXTRAP FILL: "//& 
    370             &              TRIM(fct_str(SUM(il_detect(:,:,:))))//& 
    371             &              " point(s) to extrapolate " ) 
    372  
    373          CALL logger_info(" EXTRAP FILL: method "//& 
    374             &  TRIM(cd_method) ) 
    375  
    376          !3- extrapolate 
    377          CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill, & 
    378          &               il_detect(:,:,:),                       & 
    379          &               cd_method, id_radius ) 
    380       ENDIF 
     681      CALL logger_info(" EXTRAP FILL: "//& 
     682         &              TRIM(fct_str(SUM(il_detect(:,:,:))))//& 
     683         &              " point(s) to extrapolate " ) 
     684 
     685      !3- extrapolate 
     686      CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill,    & 
     687      &               il_detect(:,:,:),                           & 
     688      &               cd_method, id_radius, id_maxiter  ) 
    381689 
    382690      DEALLOCATE(il_detect) 
    … …  
    397705   !> 
    398706   !> @author J.Paul 
    399    !> @date November, 2013 - Initial Version 
    400    !> @date July, 2015  
    401    !> - compute coef indices to be used 
    402    !> - bug fix: force coef indice to 1, for dimension lenth equal to 1 
     707   !> - Nov, 2013- Initial Version 
    403708   ! 
    404709   !> @param[inout] dd_value  3D array of variable to be extrapolated 
    … …  
    409714   !------------------------------------------------------------------- 
    410715   SUBROUTINE extrap__3D( dd_value, dd_fill, id_detect,& 
    411    &                      cd_method, id_radius ) 
     716   &                      cd_method, id_radius, id_maxiter ) 
    412717      IMPLICIT NONE 
    413718      ! Argument 
    414719      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
    415       REAL(dp)   ,                     INTENT(IN   ) :: dd_fill 
    416       INTEGER(i4), DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect 
    417       CHARACTER(LEN=*),                INTENT(IN   ) :: cd_method 
    418       INTEGER(i4),                     INTENT(IN   ) :: id_radius 
     720      REAL(dp)   ,                   INTENT(IN   ) :: dd_fill 
     721      INTEGER(i4), DIMENSION(:,:,:), INTENT(INOUT) :: id_detect 
     722      CHARACTER(LEN=*),              INTENT(IN   ) :: cd_method 
     723      INTEGER(i4),                   INTENT(IN   ) :: id_radius 
     724      INTEGER(i4),                   INTENT(IN   ) :: id_maxiter 
    419725 
    420726      ! local variable 
    421       INTEGER(i4)                                :: il_imin 
    422       INTEGER(i4)                                :: il_imax 
    423       INTEGER(i4)                                :: il_jmin 
    424       INTEGER(i4)                                :: il_jmax 
    425       INTEGER(i4)                                :: il_kmin 
    426       INTEGER(i4)                                :: il_kmax 
    427       INTEGER(i4)                                :: il_iter 
    428       INTEGER(i4)                                :: il_radius 
    429       INTEGER(i4)                                :: il_i1 
    430       INTEGER(i4)                                :: il_i2 
    431       INTEGER(i4)                                :: il_j1 
    432       INTEGER(i4)                                :: il_j2 
    433       INTEGER(i4)                                :: il_k1 
    434       INTEGER(i4)                                :: il_k2 
    435  
    436       INTEGER(i4), DIMENSION(4)                  :: il_shape 
    437       INTEGER(i4), DIMENSION(3)                  :: il_dim 
     727      INTEGER(i4) :: il_imin 
     728      INTEGER(i4) :: il_imax 
     729      INTEGER(i4) :: il_jmin 
     730      INTEGER(i4) :: il_jmax 
     731      INTEGER(i4) :: il_kmin 
     732      INTEGER(i4) :: il_kmax 
     733      INTEGER(i4) :: il_iter 
     734      INTEGER(i4) :: il_radius 
     735 
     736      INTEGER(i4), DIMENSION(4) :: il_shape 
     737      INTEGER(i4), DIMENSION(3) :: il_dim 
    438738 
    439739      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
    … …  
    443743      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdz 
    444744      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef 
    445  
    446       LOGICAL                                    :: ll_iter 
    447745 
    448746      ! loop indices 
    … …  
    467765            DO WHILE( ANY(il_detect(:,:,:)==1) ) 
    468766               ! change extend value to minimize number of iteration 
    469                il_radius=id_radius+(il_iter-1) 
    470                ll_iter=.TRUE. 
     767               il_radius=id_radius+(il_iter/id_maxiter) 
    471768 
    472769               ALLOCATE( dl_dfdx(il_shape(1), il_shape(2), il_shape(3)) )  
    … …  
    477774               dl_dfdx(:,:,:)=dd_fill 
    478775               IF( il_shape(1) > 1 )THEN 
    479                   dl_dfdx(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), & 
    480                      &                          dd_fill, 'I' ) 
     776                  dl_dfdx(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'I' ) 
    481777               ENDIF 
    482778 
    … …  
    484780               dl_dfdy(:,:,:)=dd_fill 
    485781               IF( il_shape(2) > 1 )THEN 
    486                   dl_dfdy(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), & 
    487                      &                          dd_fill, 'J' ) 
     782                  dl_dfdy(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'J' ) 
    488783               ENDIF 
    489784  
    … …  
    491786               dl_dfdz(:,:,:)=dd_fill 
    492787               IF( il_shape(3) > 1 )THEN 
    493                   dl_dfdz(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), & 
    494                      &                          dd_fill, 'K' ) 
     788                  dl_dfdz(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'K' ) 
    495789               ENDIF 
    496790  
    … …  
    510804 
    511805               DO jk=1,il_shape(3) 
    512                   ! from North West(1,1) to South East(il_shape(1),il_shape(2)) 
    513806                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
    514807                  DO jj=1,il_shape(2) 
    … …  
    520813                           il_imin=MAX(ji-il_radius,1) 
    521814                           il_imax=MIN(ji+il_radius,il_shape(1)) 
    522                            ! coef indices to be used 
    523                            il_i1 = il_radius-(ji-il_imin)+1 
    524                            il_i2 = il_radius+(il_imax-ji)+1 
    525815                           IF( il_dim(1) == 1 )THEN 
    526816                              il_imin=ji 
    527817                              il_imax=ji 
    528                               ! coef indices to be used 
    529                               il_i1 = 1 
    530                               il_i2 = 1 
    531818                           ENDIF 
    532  
    533819 
    534820                           il_jmin=MAX(jj-il_radius,1) 
    535821                           il_jmax=MIN(jj+il_radius,il_shape(2)) 
    536                            ! coef indices to be used 
    537                            il_j1 = il_radius-(jj-il_jmin)+1 
    538                            il_j2 = il_radius+(il_jmax-jj)+1 
    539822                           IF( il_dim(2) == 1 )THEN 
    540823                              il_jmin=jj 
    541824                              il_jmax=jj 
    542                               ! coef indices to be used 
    543                               il_j1 = 1 
    544                               il_j2 = 1 
    545825                           ENDIF 
    546826 
    547827                           il_kmin=MAX(jk-il_radius,1) 
    548828                           il_kmax=MIN(jk+il_radius,il_shape(3)) 
    549                            ! coef indices to be used 
    550                            il_k1 = il_radius-(jk-il_kmin)+1 
    551                            il_k2 = il_radius+(il_kmax-jk)+1 
    552829                           IF( il_dim(3) == 1 )THEN 
    553830                              il_kmin=jk 
    554831                              il_kmax=jk 
    555                               ! coef indices to be used 
    556                               il_k1 = 1 
    557                               il_k2 = 1 
    558832                           ENDIF 
    559833 
    … …  
    571845                           &            il_jmin:il_jmax, & 
    572846                           &            il_kmin:il_kmax ), & 
    573                            &  dl_coef(il_i1:il_i2, & 
    574                            &          il_j1:il_j2, & 
    575                            &          il_k1:il_k2) ) 
     847                           &  dl_coef(:,:,:) ) 
    576848 
    577849                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
    578850                              il_detect(ji,jj,jk)= 0 
    579                               ll_iter=.FALSE. 
    580                            ENDIF 
    581  
    582                         ENDIF 
    583  
    584                      ENDDO 
    585                   ENDDO 
    586                   ! from South East(il_shape(1),il_shape(2)) to North West(1,1) 
    587                   IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
    588                   DO jj=il_shape(2),1,-1 
    589                      IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE 
    590                      DO ji=il_shape(1),1,-1 
    591  
    592                         IF( il_detect(ji,jj,jk) == 1 )THEN 
    593                            
    594                            il_imin=MAX(ji-il_radius,1) 
    595                            il_imax=MIN(ji+il_radius,il_shape(1)) 
    596                            ! coef indices to be used 
    597                            il_i1 = il_radius-(ji-il_imin)+1 
    598                            il_i2 = il_radius+(il_imax-ji)+1 
    599                            IF( il_dim(1) == 1 )THEN 
    600                               il_imin=ji 
    601                               il_imax=ji 
    602                               ! coef indices to be used 
    603                               il_i1 = 1 
    604                               il_i2 = 1 
    605                            ENDIF 
    606  
    607  
    608                            il_jmin=MAX(jj-il_radius,1) 
    609                            il_jmax=MIN(jj+il_radius,il_shape(2)) 
    610                            ! coef indices to be used 
    611                            il_j1 = il_radius-(jj-il_jmin)+1 
    612                            il_j2 = il_radius+(il_jmax-jj)+1 
    613                            IF( il_dim(2) == 1 )THEN 
    614                               il_jmin=jj 
    615                               il_jmax=jj 
    616                               ! coef indices to be used 
    617                               il_j1 = 1 
    618                               il_j2 = 1 
    619                            ENDIF 
    620  
    621                            il_kmin=MAX(jk-il_radius,1) 
    622                            il_kmax=MIN(jk+il_radius,il_shape(3)) 
    623                            ! coef indices to be used 
    624                            il_k1 = il_radius-(jk-il_kmin)+1 
    625                            il_k2 = il_radius+(il_kmax-jk)+1 
    626                            IF( il_dim(3) == 1 )THEN 
    627                               il_kmin=jk 
    628                               il_kmax=jk 
    629                               ! coef indices to be used 
    630                               il_k1 = 1 
    631                               il_k2 = 1 
    632                            ENDIF 
    633  
    634                            dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( & 
    635                            &  dd_value( il_imin:il_imax, & 
    636                            &            il_jmin:il_jmax, & 
    637                            &            il_kmin:il_kmax,jl ), dd_fill, il_radius, & 
    638                            &  dl_dfdx(  il_imin:il_imax, & 
    639                            &            il_jmin:il_jmax, & 
    640                            &            il_kmin:il_kmax ), & 
    641                            &  dl_dfdy(  il_imin:il_imax, & 
    642                            &            il_jmin:il_jmax, & 
    643                            &            il_kmin:il_kmax ), & 
    644                            &  dl_dfdz(  il_imin:il_imax, & 
    645                            &            il_jmin:il_jmax, & 
    646                            &            il_kmin:il_kmax ), & 
    647                            &  dl_coef(il_i1:il_i2, & 
    648                            &          il_j1:il_j2, & 
    649                            &          il_k1:il_k2) ) 
    650  
    651                            IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
    652                               il_detect(ji,jj,jk)= 0 
    653                               ll_iter=.FALSE. 
    654851                           ENDIF 
    655852 
    … …  
    665862               DEALLOCATE( dl_coef ) 
    666863 
    667                IF( ll_iter ) il_iter=il_iter+1 
     864               il_iter=il_iter+1 
    668865            ENDDO 
    669866         ENDDO 
    … …  
    678875            DO WHILE( ANY(il_detect(:,:,:)==1) ) 
    679876               ! change extend value to minimize number of iteration 
    680                il_radius=id_radius+(il_iter-1) 
    681                ll_iter=.TRUE. 
     877               il_radius=id_radius+(il_iter/id_maxiter) 
    682878 
    683879               il_dim(1)=2*il_radius+1 
    … …  
    690886               ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) ) 
    691887 
    692                dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1),& 
    693                &                                                   1:il_dim(2),& 
    694                &                                                   1:il_dim(3),& 
     888               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1), & 
     889               &                                                   1:il_dim(2), & 
     890               &                                                   1:il_dim(3), & 
    695891               &                                                   jl ) ) 
    696                 
     892 
    697893               DO jk=1,il_shape(3) 
    698                   ! from North West(1,1) to South East(il_shape(1),il_shape(2)) 
    699894                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
    700895                  DO jj=1,il_shape(2) 
    … …  
    706901                           il_imin=MAX(ji-il_radius,1) 
    707902                           il_imax=MIN(ji+il_radius,il_shape(1)) 
    708                            ! coef indices to be used 
    709                            il_i1 = il_radius-(ji-il_imin)+1 
    710                            il_i2 = il_radius+(il_imax-ji)+1 
    711903                           IF( il_dim(1) == 1 )THEN 
    712904                              il_imin=ji 
    713905                              il_imax=ji 
    714                               ! coef indices to be used 
    715                               il_i1 = 1 
    716                               il_i2 = 1 
    717906                           ENDIF 
    718907 
    719908                           il_jmin=MAX(jj-il_radius,1) 
    720909                           il_jmax=MIN(jj+il_radius,il_shape(2)) 
    721                            ! coef indices to be used 
    722                            il_j1 = il_radius-(jj-il_jmin)+1 
    723                            il_j2 = il_radius+(il_jmax-jj)+1 
    724910                           IF( il_dim(2) == 1 )THEN 
    725911                              il_jmin=jj 
    726912                              il_jmax=jj 
    727                               ! coef indices to be used 
    728                               il_j1 = 1 
    729                               il_j2 = 1 
    730913                           ENDIF 
    731914 
    732915                           il_kmin=MAX(jk-il_radius,1) 
    733916                           il_kmax=MIN(jk+il_radius,il_shape(3)) 
    734                            ! coef indices to be used 
    735                            il_k1 = il_radius-(jk-il_kmin)+1 
    736                            il_k2 = il_radius+(il_kmax-jk)+1 
    737917                           IF( il_dim(3) == 1 )THEN 
    738918                              il_kmin=jk 
    739919                              il_kmax=jk 
    740                               ! coef indices to be used 
    741                               il_k1 = 1 
    742                               il_k2 = 1 
    743920                           ENDIF 
    744921 
    … …  
    748925                           &            il_kmin:il_kmax, & 
    749926                           &            jl), dd_fill, il_radius, & 
    750                            &  dl_coef(il_i1:il_i2, & 
    751                            &          il_j1:il_j2, & 
    752                            &          il_k1:il_k2) ) 
     927                           &  dl_coef(:,:,:) ) 
    753928 
    754929                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
    755930                              il_detect(ji,jj,jk)= 0 
    756                               ll_iter=.FALSE. 
    757                            ENDIF 
    758  
    759                         ENDIF 
    760  
    761                      ENDDO 
    762                   ENDDO 
    763                   ! from South East(il_shape(1),il_shape(2)) to North West(1,1) 
    764                   IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
    765                   DO jj=il_shape(2),1,-1 
    766                      IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE 
    767                      DO ji=il_shape(1),1,-1 
    768  
    769                         IF( il_detect(ji,jj,jk) == 1 )THEN 
    770                             
    771                            il_imin=MAX(ji-il_radius,1) 
    772                            il_imax=MIN(ji+il_radius,il_shape(1)) 
    773                            ! coef indices to be used 
    774                            il_i1 = il_radius-(ji-il_imin)+1 
    775                            il_i2 = il_radius+(il_imax-ji)+1 
    776                            IF( il_dim(1) == 1 )THEN 
    777                               il_imin=ji 
    778                               il_imax=ji 
    779                               ! coef indices to be used 
    780                               il_i1 = 1 
    781                               il_i2 = 1 
    782                            ENDIF 
    783  
    784                            il_jmin=MAX(jj-il_radius,1) 
    785                            il_jmax=MIN(jj+il_radius,il_shape(2)) 
    786                            ! coef indices to be used 
    787                            il_j1 = il_radius-(jj-il_jmin)+1 
    788                            il_j2 = il_radius+(il_jmax-jj)+1 
    789                            IF( il_dim(2) == 1 )THEN 
    790                               il_jmin=jj 
    791                               il_jmax=jj 
    792                               ! coef indices to be used 
    793                               il_j1 = 1 
    794                               il_j2 = 1 
    795                            ENDIF 
    796  
    797                            il_kmin=MAX(jk-il_radius,1) 
    798                            il_kmax=MIN(jk+il_radius,il_shape(3)) 
    799                            ! coef indices to be used 
    800                            il_k1 = il_radius-(jk-il_kmin)+1 
    801                            il_k2 = il_radius+(il_kmax-jk)+1 
    802                            IF( il_dim(3) == 1 )THEN 
    803                               il_kmin=jk 
    804                               il_kmax=jk 
    805                               ! coef indices to be used 
    806                               il_k1 = 1 
    807                               il_k2 = 1 
    808                            ENDIF 
    809  
    810                            dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( & 
    811                            &  dd_value( il_imin:il_imax, & 
    812                            &            il_jmin:il_jmax, & 
    813                            &            il_kmin:il_kmax, & 
    814                            &            jl), dd_fill, il_radius, & 
    815                            &  dl_coef(il_i1:il_i2, & 
    816                            &          il_j1:il_j2, & 
    817                            &          il_k1:il_k2) ) 
    818  
    819                            IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
    820                               il_detect(ji,jj,jk)= 0 
    821                               ll_iter=.FALSE. 
    822931                           ENDIF 
    823932 
    … …  
    827936                  ENDDO 
    828937               ENDDO 
    829                CALL logger_info(" EXTRAP 3D: "//& 
    830                &              TRIM(fct_str(SUM(il_detect(:,:,:))))//& 
    831                &              " point(s) to extrapolate " ) 
    832              
     938 
    833939               DEALLOCATE( dl_coef ) 
    834                IF( ll_iter ) il_iter=il_iter+1 
     940               il_iter=il_iter+1 
    835941            ENDDO 
    836942         ENDDO             
    … …  
    840946 
    841947   END SUBROUTINE extrap__3D 
     948   !------------------------------------------------------------------- 
     949   !> @brief 
     950   !> This function compute derivative of 1D array. 
     951   !>  
     952   !> @details  
     953   !> optionaly you could specify to take into account east west discontinuity 
     954   !> (-180° 180° or 0° 360° for longitude variable) 
     955   !> 
     956   !> @author J.Paul 
     957   !> - November, 2013- Initial Version 
     958   ! 
     959   !> @param[in] dd_value     1D array of variable to be extrapolated 
     960   !> @param[in] dd_fill      FillValue of variable 
     961   !> @param[in] ld_discont   logical to take into account east west discontinuity  
     962   !------------------------------------------------------------------- 
     963   PURE FUNCTION extrap_deriv_1D( dd_value, dd_fill, ld_discont ) 
     964 
     965      IMPLICIT NONE 
     966      ! Argument 
     967      REAL(dp)   , DIMENSION(:), INTENT(IN) :: dd_value 
     968      REAL(dp)                 , INTENT(IN) :: dd_fill 
     969      LOGICAL                  , INTENT(IN), OPTIONAL :: ld_discont 
     970 
     971      ! function 
     972      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1) ) :: extrap_deriv_1D 
     973 
     974      ! local variable 
     975      INTEGER(i4)                            :: il_imin 
     976      INTEGER(i4)                            :: il_imax 
     977      INTEGER(i4), DIMENSION(1)              :: il_shape 
     978 
     979      REAL(dp)                               :: dl_min 
     980      REAL(dp)                               :: dl_max 
     981      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value 
     982 
     983      LOGICAL                                :: ll_discont 
     984 
     985      ! loop indices 
     986      INTEGER(i4) :: ji 
     987 
     988      INTEGER(i4) :: i1 
     989      INTEGER(i4) :: i2 
     990      !---------------------------------------------------------------- 
     991      ! init 
     992      extrap_deriv_1D(:)=dd_fill 
     993 
     994      ll_discont=.FALSE. 
     995      IF( PRESENT(ld_discont) ) ll_discont=ld_discont 
     996 
     997      il_shape(:)=SHAPE(dd_value(:)) 
     998 
     999      ALLOCATE( dl_value(3)) 
     1000 
     1001      ! compute derivative in i-direction 
     1002      DO ji=1,il_shape(1) 
     1003          
     1004            il_imin=MAX(ji-1,1) 
     1005            il_imax=MIN(ji+1,il_shape(1)) 
     1006 
     1007            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN 
     1008               i1=1  ; i2=3 
     1009            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN 
     1010               i1=1  ; i2=2 
     1011            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN 
     1012               i1=2  ; i2=3 
     1013            ENDIF 
     1014 
     1015            dl_value(i1:i2)=dd_value(il_imin:il_imax) 
     1016            IF( il_imin == 1 )THEN 
     1017               dl_value(:)=EOSHIFT( dl_value(:), & 
     1018               &                    DIM=1,         & 
     1019               &                    SHIFT=-1,      & 
     1020               &                    BOUNDARY=dl_value(1) ) 
     1021            ENDIF 
     1022            IF( il_imax == il_shape(1) )THEN 
     1023               dl_value(:)=EOSHIFT( dl_value(:), & 
     1024               &                    DIM=1,         & 
     1025               &                    SHIFT=1,       & 
     1026               &                    BOUNDARY=dl_value(3)) 
     1027            ENDIF 
     1028 
     1029            IF( ll_discont )THEN 
     1030               dl_min=MINVAL( dl_value(:), dl_value(:)/=dd_fill ) 
     1031               dl_max=MAXVAL( dl_value(:), dl_value(:)/=dd_fill ) 
     1032               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN 
     1033                  WHERE( dl_value(:) < 0._dp )  
     1034                     dl_value(:) = dl_value(:)+360._dp 
     1035                  END WHERE 
     1036               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN 
     1037                  WHERE( dl_value(:) > 180._dp )  
     1038                     dl_value(:) = dl_value(:)-180._dp 
     1039                  END WHERE 
     1040               ENDIF 
     1041            ENDIF 
     1042 
     1043         IF( dl_value( 2) /= dd_fill .AND. & ! ji 
     1044         &   dl_value( 3) /= dd_fill .AND. & ! ji+1 
     1045         &   dl_value( 1) /= dd_fill )THEN   ! ji-1 
     1046 
     1047            extrap_deriv_1D(ji)=& 
     1048            &  ( dl_value(3) - dl_value(1) ) / & 
     1049            &  REAL( il_imax-il_imin ,dp) 
     1050 
     1051         ENDIF 
     1052 
     1053      ENDDO 
     1054 
     1055      DEALLOCATE( dl_value ) 
     1056 
     1057   END FUNCTION extrap_deriv_1D 
     1058   !------------------------------------------------------------------- 
     1059   !> @brief 
     1060   !> This function compute derivative of 2D array. 
     1061   !> you have to specify in which direction derivative have to be computed: 
     1062   !> first (I) or second (J) dimension.  
     1063   !> 
     1064   !> @details  
     1065   !> optionaly you could specify to take into account east west discontinuity 
     1066   !> (-180° 180° or 0° 360° for longitude variable) 
     1067   !> 
     1068   !> @author J.Paul 
     1069   !> - November, 2013- Initial Version 
     1070   ! 
     1071   !> @param[in] dd_value     2D array of variable to be extrapolated 
     1072   !> @param[in] dd_fill      FillValue of variable 
     1073   !> @param[in] cd_dim       compute derivative on first (I) or second (J) dimension  
     1074   !> @param[in] ld_discont   logical to take into account east west discontinuity  
     1075   !------------------------------------------------------------------- 
     1076   FUNCTION extrap_deriv_2D( dd_value, dd_fill, cd_dim, ld_discont ) 
     1077 
     1078      IMPLICIT NONE 
     1079      ! Argument 
     1080      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_value 
     1081      REAL(dp)                   , INTENT(IN) :: dd_fill 
     1082      CHARACTER(LEN=*)           , INTENT(IN) :: cd_dim 
     1083      LOGICAL                    , INTENT(IN), OPTIONAL :: ld_discont 
     1084 
     1085      ! function 
     1086      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), & 
     1087      &                   SIZE(dd_value,DIM=2) ) :: extrap_deriv_2D 
     1088 
     1089      ! local variable 
     1090      INTEGER(i4)                              :: il_imin 
     1091      INTEGER(i4)                              :: il_imax 
     1092      INTEGER(i4)                              :: il_jmin 
     1093      INTEGER(i4)                              :: il_jmax 
     1094      INTEGER(i4), DIMENSION(2)                :: il_shape 
     1095 
     1096      REAL(dp)                                 :: dl_min 
     1097      REAL(dp)                                 :: dl_max 
     1098      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value 
     1099 
     1100      LOGICAL                                  :: ll_discont 
     1101 
     1102      ! loop indices 
     1103      INTEGER(i4) :: ji 
     1104      INTEGER(i4) :: jj 
     1105 
     1106      INTEGER(i4) :: i1 
     1107      INTEGER(i4) :: i2 
     1108 
     1109      INTEGER(i4) :: j1 
     1110      INTEGER(i4) :: j2 
     1111      !---------------------------------------------------------------- 
     1112      ! init 
     1113      extrap_deriv_2D(:,:)=dd_fill 
     1114 
     1115      ll_discont=.FALSE. 
     1116      IF( PRESENT(ld_discont) ) ll_discont=ld_discont 
     1117 
     1118      il_shape(:)=SHAPE(dd_value(:,:)) 
     1119 
     1120      SELECT CASE(TRIM(fct_upper(cd_dim))) 
     1121 
     1122      CASE('I') 
     1123 
     1124         ALLOCATE( dl_value(3,il_shape(2)) ) 
     1125         ! compute derivative in i-direction 
     1126         DO ji=1,il_shape(1) 
     1127 
     1128            ! init 
     1129            dl_value(:,:)=dd_fill 
     1130             
     1131            il_imin=MAX(ji-1,1) 
     1132            il_imax=MIN(ji+1,il_shape(1)) 
     1133 
     1134            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN 
     1135               i1=1  ; i2=3 
     1136            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN 
     1137               i1=1  ; i2=2 
     1138            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN 
     1139               i1=2  ; i2=3 
     1140            ENDIF 
     1141 
     1142            dl_value(i1:i2,:)=dd_value(il_imin:il_imax,:) 
     1143            IF( il_imin == 1 )THEN 
     1144               dl_value(:,:)=EOSHIFT( dl_value(:,:), & 
     1145               &                      DIM=1,         & 
     1146               &                      SHIFT=-1,      & 
     1147               &                      BOUNDARY=dl_value(1,:) ) 
     1148            ENDIF 
     1149            IF( il_imax == il_shape(1) )THEN 
     1150               dl_value(:,:)=EOSHIFT( dl_value(:,:), & 
     1151               &                      DIM=1,         & 
     1152               &                      SHIFT=1,       & 
     1153               &                      BOUNDARY=dl_value(3,:)) 
     1154            ENDIF 
     1155 
     1156            IF( ll_discont )THEN 
     1157               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill ) 
     1158               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill ) 
     1159               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN 
     1160                  WHERE( dl_value(:,:) < 0_dp )  
     1161                     dl_value(:,:) = dl_value(:,:)+360._dp 
     1162                  END WHERE 
     1163               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN 
     1164                  WHERE( dl_value(:,:) > 180 )  
     1165                     dl_value(:,:) = dl_value(:,:)-180._dp 
     1166                  END WHERE 
     1167               ENDIF 
     1168            ENDIF 
     1169             
     1170            WHERE( dl_value(2,:) /= dd_fill .AND. &  ! ji 
     1171            &      dl_value(3,:) /= dd_fill .AND. &  ! ji+1 
     1172            &      dl_value(1,:) /= dd_fill )        ! ji-1 
     1173 
     1174               extrap_deriv_2D(ji,:)=& 
     1175               &  ( dl_value(3,:) - dl_value(1,:) ) / & 
     1176               &    REAL( il_imax-il_imin,dp) 
     1177 
     1178            END WHERE 
     1179 
     1180         ENDDO 
     1181 
     1182      CASE('J') 
     1183 
     1184         ALLOCATE( dl_value(il_shape(1),3) ) 
     1185         ! compute derivative in j-direction 
     1186         DO jj=1,il_shape(2) 
     1187          
     1188            il_jmin=MAX(jj-1,1) 
     1189            il_jmax=MIN(jj+1,il_shape(2)) 
     1190 
     1191            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN 
     1192               j1=1  ; j2=3 
     1193            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN 
     1194               j1=1  ; j2=2 
     1195            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN 
     1196               j1=2  ; j2=3 
     1197            ENDIF 
     1198 
     1199            dl_value(:,j1:j2)=dd_value(:,il_jmin:il_jmax) 
     1200            IF( il_jmin == 1 )THEN 
     1201               dl_value(:,:)=EOSHIFT( dl_value(:,:), & 
     1202               &                      DIM=2,         & 
     1203               &                      SHIFT=-1,      & 
     1204               &                      BOUNDARY=dl_value(:,1)) 
     1205            ENDIF 
     1206            IF( il_jmax == il_shape(2) )THEN 
     1207               dl_value(:,:)=EOSHIFT( dl_value(:,:), & 
     1208               &                      DIM=2,         & 
     1209               &                      SHIFT=1,       & 
     1210               &                      BOUNDARY=dl_value(:,3)) 
     1211            ENDIF 
     1212 
     1213            IF( ll_discont )THEN 
     1214               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill ) 
     1215               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill ) 
     1216               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN 
     1217                  WHERE( dl_value(:,:) < 0_dp )  
     1218                     dl_value(:,:) = dl_value(:,:)+360._dp 
     1219                  END WHERE 
     1220               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN 
     1221                  WHERE( dl_value(:,:) > 180 )  
     1222                     dl_value(:,:) = dl_value(:,:)-180._dp 
     1223                  END WHERE 
     1224               ENDIF 
     1225            ENDIF 
     1226 
     1227            WHERE( dl_value(:, 2) /= dd_fill .AND. & ! jj 
     1228            &      dl_value(:, 3) /= dd_fill .AND. & ! jj+1 
     1229            &      dl_value(:, 1) /= dd_fill )       ! jj-1 
     1230 
     1231               extrap_deriv_2D(:,jj)=& 
     1232               &  ( dl_value(:,3) - dl_value(:,1) ) / & 
     1233               &   REAL(il_jmax-il_jmin,dp)          
     1234 
     1235            END WHERE 
     1236 
     1237         ENDDO 
     1238          
     1239      END SELECT 
     1240 
     1241      DEALLOCATE( dl_value ) 
     1242 
     1243   END FUNCTION extrap_deriv_2D 
     1244   !------------------------------------------------------------------- 
     1245   !> @brief 
     1246   !> This function compute derivative of 3D array. 
     1247   !> you have to specify in which direction derivative have to be computed: 
     1248   !> first (I), second (J) or third (K) dimension. 
     1249   !>  
     1250   !> @details  
     1251   !> optionaly you could specify to take into account east west discontinuity 
     1252   !> (-180° 180° or 0° 360° for longitude variable) 
     1253   !> 
     1254   !> @author J.Paul 
     1255   !> - November, 2013- Initial Version 
     1256   ! 
     1257   !> @param[inout] dd_value  3D array of variable to be extrapolated 
     1258   !> @param[in] dd_fill      FillValue of variable 
     1259   !> @param[in] cd_dim       compute derivative on first (I) second (J) or third (K) dimension    
     1260   !> @param[in] ld_discont   logical to take into account east west discontinuity 
     1261   !------------------------------------------------------------------- 
     1262   PURE FUNCTION extrap_deriv_3D( dd_value, dd_fill, cd_dim, ld_discont ) 
     1263 
     1264      IMPLICIT NONE 
     1265      ! Argument 
     1266      REAL(dp)        , DIMENSION(:,:,:), INTENT(IN) :: dd_value 
     1267      REAL(dp)                          , INTENT(IN) :: dd_fill 
     1268      CHARACTER(LEN=*)                  , INTENT(IN) :: cd_dim 
     1269      LOGICAL                           , INTENT(IN), OPTIONAL :: ld_discont 
     1270 
     1271      ! function 
     1272      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), & 
     1273      &                   SIZE(dd_value,DIM=2), & 
     1274      &                   SIZE(dd_value,DIM=3)) :: extrap_deriv_3D 
     1275 
     1276      ! local variable 
     1277      INTEGER(i4)                                :: il_imin 
     1278      INTEGER(i4)                                :: il_imax 
     1279      INTEGER(i4)                                :: il_jmin 
     1280      INTEGER(i4)                                :: il_jmax 
     1281      INTEGER(i4)                                :: il_kmin 
     1282      INTEGER(i4)                                :: il_kmax 
     1283      INTEGER(i4), DIMENSION(3)                  :: il_shape 
     1284 
     1285      REAL(dp)                                   :: dl_min 
     1286      REAL(dp)                                   :: dl_max 
     1287      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value 
     1288 
     1289      LOGICAL                                    :: ll_discont 
     1290 
     1291      ! loop indices 
     1292      INTEGER(i4) :: ji 
     1293      INTEGER(i4) :: jj 
     1294      INTEGER(i4) :: jk 
     1295 
     1296      INTEGER(i4) :: i1 
     1297      INTEGER(i4) :: i2 
     1298 
     1299      INTEGER(i4) :: j1 
     1300      INTEGER(i4) :: j2 
     1301       
     1302      INTEGER(i4) :: k1 
     1303      INTEGER(i4) :: k2       
     1304      !---------------------------------------------------------------- 
     1305      ! init 
     1306      extrap_deriv_3D(:,:,:)=dd_fill 
     1307 
     1308      ll_discont=.FALSE. 
     1309      IF( PRESENT(ld_discont) ) ll_discont=ld_discont 
     1310 
     1311      il_shape(:)=SHAPE(dd_value(:,:,:)) 
     1312 
     1313 
     1314      SELECT CASE(TRIM(fct_upper(cd_dim))) 
     1315 
     1316      CASE('I') 
     1317 
     1318         ALLOCATE( dl_value(3,il_shape(2),il_shape(3)) ) 
     1319         ! compute derivative in i-direction 
     1320         DO ji=1,il_shape(1) 
     1321             
     1322            il_imin=MAX(ji-1,1) 
     1323            il_imax=MIN(ji+1,il_shape(1)) 
     1324 
     1325            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN 
     1326               i1=1  ; i2=3 
     1327            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN 
     1328               i1=1  ; i2=2 
     1329            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN 
     1330               i1=2  ; i2=3 
     1331            ENDIF 
     1332 
     1333            dl_value(i1:i2,:,:)=dd_value(il_imin:il_imax,:,:) 
     1334            IF( il_imin == 1 )THEN 
     1335               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), & 
     1336               &                      DIM=1,         & 
     1337               &                      SHIFT=-1,      & 
     1338               &                      BOUNDARY=dl_value(1,:,:) ) 
     1339            ENDIF 
     1340            IF( il_imax == il_shape(1) )THEN 
     1341               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), & 
     1342               &                      DIM=1,         & 
     1343               &                      SHIFT=1,       & 
     1344               &                      BOUNDARY=dl_value(3,:,:)) 
     1345            ENDIF 
     1346 
     1347            IF( ll_discont )THEN 
     1348               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill ) 
     1349               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill ) 
     1350               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN 
     1351                  WHERE( dl_value(:,:,:) < 0_dp )  
     1352                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp 
     1353                  END WHERE 
     1354               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN 
     1355                  WHERE( dl_value(:,:,:) > 180 )  
     1356                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp 
     1357                  END WHERE 
     1358               ENDIF 
     1359            ENDIF 
     1360 
     1361            WHERE( dl_value(2,:,:) /= dd_fill .AND. & ! ji 
     1362            &      dl_value(3,:,:) /= dd_fill .AND. & !ji+1  
     1363            &      dl_value(1,:,:) /= dd_fill )       !ji-1 
     1364 
     1365               extrap_deriv_3D(ji,:,:)= & 
     1366               &  ( dl_value(3,:,:) - dl_value(1,:,:) ) / & 
     1367               &  REAL( il_imax-il_imin ,dp) 
     1368 
     1369            END WHERE 
     1370 
     1371         ENDDO 
     1372 
     1373      CASE('J') 
     1374 
     1375         ALLOCATE( dl_value(il_shape(1),3,il_shape(3)) ) 
     1376         ! compute derivative in j-direction 
     1377         DO jj=1,il_shape(2) 
     1378          
     1379            il_jmin=MAX(jj-1,1) 
     1380            il_jmax=MIN(jj+1,il_shape(2)) 
     1381 
     1382            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN 
     1383               j1=1  ; j2=3 
     1384            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN 
     1385               j1=1  ; j2=2 
     1386            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN 
     1387               j1=2  ; j2=3 
     1388            ENDIF 
     1389 
     1390            dl_value(:,j1:j2,:)=dd_value(:,il_jmin:il_jmax,:) 
     1391            IF( il_jmin == 1 )THEN 
     1392               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), & 
     1393               &                      DIM=2,         & 
     1394               &                      SHIFT=-1,      & 
     1395               &                      BOUNDARY=dl_value(:,1,:) ) 
     1396            ENDIF 
     1397            IF( il_jmax == il_shape(2) )THEN 
     1398               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), & 
     1399               &                      DIM=2,         & 
     1400               &                      SHIFT=1,       & 
     1401               &                      BOUNDARY=dl_value(:,3,:)) 
     1402            ENDIF 
     1403 
     1404            IF( ll_discont )THEN 
     1405               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill ) 
     1406               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill ) 
     1407               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN 
     1408                  WHERE( dl_value(:,:,:) < 0_dp )  
     1409                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp 
     1410                  END WHERE 
     1411               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN 
     1412                  WHERE( dl_value(:,:,:) > 180 )  
     1413                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp 
     1414                  END WHERE 
     1415               ENDIF 
     1416            ENDIF 
     1417 
     1418            WHERE( dl_value(:, 2,:) /= dd_fill .AND. & ! jj 
     1419               &   dl_value(:, 3,:) /= dd_fill .AND. & ! jj+1 
     1420            &      dl_value(:, 1,:) /= dd_fill )       ! jj-1 
     1421 
     1422               extrap_deriv_3D(:,jj,:)=& 
     1423               &  ( dl_value(:,3,:) - dl_value(:,1,:) ) / & 
     1424               &  REAL( il_jmax - il_jmin ,dp)          
     1425 
     1426            END WHERE 
     1427 
     1428         ENDDO 
     1429          
     1430      CASE('K') 
     1431         ! compute derivative in k-direction 
     1432         DO jk=1,il_shape(3) 
     1433 
     1434            il_kmin=MAX(jk-1,1) 
     1435            il_kmax=MIN(jk+1,il_shape(3)) 
     1436 
     1437            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN 
     1438               k1=1  ; k2=3 
     1439            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN 
     1440               k1=1  ; k2=2 
     1441            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN 
     1442               k1=2  ; k2=3 
     1443            ENDIF 
     1444 
     1445            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax) 
     1446            IF( il_kmin == 1 )THEN 
     1447               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), & 
     1448               &                      DIM=3,         & 
     1449               &                      SHIFT=-1,      & 
     1450               &                      BOUNDARY=dl_value(:,:,1) ) 
     1451            ENDIF 
     1452            IF( il_kmax == il_shape(3) )THEN 
     1453               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), & 
     1454               &                        DIM=3,         & 
     1455               &                        SHIFT=1,       & 
     1456               &                        BOUNDARY=dl_value(:,:,3)) 
     1457            ENDIF 
     1458 
     1459            IF( ll_discont )THEN 
     1460               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill ) 
     1461               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill ) 
     1462               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN 
     1463                  WHERE( dl_value(:,:,:) < 0_dp )  
     1464                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp 
     1465                  END WHERE 
     1466               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN 
     1467                  WHERE( dl_value(:,:,:) > 180 )  
     1468                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp 
     1469                  END WHERE 
     1470               ENDIF 
     1471            ENDIF          
     1472 
     1473            WHERE( dl_value(:,:, 2) /= dd_fill .AND. & ! jk 
     1474               &   dl_value(:,:, 3) /= dd_fill .AND. & ! jk+1 
     1475               &   dl_value(:,:, 1) /= dd_fill )       ! jk-1 
     1476 
     1477               extrap_deriv_3D(:,:,jk)=& 
     1478               &  ( dl_value(:,:,3) - dl_value(:,:,1) ) / & 
     1479               &  REAL( il_kmax-il_kmin,dp)          
     1480 
     1481            END WHERE 
     1482 
     1483         ENDDO 
     1484 
     1485      END SELECT 
     1486 
     1487      DEALLOCATE( dl_value ) 
     1488 
     1489   END FUNCTION extrap_deriv_3D 
    8421490   !------------------------------------------------------------------- 
    8431491   !> @brief 
    … …  
    8451493   !>  
    8461494   !> @details  
    847    !> coefficients are  "grid distance" to the center of the box  
    848    !> choosed to compute extrapolation. 
     1495   !> coefficients are  "grid distance" to the center of the box choosed to compute 
     1496   !> extrapolation. 
    8491497   !> 
    8501498   !> @author J.Paul 
    851    !> @date November, 2013 - Initial Version 
    852    !> @date July, 2015  
    853    !> - decrease weight of third dimension 
     1499   !> - November, 2013- Initial Version 
    8541500   ! 
    8551501   !> @param[in] dd_value  3D array of variable to be extrapolated 
    … …  
    8981544 
    8991545               ! compute distance 
    900                ! "vertical weight" is lower than horizontal  
    9011546               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + & 
    9021547               &                   (jj-il_jmid)**2 + & 
    903                &                 3*(jk-il_kmid)**2 
     1548               &                   (jk-il_kmid)**2 
    9041549 
    9051550               IF( dl_dist(ji,jj,jk) /= 0 )THEN 
    … …  
    9241569   !>  
    9251570   !> @author J.Paul 
    926    !> @date November, 2013 - Initial Version 
     1571   !> - November, 2013- Initial Version 
    9271572   !> 
    9281573   !> @param[in] dd_value  3D array of variable to be extrapolated 
    … …  
    10131658   !> 
    10141659   !> @author J.Paul 
    1015    !> @date November, 2013 - Initial Version 
    1016    !> @date July, 2015  
    1017    !> - decrease weight of third dimension 
     1660   !> - November, 2013- Initial Version 
    10181661   ! 
    10191662   !> @param[in] dd_value  3D array of variable to be extrapolated 
    … …  
    10621705 
    10631706               ! compute distance 
    1064                ! "vertical weight" is lower than horizontal  
    10651707               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + & 
    10661708               &                   (jj-il_jmid)**2 + & 
    1067                &                 3*(jk-il_kmid)**2 
     1709               &                   (jk-il_kmid)**2 
    10681710 
    10691711               IF( dl_dist(ji,jj,jk) /= 0 )THEN 
    … …  
    10901732   !> 
    10911733   !> @author J.Paul 
    1092    !> @date November, 2013 - Initial Version 
     1734   !> - November, 2013- Initial Version 
    10931735   ! 
    10941736   !> @param[in] dd_value  3D array of variable to be extrapolated 
    … …  
    11211763      INTEGER(i4) :: jj 
    11221764      INTEGER(i4) :: jk 
     1765 
    11231766      !---------------------------------------------------------------- 
    11241767 
    … …  
    11501793            ENDDO 
    11511794         ENDDO 
    1152  
    11531795 
    11541796         ! return value 
    … …  
    11731815   !> 
    11741816   !> @author J.Paul 
    1175    !> @date November, 2013 - Initial version 
     1817   !> - November, 2013-Initial version 
    11761818   ! 
    11771819   !> @param[inout] td_var variable  
    … …  
    12751917   !> 
    12761918   !> @author J.Paul 
    1277    !> @date November, 2013 - Initial version 
     1919   !> - November, 2013-Initial version 
    12781920   !> 
    12791921   !> @param[inout] td_var variable  

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

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

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/filter.f90

    r10248 r10251  
    1818!>          - rad > cutoff : @f$ filter=0 @f$                
    1919!>       - 'blackman' 
    20 !>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) +  
    21 !>                                      0.08*COS(2\pi*\frac{rad}{cutoff}) @f$ 
     20!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 0.08*COS(2\pi*\frac{rad}{cutoff}) @f$ 
    2221!>          - rad > cutoff : @f$ filter=0 @f$ 
    2322!>       - 'gauss' 
    … …  
    3029!> 
    3130!>    td_var\%c_filter(2) string character is the number of turn to be done<br/> 
    32 !>    td_var\%c_filter(3) string character is the cut-off frequency  
    33 ! >                       (count in number of mesh grid)<br/> 
    34 !>    td_var\%c_filter(4) string character is the halo radius  
    35 !>                        (count in number of mesh grid)<br/> 
    36 !>    td_var\%c_filter(5) string character is the alpha parameter  
    37 !>                        (for gauss and butterworth method)<br/> 
     31!>    td_var\%c_filter(3) string character is the cut-off frequency (count in number of mesh grid)<br/> 
     32!>    td_var\%c_filter(4) string character is the halo radius (count in number of mesh grid)<br/> 
     33!>    td_var\%c_filter(5) string character is the alpha parameter (for gauss and butterworth method)<br/> 
    3834!>     
    3935!>    @note Filter method could be specify for each variable in namelist _namvar_, 
    … …  
    4440!>    The number of turn is specify using '*' separator.<br/> 
    4541!>    Example: 
    46 !>       - cn_varinfo='varname1:flt=2*hamming(@f$cutoff@f$,@f$radius@f$)',  
    47 !>                    'varname2:flt=gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)' 
     42!>       - cn_varinfo='varname1:2*hamming(@f$cutoff@f$,@f$radius@f$)', 'varname2:gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)' 
    4843!> 
    4944!>    to filter variable value:<br/> 
    … …  
    111106   !> 
    112107   !> @author J.Paul 
    113    !> @date November, 2013 - Initial Version 
     108   !> - November, 2013- Initial Version 
    114109   ! 
    115110   !> @param[inout] td_var variable structure  
    … …  
    255250   !> 
    256251   !> @author J.Paul 
    257    !> @date November, 2013 - Initial Version 
     252   !> - November, 2013- Initial Version 
    258253   ! 
    259254   !> @param[inout] td_var variable  
    … …  
    301296 
    302297      !3-extrapolate 
    303       CALL extrap_fill_value( td_var ) !, id_iext=id_radius, id_jext=id_radius ) 
     298      CALL extrap_fill_value( td_var, id_iext=id_radius, id_jext=id_radius ) 
    304299 
    305300      !4-filtering 
    … …  
    346341   ! 
    347342   !> @author J.Paul 
    348    !> @date November, 2013 - Initial Version 
     343   !> - November, 2013- Initial Version 
    349344   ! 
    350345   !> @param[inout] dd_value  array of value to be filtered  
    … …  
    398393   !> 
    399394   !> @author J.Paul 
    400    !> @date November, 2013 - Initial Version 
     395   !> - November, 2013- Initial Version 
    401396   ! 
    402397   !> @param[inout] dd_value  array of value to be filtered  
    … …  
    444439   !> 
    445440   !> @author J.Paul 
    446    !> @date November, 2013 - Initial Version 
     441   !> - November, 2013- Initial Version 
    447442   ! 
    448443   !> @param[inout] dd_value  array of value to be filtered  
    … …  
    487482   !> 
    488483   !> @author J.Paul 
    489    !> @date November, 2013 - Initial Version 
     484   !> - November, 2013- Initial Version 
    490485   ! 
    491486   !> @param[inout] dd_value  array of value to be filtered  
    … …  
    542537   !> 
    543538   !> @author J.Paul 
    544    !> @date November, 2013 - Initial Version 
     539   !> - Nov, 2013- Initial Version 
    545540   ! 
    546541   !> @param[inout] dd_value  array of value to be filtered  
    … …  
    595590   ! 
    596591   !> @author J.Paul 
    597    !> @date November, 2013 - Initial Version 
     592   !> - November, 2013- Initial Version 
    598593   ! 
    599594   !> @param[in] cd_name   filter name 
    … …  
    654649   ! 
    655650   !> @author J.Paul 
    656    !> @date November, 2013 - Initial Version 
     651   !> - November, 2013- Initial Version 
    657652   ! 
    658653   !> @param[in] cd_name   filter name 
    … …  
    700695   ! 
    701696   !> @author J.Paul 
    702    !> @date November, 2013 - Initial Version 
     697   !> - November, 2013- Initial Version 
    703698   ! 
    704699   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    754749   ! 
    755750   !> @author J.Paul 
    756    !> @date November, 2013 - Initial Version 
     751   !> - November, 2013- Initial Version 
    757752   ! 
    758753   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    813808   ! 
    814809   !> @author J.Paul 
    815    !> @date November, 2013 - Initial Version 
     810   !> - November, 2013- Initial Version 
    816811   ! 
    817812   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    868863   ! 
    869864   !> @author J.Paul 
    870    !> @date November, 2013 - Initial Version 
     865   !> - November, 2013- Initial Version 
    871866   ! 
    872867   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    927922   ! 
    928923   !> @author J.Paul 
    929    !> @date November, 2013 - Initial Version 
     924   !> - November, 2013- Initial Version 
    930925   ! 
    931926   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    983978   !> 
    984979   !> @author J.Paul 
    985    !> @date November, 2013 - Initial Version 
     980   !> - November, 2013- Initial Version 
    986981   !> 
    987982   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    10431038   !> 
    10441039   !> @author J.Paul 
    1045    !> @date November, 2013 - Initial Version 
     1040   !> - November, 2013- Initial Version 
    10461041   !> 
    10471042   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    10951090   !> 
    10961091   !> @author J.Paul 
    1097    !> @date November, 2013 - Initial Version 
     1092   !> - November, 2013- Initial Version 
    10981093   !> 
    10991094   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    11511146   !> 
    11521147   !> @author J.Paul 
    1153    !> @date November, 2013 - Initial Version 
     1148   !> - November, 2013- Initial Version 
    11541149   !> 
    11551150   !> @param[in] dd_cutoff cut-off frequency 
    … …  
    12031198   !> 
    12041199   !> @author J.Paul 
    1205    !> @date November, 2013 - Initial Version 
     1200   !> - November, 2013- Initial Version 
    12061201   !> 
    12071202   !> @param[in] dd_cutoff cut-off frequency 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/function.f90

    r10248 r10251  
    5151!> @endcode 
    5252!> 
    53 !>  to check if character is real 
    54 !> @code 
    55 !>  ll_is_real=fct_is_real(cd_var) 
    56 !> @endcode 
    57 !> 
    5853!>  to split string into substring and return one of the element:<br/>   
    5954!> @code 
    … …  
    9489! REVISION HISTORY: 
    9590!> @date November, 2013 - Initial Version 
    96 !> @date September, 2014  
    97 !> - add header 
     91!> @date September, 2014 - add header 
    9892! 
    9993!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    112106   PUBLIC :: fct_lower    !< convert character from upper to lower case 
    113107   PUBLIC :: fct_is_num   !< check if character is numeric 
    114    PUBLIC :: fct_is_real  !< check if character is real 
    115108   PUBLIC :: fct_split    !< split string into substring 
    116109   PUBLIC :: fct_basename !< return basename (name without path) 
    … …  
    160153   !  
    161154   !> @author J.Paul  
    162    !> @date September, 2014 - Initial Version  
     155   !> - September, 2014- Initial Version  
    163156   !  
    164157   !> @param[in] cd_char   string character 
    … …  
    184177   !  
    185178   !> @author J.Paul  
    186    !> @date September, 2014 - Initial Version  
     179   !> - September, 2014- Initial Version  
    187180   !  
    188181   !> @param[in] cd_char   string character 
    … …  
    208201   !  
    209202   !> @author J.Paul  
    210    !> @date November, 2013 - Initial Version  
     203   !> - Nov, 2013- Initial Version  
    211204   !  
    212205   !> @param[in] cd_char   string character 
    … …  
    232225   !  
    233226   !> @author J.Paul  
    234    !> @date November, 2013 - Initial Version  
     227   !> - November, 2013- Initial Version  
    235228   !  
    236229   !> @param[in] cd_char   string character 
    … …  
    256249   !  
    257250   !> @author J.Paul  
    258    !> @date November, 2013 - Initial Version  
     251   !> - November, 2013- Initial Version  
    259252   !  
    260253   !> @param[in] cd_char   string character 
    … …  
    280273   !> 
    281274   !> @author J.Paul  
    282    !> @date November, 2013 - Initial Version  
     275   !> - November, 2013- Initial Version  
    283276   !> 
    284277   !> @param[in] cd_char   string character 
    … …  
    304297   !> 
    305298   !> @author J.Paul  
    306    !> @date November, 2013 - Initial Version  
     299   !> - November, 2013- Initial Version  
    307300   !> 
    308301   !> @param[in] cd_char   string character 
    … …  
    328321   !> 
    329322   !> @author J.Paul  
    330    !> @date November, 2013 - Initial Version  
     323   !> - November, 2013- Initial Version  
    331324   !> 
    332325   !> @return file id  
    … …  
    351344   ! 
    352345   !> @author J.Paul 
    353    !> @date November, 2013 - Initial Version 
     346   !> - November, 2013- Initial Version 
    354347   !> 
    355348   !> @param[in] id_status 
    … …  
    372365   ! 
    373366   !> @author J.Paul 
    374    !> @date November, 2014 - Initial Version 
     367   !> - November, 2014- Initial Version 
    375368   !> 
    376369   !> @param[in] cd_msg optional message to be added 
    … …  
    394387   !> 
    395388   !> @author J.Paul 
    396    !> @date November, 2013 - Initial Version 
     389   !> - November, 2013- Initial Version 
    397390   ! 
    398391   !> @param[in] ld_var logical variable 
    … …  
    416409   !> 
    417410   !> @author J.Paul 
    418    !> @date November, 2013 - Initial Version 
     411   !> - November, 2013- Initial Version 
    419412   ! 
    420413   !> @param[in] bd_var integer(1) variable 
    … …  
    438431   !> 
    439432   !> @author J.Paul 
    440    !> @date November, 2013 - Initial Version 
     433   !> - November, 2013- Initial Version 
    441434   ! 
    442435   !> @param[in] sd_var integer(2) variable 
    … …  
    460453   !> 
    461454   !> @author J.Paul 
    462    !> @date November, 2013 - Initial Version 
     455   !> - November, 2013- Initial Version 
    463456   ! 
    464457   !> @param[in] id_var integer(4) variable 
    … …  
    482475   !> 
    483476   !> @author J.Paul 
    484    !> @date November, 2013 - Initial Version 
     477   !> - November, 2013- Initial Version 
    485478   ! 
    486479   !> @param[in] kd_var integer(8) variable 
    … …  
    504497   !> 
    505498   !> @author J.Paul 
    506    !> @date November, 2013 - Initial Version 
     499   !> - November, 2013- Initial Version 
    507500   ! 
    508501   !> @param[in] rd_var real(4) variable 
    … …  
    526519   !> 
    527520   !> @author J.Paul 
    528    !> @date November, 2013 - Initial Version 
     521   !> - November, 2013- Initial Version 
    529522   ! 
    530523   !> @param[in] dd_var real(8) variable 
    … …  
    551544   !> 
    552545   !> @author J.Paul 
    553    !> @date November, 2013 - Initial Version 
     546   !> - November, 2013- Initial Version 
    554547   ! 
    555548   !> @param[in] cd_arr array of character 
    … …  
    597590   ! 
    598591   !> @author J.Paul 
    599    !> @date November, 2013 - Initial Version 
     592   !> - November, 2013- Initial Version 
    600593   ! 
    601594   !> @param[in] cd_var character 
    … …  
    654647   ! 
    655648   !> @author J.Paul 
    656    !> @date November, 2013 - Initial Version 
     649   !> - November, 2013- Initial Version 
    657650   ! 
    658651   !> @param[in] cd_var character 
    … …  
    704697   ! 
    705698   !> @author J.Paul 
    706    !> @date November, 2013 - Initial Version 
     699   !> - November, 2013- Initial Version 
    707700   ! 
    708701   !> @param[in] cd_var character 
    … …  
    730723   END FUNCTION fct_is_num 
    731724   !------------------------------------------------------------------- 
    732    !> @brief This function check if character is real number. 
    733    ! 
    734    !> @details 
    735    !> it allows exponantial and decimal number 
    736    !> exemple :  1e6, 2.3 
    737    !> 
    738    !> @author J.Paul 
    739    !> @date June, 2015 - Initial Version 
    740    ! 
    741    !> @param[in] cd_var character 
    742    !> @return character is numeric 
    743    !------------------------------------------------------------------- 
    744    PURE LOGICAL FUNCTION fct_is_real(cd_var) 
    745       IMPLICIT NONE 
    746       ! Argument       
    747       CHARACTER(LEN=*), INTENT(IN) :: cd_var 
    748     
    749       ! local variables 
    750       LOGICAL :: ll_exp 
    751       LOGICAL :: ll_dec 
    752     
    753       ! loop indices 
    754       INTEGER :: ji 
    755       !---------------------------------------------------------------- 
    756     
    757       ll_exp=.TRUE. 
    758       ll_dec=.FALSE. 
    759       DO ji=1,LEN(TRIM(cd_var)) 
    760          IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. & 
    761          &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN 
    762     
    763             fct_is_real=.TRUE. 
    764             ll_exp=.FALSE. 
    765        
    766          ELSEIF( TRIM(cd_var(ji:ji))=='e' )THEN 
    767           
    768             IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN 
    769                fct_is_real=.FALSE. 
    770                EXIT 
    771             ELSE  
    772                ll_exp=.TRUE. 
    773             ENDIF 
    774     
    775          ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN 
    776     
    777             IF( ll_dec )THEN 
    778                fct_is_real=.FALSE. 
    779                EXIT 
    780             ELSE 
    781                fct_is_real=.TRUE. 
    782                ll_dec=.TRUE. 
    783             ENDIF 
    784     
    785          ELSE 
    786     
    787             fct_is_real=.FALSE. 
    788             EXIT 
    789     
    790          ENDIF 
    791       ENDDO 
    792     
    793    END FUNCTION fct_is_real 
    794    !------------------------------------------------------------------- 
    795725   !> @brief This function split string of character  
    796726   !> using separator character, by default '|', 
    … …  
    798728   ! 
    799729   !> @author J.Paul 
    800    !> @date November, 2013 - Initial Version 
     730   !> - November, 2013- Initial Version 
    801731   ! 
    802732   !> @param[in] cd_string string of character 
    … …  
    878808   ! 
    879809   !> @author J.Paul 
    880    !> @date November, 2013 - Initial Version 
     810   !> - November, 2013- Initial Version 
    881811   ! 
    882812   !> @param[in] cd_string string of character 
    … …  
    943873   !> Optionally you could specify another separator. 
    944874   !> @author J.Paul 
    945    !> @date November, 2013 - Initial Version 
     875   !> - November, 2013- Initial Version 
    946876   ! 
    947877   !> @param[in] cd_string filename 
    … …  
    984914   !> Optionally you could specify another separator. 
    985915   !> @author J.Paul 
    986    !> @date November, 2013 - Initial Version 
     916   !> - November, 2013- Initial Version 
    987917   ! 
    988918   !> @param[in] cd_string filename 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/grid.f90

    r10248 r10251  
    149149!>    CALL grid_check_coincidence(td_coord0, td_coord1,  
    150150!>                                id_imin0, id_imax0, id_jmin0, id_jmax0 
    151 !>                                ,id_rho) 
     151!>                                [,id_rho]) 
    152152!> @endcode 
    153153!>       - td_coord0 is coarse grid coordinate mpp structure 
    … …  
    161161!>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid  
    162162!> domain  
    163 !>       - id_rho    is array of refinement factor  
     163!>       - id_rho    is array of refinement factor (default 1) 
    164164!> 
    165165!>    to add ghost cell at boundaries:<br/> 
    … …  
    213213!> @date October, 2014 
    214214!> - use mpp file structure instead of file 
    215 !> @date February, 2015 
    216 !> - add function grid_fill_small_msk to fill small domain inside bigger one 
    217215! 
    218216!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    257255   PUBLIC :: grid_split_domain         !< compute closed sea domain  
    258256   PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value  
    259    PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one  
    260257 
    261258                                     ! get closest coarse grid indices of fine grid domain 
    … …  
    355352   !> @note need all processor files to be there 
    356353   !> @author J.Paul 
    357    !> @date October, 2014 - Initial Version 
     354   !> - October, 2014- Initial Version 
    358355   !> 
    359356   !> @param[inout] td_file file structure  
    … …  
    469466   !> - compute East West overlap 
    470467   !> 
    471    !> @note need all processor files 
     468   !> @note need all processor files to be there 
    472469   !> @author J.Paul 
    473    !> @date October, 2014 - Initial Version 
     470   !> - October, 2014- Initial Version 
    474471   !> 
    475472   !> @param[in] td_mpp mpp structure  
    … …  
    499496      il_ew   =-1 
    500497 
    501       CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name)) 
    502498      ! copy structure 
    503499      tl_mpp=mpp_copy(td_mpp) 
    … …  
    527523      ENDIF 
    528524 
    529       CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio))) 
    530  
    531525      SELECT CASE(il_perio) 
    532526      CASE(3,4) 
     527         il_pivot=0 
     528      CASE(5,6) 
    533529         il_pivot=1 
    534       CASE(5,6) 
    535          il_pivot=0 
    536530      CASE(0,1,2) 
    537531         il_pivot=1 
    … …  
    540534      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 
    541535         ! get pivot 
    542          CALL logger_info("GRID GET INFO: look for pivot ") 
    543536         il_pivot=grid_get_pivot(tl_mpp) 
    544537      ENDIF 
    … …  
    546539      IF( il_perio < 0 .OR. il_perio > 6 )THEN 
    547540         ! get periodicity 
    548          CALL logger_info("GRID GET INFO: look for perio ") 
    549541         il_perio=grid_get_perio(tl_mpp, il_pivot) 
    550542      ENDIF 
    … …  
    552544      IF( il_ew < 0 )THEN 
    553545         ! get periodicity 
    554          CALL logger_info("GRID GET INFO: look for overlap ") 
    555546         il_ew=grid_get_ew_overlap(tl_mpp) 
    556547      ENDIF 
    … …  
    604595   !> 
    605596   !> @author J.Paul 
    606    !> @date November, 2013 - Initial version 
     597   !> - November, 2013- Subroutine written 
    607598   !> @date September, 2014 
    608599   !> - add dummy loop in case variable not over right point. 
    … …  
    717708   !>  
    718709   !> @author J.Paul 
    719    !> @date October, 2014 - Initial version 
     710   !> - October, 2014 - Initial version 
    720711   ! 
    721712   !> @param[in] dd_value array of value 
    … …  
    792783 
    793784         IF( ll_check )THEN 
    794             CALL logger_info("GRID GET PIVOT: F-pivot") 
     785            CALL logger_info("GRID GET PIVOT: T-pivot") 
    795786            grid__get_pivot_varT=0 
    796787         ENDIF 
    … …  
    810801   !>  
    811802   !> @author J.Paul 
    812    !> @date October, 2014 - Initial version 
     803   !> - October, 2014 - Initial version 
    813804   ! 
    814805   !> @param[in] dd_value array of value 
    … …  
    885876 
    886877         IF( ll_check )THEN 
    887             CALL logger_info("GRID GET PIVOT: F-pivot") 
     878            CALL logger_info("GRID GET PIVOT: T-pivot") 
    888879            grid__get_pivot_varU=0 
    889880         ENDIF 
    … …  
    903894   !>  
    904895   !> @author J.Paul 
    905    !> @date October, 2014 - Initial version 
     896   !> - October, 2014 - Initial version 
    906897   ! 
    907898   !> @param[in] dd_value array of value 
    … …  
    978969 
    979970         IF( ll_check )THEN 
    980             CALL logger_info("GRID GET PIVOT: F-pivot") 
     971            CALL logger_info("GRID GET PIVOT: T-pivot") 
    981972            grid__get_pivot_varV=0 
    982973         ENDIF 
    … …  
    996987   !>  
    997988   !> @author J.Paul 
    998    !> @date October, 2014 - Initial version 
     989   !> - October, 2014 - Initial version 
    999990   ! 
    1000991   !> @param[in] dd_value array of value 
    … …  
    10711062 
    10721063         IF( ll_check )THEN 
    1073             CALL logger_info("GRID GET PIVOT: F-pivot") 
     1064            CALL logger_info("GRID GET PIVOT: T-pivot") 
    10741065            grid__get_pivot_varF=0 
    10751066         ENDIF 
    … …  
    10921083   !> 
    10931084   !> @author J.Paul 
    1094    !> @date Ocotber, 2014 - Initial version 
     1085   !> - Ocotber, 2014- Initial version 
    10951086   ! 
    10961087   !> @param[in] td_file file structure 
    … …  
    11811172   !> 
    11821173   !> @author J.Paul 
    1183    !> @date October, 2014 - Initial version 
     1174   !> - October, 2014 - Initial version 
    11841175   ! 
    11851176   !> @param[in] td_mpp   mpp file structure 
    … …  
    12861277   !> 1: cyclic east-west boundary 
    12871278   !> 2: symmetric boundary condition across the equator 
    1288    !> 3: North fold boundary (with a T-point pivot) 
    1289    !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
    1290    !> 5: North fold boundary (with a F-point pivot) 
    1291    !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
     1279   !> 3: North fold boundary (with a F-point pivot) 
     1280   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
     1281   !> 5: North fold boundary (with a T-point pivot) 
     1282   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
    12921283   !> 
    12931284   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
    12941285   !> 
    12951286   !> @author J.Paul 
    1296    !> @date November, 2013 - Initial version 
     1287   !> - November, 2013- Subroutine written 
    12971288   !> @date October, 2014 
    12981289   !> - work on variable structure instead of file structure 
    … …  
    14611452   !> 
    14621453   !> @author J.Paul 
    1463    !> @date October, 2014 - Initial version 
     1454   !> - October, 2014 - Initial version 
    14641455   !> 
    14651456   !> @param[in] td_file   file structure 
    … …  
    15461537   !> 1: cyclic east-west boundary 
    15471538   !> 2: symmetric boundary condition across the equator 
    1548    !> 3: North fold boundary (with a T-point pivot) 
    1549    !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
    1550    !> 5: North fold boundary (with a F-point pivot) 
    1551    !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
     1539   !> 3: North fold boundary (with a F-point pivot) 
     1540   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 
     1541   !> 5: North fold boundary (with a T-point pivot) 
     1542   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 
    15521543   !> 
    15531544   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
    15541545   !> 
    15551546   !> @author J.Paul 
    1556    !> @date October, 2014 - Initial version 
     1547   !> - October, 2014 - Initial version 
    15571548   ! 
    15581549   !> @param[in] td_mpp   mpp file structure 
    … …  
    16431634   ! 
    16441635   !> @author J.Paul 
    1645    !> @date November, 2013 - Initial Version 
     1636   !> - November, 2013- Initial Version 
    16461637   !> @date October, 2014 
    16471638   !> - work on mpp file structure instead of file structure 
    … …  
    17551746   !> 
    17561747   !> @author J.Paul 
    1757    !> @date October, 2014 - Initial Version 
     1748   !> - October, 2014- Initial Version 
    17581749   !> 
    17591750   !> @param[in] td_file file structure  
    … …  
    18061797   ! 
    18071798   !> @author J.Paul 
    1808    !> @date November, 2013 - Initial Version 
     1799   !> - November, 2013- Initial Version 
    18091800   !> @date October, 2014 
    18101801   !> - work on mpp file structure instead of file structure 
    … …  
    18621853   !> 
    18631854   !> @author J.Paul 
    1864    !> @date November, 2013 - Initial Version 
     1855   !> - November, 2013- Initial Version 
    18651856   !> 
    18661857   !> @param[in] td_lat latitude variable structure  
    … …  
    18991890   ! 
    19001891   !> @author J.Paul 
    1901    !> @date November, 2013 - Initial Version 
     1892   !> - November, 2013- Initial Version 
    19021893   !> @date October, 2014 
    19031894   !> - work on mpp file structure instead of file structure 
    … …  
    19871978   !> 
    19881979   !> @author J.Paul 
    1989    !> @date November, 2013 - Initial Version 
     1980   !> - November, 2013- Initial Version 
    19901981   !> @date September, 2014 
    19911982   !> - use grid point to read coordinates variable.  
    19921983   !> @date October, 2014 
    19931984   !> - work on mpp file structure instead of file structure 
    1994    !> @date February, 2015 
    1995    !> - use longitude or latitude as standard name, if can not find  
    1996    !> longitude_T, latitude_T... 
    19971985   !> 
    19981986   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
    … …  
    20162004 
    20172005      ! local variable 
    2018       CHARACTER(LEN= 1)                        :: cl_point 
    2019       CHARACTER(LEN=lc)                        :: cl_name 
    2020  
    2021       INTEGER(i4)                              :: il_imin0 
    2022       INTEGER(i4)                              :: il_imax0 
    2023       INTEGER(i4)                              :: il_jmin0 
    2024       INTEGER(i4)                              :: il_jmax0 
    2025       INTEGER(i4)                              :: il_ind 
    2026  
    2027       INTEGER(i4), DIMENSION(2,2)              :: il_xghost0 
    2028       INTEGER(i4), DIMENSION(2,2)              :: il_xghost1 
    2029  
    2030       INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho 
    2031  
    2032       TYPE(TVAR)                               :: tl_lon0 
    2033       TYPE(TVAR)                               :: tl_lat0 
    2034       TYPE(TVAR)                               :: tl_lon1 
    2035       TYPE(TVAR)                               :: tl_lat1 
    2036  
    2037       TYPE(TMPP)                               :: tl_coord0 
    2038       TYPE(TMPP)                               :: tl_coord1 
     2006      TYPE(TMPP) :: tl_coord0 
     2007      TYPE(TMPP) :: tl_coord1 
     2008 
     2009      TYPE(TVAR)  :: tl_lon0 
     2010      TYPE(TVAR)  :: tl_lat0 
     2011      TYPE(TVAR)  :: tl_lon1 
     2012      TYPE(TVAR)  :: tl_lat1 
     2013 
     2014      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     2015 
     2016      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
     2017      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
     2018 
     2019      INTEGER(i4) :: il_imin0 
     2020      INTEGER(i4) :: il_imax0 
     2021      INTEGER(i4) :: il_jmin0 
     2022      INTEGER(i4) :: il_jmax0 
     2023 
     2024      CHARACTER(LEN= 1) :: cl_point 
     2025      CHARACTER(LEN=lc) :: cl_name 
    20392026 
    20402027      ! loop indices 
    … …  
    20702057         ! read coarse longitue and latitude 
    20712058         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    2072          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    2073          IF( il_ind == 0 )THEN 
    2074             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2075             &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
    2076             &  try to use longitude.") 
    2077             WRITE(cl_name,*) 'longitude' 
    2078          ENDIF 
    20792059         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    2080  
    20812060         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    2082          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    2083          IF( il_ind == 0 )THEN 
    2084             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2085             &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
    2086             &  try to use latitude.") 
    2087             WRITE(cl_name,*) 'latitude' 
    2088          ENDIF 
    20892061         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    20902062          
    … …  
    21052077         ! read fine longitue and latitude 
    21062078         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    2107          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    2108          IF( il_ind == 0 )THEN 
    2109             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2110             &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
    2111             &  try to use longitude.") 
    2112             WRITE(cl_name,*) 'longitude' 
    2113          ENDIF 
    21142079         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))  
    2115  
    21162080         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    2117          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    2118          IF( il_ind == 0 )THEN 
    2119             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2120             &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
    2121             &  try to use latitude.") 
    2122             WRITE(cl_name,*) 'latitude' 
    2123          ENDIF 
    21242081         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    21252082  
    … …  
    21702127   !> 
    21712128   !> @author J.Paul 
    2172    !> @date November, 2013 - Initial Version 
     2129   !> - November, 2013- Initial Version 
    21732130   !> @date September, 2014 
    21742131   !> - use grid point to read coordinates variable. 
    21752132   !> @date October, 2014 
    21762133   !> - work on mpp file structure instead of file structure 
    2177    !> @date February, 2015 
    2178    !> - use longitude or latitude as standard name, if can not find  
    2179    !> longitude_T, latitude_T... 
    21802134   !> 
    21812135   !> @param[in] td_longitude0   coarse grid longitude 
    … …  
    22002154 
    22012155      ! local variable 
    2202       CHARACTER(LEN= 1)                        :: cl_point 
    2203       CHARACTER(LEN=lc)                        :: cl_name 
    2204  
    2205       INTEGER(i4)                              :: il_ind 
    2206  
    2207       INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho 
    2208  
    2209       INTEGER(i4), DIMENSION(2,2)              :: il_xghost 
    2210  
    2211       TYPE(TVAR)                               :: tl_lon1 
    2212       TYPE(TVAR)                               :: tl_lat1 
    2213  
    2214       TYPE(TMPP)                               :: tl_coord1 
     2156      TYPE(TMPP)  :: tl_coord1 
     2157 
     2158      TYPE(TVAR)  :: tl_lon1 
     2159      TYPE(TVAR)  :: tl_lat1 
     2160 
     2161      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     2162 
     2163      INTEGER(i4), DIMENSION(2,2)       :: il_xghost 
     2164 
     2165      CHARACTER(LEN= 1) :: cl_point 
     2166      CHARACTER(LEN=lc) :: cl_name 
    22152167 
    22162168      ! loop indices 
    … …  
    22572209         ! read fine longitue and latitude 
    22582210         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    2259          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    2260          IF( il_ind == 0 )THEN 
    2261             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2262             &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". & 
    2263             &  try to use longitude.") 
    2264             WRITE(cl_name,*) 'longitude' 
    2265          ENDIF 
    22662211         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    2267  
    22682212         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    2269          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    2270          IF( il_ind == 0 )THEN 
    2271             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2272             &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". & 
    2273             &  try to use longitude.") 
    2274             WRITE(cl_name,*) 'latitude' 
    2275          ENDIF 
    22762213         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    22772214          
    … …  
    23072244   !> 
    23082245   !> @author J.Paul 
    2309    !> @date November, 2013 - Initial Version 
     2246   !> - November, 2013- Initial Version 
    23102247   !> @date September, 2014 
    23112248   !> - use grid point to read coordinates variable. 
    23122249   !> @date October, 2014 
    23132250   !> - work on mpp file structure instead of file structure 
    2314    !> @date February, 2015 
    2315    !> - use longitude or latitude as standard name, if can not find  
    2316    !> longitude_T, latitude_T... 
    23172251   !>  
    23182252   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
    … …  
    23372271 
    23382272      ! local variable 
    2339       CHARACTER(LEN= 1)                        :: cl_point 
    2340       CHARACTER(LEN=lc)                        :: cl_name       
    2341  
    2342       INTEGER(i4)                              :: il_imin0 
    2343       INTEGER(i4)                              :: il_imax0 
    2344       INTEGER(i4)                              :: il_jmin0 
    2345       INTEGER(i4)                              :: il_jmax0 
    2346       INTEGER(i4)                              :: il_ind 
    2347  
    2348       INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
    2349  
    2350       INTEGER(i4), DIMENSION(2,2)              :: il_xghost 
    2351  
    2352       TYPE(TVAR)                               :: tl_lon0 
    2353       TYPE(TVAR)                               :: tl_lat0 
    2354  
    2355       TYPE(TMPP)                               :: tl_coord0 
     2273      TYPE(TMPP)  :: tl_coord0 
     2274 
     2275      TYPE(TVAR)  :: tl_lon0 
     2276      TYPE(TVAR)  :: tl_lat0 
     2277 
     2278      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     2279 
     2280      INTEGER(i4), DIMENSION(2,2)       :: il_xghost 
     2281 
     2282      INTEGER(i4) :: il_imin0 
     2283      INTEGER(i4) :: il_imax0 
     2284      INTEGER(i4) :: il_jmin0 
     2285      INTEGER(i4) :: il_jmax0 
     2286 
     2287      CHARACTER(LEN= 1) :: cl_point 
     2288      CHARACTER(LEN=lc) :: cl_name       
    23562289 
    23572290      ! loop indices 
    … …  
    23972330         ! read coarse longitue and latitude 
    23982331         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    2399          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    2400          IF( il_ind == 0 )THEN 
    2401             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2402             &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". & 
    2403             &  try to use longitude.") 
    2404             WRITE(cl_name,*) 'longitude' 
    2405          ENDIF 
    24062332         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    2407           
    24082333         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    2409          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    2410          IF( il_ind == 0 )THEN 
    2411             CALL logger_warn("GRID GET COARSE INDEX: no variable "//& 
    2412             &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". & 
    2413             &  try to use latitude.") 
    2414             WRITE(cl_name,*) 'latitude' 
    2415          ENDIF 
    24162334         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    24172335 
    … …  
    24592377   !> 
    24602378   !> @author J.Paul 
    2461    !> @date November, 2013 - Initial Version 
     2379   !> - November, 2013- Initial Version 
    24622380   !> @date September, 2014 
    24632381   !> - check grid point 
    … …  
    26022520            CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
    26032521            CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
    2604   
     2522             
    26052523            ! "global" coarse grid indice 
    26062524            il_imin0=1 
    … …  
    26502568            IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 
    26512569            &   dl_lat1_ll == tl_lat1%d_fill )THEN 
    2652                CALL logger_debug("GRID GET COARSE INDEX: lon "//& 
    2653                &  TRIM(fct_str(dl_lon1_ll))//" "//& 
    2654                &  TRIM(fct_str(tl_lon1%d_fill)) ) 
    2655                CALL logger_debug("GRID GET COARSE INDEX: lat "//& 
    2656                &  TRIM(fct_str(dl_lat1_ll))//" "//& 
    2657                &  TRIM(fct_str(tl_lat1%d_fill)) ) 
    26582570               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 
    26592571               &                 "point is FillValue. remove ghost cell "//& 
    … …  
    27202632            ji = il_iul(1) 
    27212633            jj = il_iul(2) 
     2634 
    27222635            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 
    27232636               IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 
    … …  
    27342647               ENDIF 
    27352648            ENDIF 
     2649 
    27362650            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 
    27372651               IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 
    … …  
    28842798   ! 
    28852799   !> @author J.Paul 
    2886    !> @date November, 2013 - Initial Version 
     2800   !> - November, 2013- Initial Version 
    28872801   ! 
    28882802   !> @param[in] td_lon longitude structure  
    … …  
    29522866   !> 
    29532867   !> @author J.Paul 
    2954    !> @date November, 2013 - Initial Version 
    2955    !> @date February, 2015 - change dichotomy method to manage ORCA grid 
     2868   !> - November, 2013- Initial Version 
    29562869   ! 
    29572870   !> @param[in] dd_lon0   coarse grid array of longitude 
    … …  
    29592872   !> @param[in] dd_lon1   fine   grid longitude 
    29602873   !> @param[in] dd_lat1   fine   grid latitude 
    2961    !> @param[in] dd_fill   fill value 
    29622874   !> @return coarse grid indices of closest point of fine grid point 
    2963    !------------------------------------------------------------------- 
    2964    FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill ) 
     2875   !> 
     2876   !------------------------------------------------------------------- 
     2877   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1  ) 
    29652878      IMPLICIT NONE 
    29662879      ! Argument 
    … …  
    29692882      REAL(dp),                 INTENT(IN) :: dd_lon1 
    29702883      REAL(dp),                 INTENT(IN) :: dd_lat1 
    2971       REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill 
    29722884 
    29732885      ! function 
    … …  
    30172929 
    30182930      ll_north=.FALSE. 
    3019       ll_continue=.FALSE. 
    3020  
    3021       ! avoid to use fillvalue for reduce domain on first time 
    3022       IF( PRESENT(dd_fill) )THEN 
    3023          DO WHILE( ALL(dl_lon0(il_isup,:) == dd_fill) ) 
    3024             il_isup=il_isup-1 
    3025          ENDDO 
    3026          DO WHILE( ALL(dl_lon0(il_iinf,:) == dd_fill) ) 
    3027             il_iinf=il_iinf+1 
    3028          ENDDO 
    3029          DO WHILE( ALL(dd_lat0(:,il_jsup) == dd_fill) ) 
    3030             il_jsup=il_jsup-1 
    3031          ENDDO 
    3032          DO WHILE( ALL(dd_lat0(:,il_jinf) == dd_fill) ) 
    3033             il_jinf=il_jinf+1 
    3034          ENDDO 
     2931      ll_continue=.TRUE. 
     2932 
     2933      ! look for meridian 0°/360° 
     2934      il_jmid = il_jinf + INT(il_shape(2)/2) 
     2935      il_ind(:) = MAXLOC( dl_lon0(:,il_jmid), dl_lon0(:,il_jmid) <= 360._dp ) 
     2936 
     2937      il_imid=il_ind(1) 
     2938 
     2939      IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
     2940      &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN 
     2941 
     2942         il_iinf = il_imid ;  il_isup = il_imid 
     2943         il_jinf = il_jmid ;  il_jsup = il_jmid 
     2944 
     2945         ll_continue=.FALSE. 
     2946 
     2947      ELSE 
     2948         IF( dl_lon1 < dl_lon0(il_isup,il_jmid) .AND. & 
     2949         &   il_imid /= il_isup )THEN 
     2950 
     2951            ! point east 
     2952            il_iinf = il_imid 
     2953       
     2954         ELSE IF( dl_lon1 > dl_lon0(il_iinf,il_jmid) .AND. & 
     2955         &        il_imid /= il_iinf )THEN 
     2956 
     2957            ! point west 
     2958            il_isup = il_imid 
     2959 
     2960         ENDIF 
    30352961 
    30362962         il_shape(1)= il_isup - il_iinf + 1 
    30372963         il_shape(2)= il_jsup - il_jinf + 1 
    30382964 
    3039       ENDIF 
    3040  
    3041       ! special case for north ORCA grid 
    3042       IF( dd_lat1 > 19. .AND. dl_lon1 < 74.  )THEN 
    3043          ll_north=.TRUE. 
    3044       ENDIF 
    3045  
    3046       IF( .NOT. ll_north )THEN 
    3047          ! look for meridian 0°/360° 
     2965         il_imid = il_iinf + INT(il_shape(1)/2)  
    30482966         il_jmid = il_jinf + INT(il_shape(2)/2) 
    3049          il_ind(:) = MAXLOC( dl_lon0(il_iinf:il_isup,il_jmid), & 
    3050          &                   dl_lon0(il_iinf:il_isup,il_jmid) <= 360._dp ) 
    3051  
    3052          il_imid=il_ind(1) 
     2967 
     2968         ! exit if too close from north fold (safer) 
     2969         IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE. 
     2970 
     2971         ! exit when close enough of point 
     2972         IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE. 
     2973      ENDIF 
     2974 
     2975      ! 
     2976      DO WHILE( ll_continue .AND. .NOT. ll_north ) 
    30532977 
    30542978         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
    … …  
    30582982            il_jinf = il_jmid ;  il_jsup = il_jmid 
    30592983 
     2984            ll_continue=.FALSE. 
     2985 
    30602986         ELSE 
    3061             IF( ALL(dl_lon0(il_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. & 
    3062             &   il_imid /= il_isup )THEN 
    3063                ! 0 < lon1 < lon0(isup) 
     2987            IF( dl_lon1 > dl_lon0(il_imid,il_jmid) )THEN 
     2988 
    30642989               ! point east 
    3065                il_iinf = il_imid+1 
    3066                ll_continue=.TRUE. 
    3067           
    3068             ELSE IF( ALL(dl_lon0(il_iinf,il_jinf:il_jsup) <  dl_lon1 ) .AND. & 
    3069             &        il_imid /= il_iinf )THEN 
    3070                ! lon0(iinf) < lon1 < 360 
     2990               il_iinf = il_imid 
     2991         
     2992            ELSE IF(dl_lon1 < dl_lon0(il_imid,il_jmid) )THEN 
     2993 
    30712994               ! point west 
    30722995               il_isup = il_imid 
    3073                ll_continue=.TRUE. 
    30742996 
    30752997            ENDIF 
    30762998 
    3077             il_shape(1)= il_isup - il_iinf + 1 
    3078             il_shape(2)= il_jsup - il_jinf + 1 
    3079  
    3080             il_imid = il_iinf + INT(il_shape(1)/2)  
    3081             il_jmid = il_jinf + INT(il_shape(2)/2) 
    3082  
    3083             ! exit when close enough of point 
    3084             IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE. 
    3085          ENDIF 
    3086       ENDIF 
    3087  
    3088       ! 
    3089       DO WHILE( ll_continue .AND. .NOT. ll_north ) 
    3090  
    3091          ll_continue=.FALSE. 
    3092          IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
    3093          &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN 
    3094  
    3095             il_iinf = il_imid ;  il_isup = il_imid 
    3096             il_jinf = il_jmid ;  il_jsup = il_jmid 
    3097  
    3098          ELSE 
    3099             IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN     
    3100  
    3101                ! point east 
    3102                il_iinf = il_imid 
    3103                ll_continue=.TRUE. 
    3104          
    3105             ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN     
    3106  
    3107                ! point west 
    3108                il_isup = il_imid 
    3109                ll_continue=.TRUE. 
    3110  
    3111             ENDIF 
    3112  
    3113             IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN     
     2999            IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN 
    31143000                
    31153001               ! point north 
    31163002               il_jinf = il_jmid 
    3117                ll_continue=.TRUE. 
    3118  
    3119             ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN     
     3003 
     3004            ELSE IF(dd_lat1 < dd_lat0(il_imid,il_jmid) )THEN 
    31203005 
    31213006               ! point south 
    31223007               il_jsup = il_jmid 
    3123                ll_continue=.TRUE. 
    31243008             
    31253009            ENDIF 
    … …  
    31303014            il_imid = il_iinf + INT(il_shape(1)/2)  
    31313015            il_jmid = il_jinf + INT(il_shape(2)/2) 
     3016 
     3017            ! exit if too close from north fold (safer) 
     3018            IF( dd_lat0(il_imid,il_jmid) > 50.0 ) ll_north=.TRUE. 
    31323019 
    31333020            ! exit when close enough of point 
    … …  
    31623049   ! 
    31633050   !> @author J.Paul 
    3164    !> @date November, 2013 - Initial Version 
     3051   !> - November, 2013- Initial Version 
    31653052   ! 
    31663053   !> @param[in] dd_lon    grid longitude array 
    … …  
    31683055   !> @param[in] dd_lonA   longitude of point A 
    31693056   !> @param[in] dd_latA   latitude  of point A 
    3170    !> @param[in] dd_fill 
    31713057   !> @return array of distance between point A and grid points. 
    31723058   !------------------------------------------------------------------- 
    3173    FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA ) 
     3059   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) 
    31743060      IMPLICIT NONE 
    31753061      ! Argument       
    … …  
    32243110         DO ji=1,il_shape(1) 
    32253111            IF( dl_lon(ji,jj) == dl_lonA .AND. & 
    3226             &   dl_lat(ji,jj) == dl_latA )THEN 
     3112            &   dl_lat(ji,jj) == dl_laTA )THEN 
    32273113               grid_distance(ji,jj)=0.0 
    32283114            ELSE 
    32293115               dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + & 
    3230                &       COS(dl_latA)*COS(dl_lat(ji,jj)) * & 
    3231                &       COS(dl_lon(ji,jj)-dl_lonA) 
     3116               &       COS(dl_latA)*COS(dl_lat(ji,jj))*COS(dl_lon(ji,jj)-dl_lonA) 
    32323117               ! check to avoid mistake with ACOS 
    32333118               IF( dl_tmp < -1.0 ) dl_tmp = -1.0 
    … …  
    32513136   ! 
    32523137   !> @author J.Paul 
    3253    !> @date September, 2014 - Initial Version 
     3138   !> - September, 2014- Initial Version 
    32543139   !> @date October, 2014 
    32553140   !> - work on mpp file structure instead of file structure 
    … …  
    32853170 
    32863171      ! local variable 
    3287       INTEGER(i4)                              :: il_imin0 
    3288       INTEGER(i4)                              :: il_jmin0 
    3289       INTEGER(i4)                              :: il_imax0 
    3290       INTEGER(i4)                              :: il_jmax0 
    3291       INTEGER(i4)                              :: il_ind 
     3172      INTEGER(i4) :: il_imin0 
     3173      INTEGER(i4) :: il_jmin0 
     3174      INTEGER(i4) :: il_imax0 
     3175      INTEGER(i4) :: il_jmax0 
    32923176       
    3293       INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
     3177      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    32943178       
    3295       INTEGER(i4), DIMENSION(2,2)              :: il_xghost0 
    3296       INTEGER(i4), DIMENSION(2,2)              :: il_xghost1 
    3297  
    3298       CHARACTER(LEN= 1)                        :: cl_point 
    3299       CHARACTER(LEN=lc)                        :: cl_name 
     3179      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
     3180      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
     3181 
     3182      CHARACTER(LEN= 1) :: cl_point 
     3183      CHARACTER(LEN=lc) :: cl_name 
    33003184 
    33013185      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    … …  
    33043188      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
    33053189 
    3306       TYPE(TVAR)                               :: tl_lon0 
    3307       TYPE(TVAR)                               :: tl_lat0 
    3308       TYPE(TVAR)                               :: tl_lon1 
    3309       TYPE(TVAR)                               :: tl_lat1 
    3310  
    3311       TYPE(TMPP)                               :: tl_coord0 
    3312       TYPE(TMPP)                               :: tl_coord1 
     3190      TYPE(TVAR) :: tl_lon0 
     3191      TYPE(TVAR) :: tl_lat0 
     3192      TYPE(TVAR) :: tl_lon1 
     3193      TYPE(TVAR) :: tl_lat1 
     3194 
     3195      TYPE(TMPP) :: tl_coord0 
     3196      TYPE(TMPP) :: tl_coord1 
    33133197       
    33143198      ! loop indices 
    … …  
    33433227         ! read coarse longitue and latitude 
    33443228         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    3345          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    3346          IF( il_ind == 0 )THEN 
    3347             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3348             &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
    3349             &  try to use longitude.") 
    3350             WRITE(cl_name,*) 'longitude' 
    3351          ENDIF 
    33523229         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    3353  
    33543230         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    3355          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    3356          IF( il_ind == 0 )THEN 
    3357             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3358             &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
    3359             &  try to use latitude.") 
    3360             WRITE(cl_name,*) 'latitude' 
    3361          ENDIF 
    33623231         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    33633232          
    … …  
    33983267         ! read fine longitue and latitude 
    33993268         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    3400          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    3401          IF( il_ind == 0 )THEN 
    3402             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3403             &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
    3404             &  try to use longitude.") 
    3405             WRITE(cl_name,*) 'longitude' 
    3406          ENDIF 
    34073269         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    3408  
    34093270         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    3410          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    3411          IF( il_ind == 0 )THEN 
    3412             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3413             &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
    3414             &  try to use latitude.") 
    3415             WRITE(cl_name,*) 'latitude' 
    3416          ENDIF 
    34173271         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    34183272  
    … …  
    34643318   ! 
    34653319   !> @author J.Paul 
    3466    !> @date September, 2014 - Initial Version 
     3320   !> - September, 2014- Initial Version 
    34673321   !> @date October, 2014 
    34683322   !> - work on mpp file structure instead of file structure 
    … …  
    35003354 
    35013355      ! local variable 
    3502       INTEGER(i4)                              :: il_ind 
    3503       INTEGER(i4), DIMENSION(2,2)              :: il_xghost1 
    3504       INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
     3356      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    35053357       
    3506       CHARACTER(LEN= 1)                        :: cl_point 
    3507       CHARACTER(LEN=lc)                        :: cl_name 
     3358      INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
     3359 
     3360      CHARACTER(LEN= 1) :: cl_point 
     3361      CHARACTER(LEN=lc) :: cl_name 
    35083362 
    35093363      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
    35103364      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
    35113365 
    3512       TYPE(TVAR)                               :: tl_lon1 
    3513       TYPE(TVAR)                               :: tl_lat1 
    3514  
    3515       TYPE(TMPP)                               :: tl_coord1 
     3366      TYPE(TVAR) :: tl_lon1 
     3367      TYPE(TVAR) :: tl_lat1 
     3368 
     3369      TYPE(TMPP) :: tl_coord1 
    35163370      ! loop indices 
    35173371      !---------------------------------------------------------------- 
    … …  
    35433397         ! read fine longitue and latitude 
    35443398         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    3545          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    3546          IF( il_ind == 0 )THEN 
    3547             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3548             &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
    3549             &  try to use longitude.") 
    3550             WRITE(cl_name,*) 'longitude' 
    3551          ENDIF 
    35523399         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    3553  
    35543400         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    3555          il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name) 
    3556          IF( il_ind == 0 )THEN 
    3557             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3558             &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". & 
    3559             &  try to use latitude.") 
    3560             WRITE(cl_name,*) 'latitude' 
    3561          ENDIF 
    35623401         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    35633402  
    … …  
    36073446   ! 
    36083447   !> @author J.Paul 
    3609    !> @date September, 2014 - Initial Version 
     3448   !> - September, 2014- Initial Version 
    36103449   !> @date October, 2014 
    36113450   !> - work on mpp file structure instead of file structure 
    … …  
    36443483 
    36453484      ! local variable 
    3646       INTEGER(i4)                              :: il_imin0 
    3647       INTEGER(i4)                              :: il_jmin0 
    3648       INTEGER(i4)                              :: il_imax0 
    3649       INTEGER(i4)                              :: il_jmax0 
    3650       INTEGER(i4)                              :: il_ind 
     3485      INTEGER(i4) :: il_imin0 
     3486      INTEGER(i4) :: il_jmin0 
     3487      INTEGER(i4) :: il_imax0 
     3488      INTEGER(i4) :: il_jmax0 
    36513489       
    3652       INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
     3490      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
    36533491       
    3654       INTEGER(i4), DIMENSION(2,2)              :: il_xghost0 
    3655  
    3656       CHARACTER(LEN= 1)                        :: cl_point 
    3657       CHARACTER(LEN=lc)                        :: cl_name 
     3492      INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
     3493 
     3494      CHARACTER(LEN= 1) :: cl_point 
     3495      CHARACTER(LEN=lc) :: cl_name 
    36583496 
    36593497      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    36603498      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 
    36613499 
    3662       TYPE(TVAR)                               :: tl_lon0 
    3663       TYPE(TVAR)                               :: tl_lat0 
    3664  
    3665       TYPE(TMPP)                               :: tl_coord0 
     3500      TYPE(TVAR) :: tl_lon0 
     3501      TYPE(TVAR) :: tl_lat0 
     3502 
     3503      TYPE(TMPP) :: tl_coord0 
    36663504      ! loop indices 
    36673505      !---------------------------------------------------------------- 
    … …  
    36923530         ! read coarse longitue and latitude 
    36933531         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 
    3694          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    3695          IF( il_ind == 0 )THEN 
    3696             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3697             &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
    3698             &  try to use longitude.") 
    3699             WRITE(cl_name,*) 'longitude' 
    3700          ENDIF 
    37013532         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    3702  
    37033533         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 
    3704          il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name) 
    3705          IF( il_ind == 0 )THEN 
    3706             CALL logger_warn("GRID GET FINE OFFSET: no variable "//& 
    3707             &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". & 
    3708             &  try to use latitude.") 
    3709             WRITE(cl_name,*) 'latitude' 
    3710          ENDIF 
    37113534         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    37123535          
    … …  
    37623585   ! 
    37633586   !> @author J.Paul 
    3764    !> @date November, 2013 - Initial Version 
    3765    !> @date September, 2014  
    3766    !> - rename from grid_get_fine_offset 
    3767    !> @date May, 2015  
    3768    !> - improve way to find offset 
    3769    !> 
     3587   !> - November, 2013 - Initial Version 
     3588   !> @date September, 2014 - rename from grid_get_fine_offset 
     3589   ! 
    37703590   !> @param[in] dd_lon0   coarse grid longitude array  
    37713591   !> @param[in] dd_lat0   coarse grid latitude  array 
    … …  
    38003620 
    38013621      ! local variable 
    3802       INTEGER(i4), DIMENSION(2)                :: il_shape0 
    3803       INTEGER(i4), DIMENSION(2)                :: il_shape1 
    3804  
     3622      INTEGER(i4), DIMENSION(2) :: il_shape0 
     3623      INTEGER(i4), DIMENSION(2) :: il_shape1 
    38053624      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    38063625      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
    3807  
    3808       LOGICAL                                  :: ll_ii 
    3809       LOGICAL                                  :: ll_ij 
    38103626       
    38113627      ! loop indices 
    … …  
    38413657      grid__get_fine_offset_cc(:,:)=-1 
    38423658 
    3843       IF( il_shape1(jp_J) == 1 )THEN 
    3844            
    3845          grid__get_fine_offset_cc(jp_J,:)=((id_rho(jp_J)-1)/2) 
    3846  
    3847          ! work on i-direction 
    3848          ! look for i-direction left offset 
     3659      IF( il_shape1(1) > 1 )THEN 
     3660 
     3661         ! look for i-direction left offset  
    38493662         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 
    38503663            DO ji=1,id_rho(jp_I)+2 
    38513664               IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 
    3852                   grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji 
     3665                  grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji 
    38533666                  EXIT 
    38543667               ENDIF 
    … …  
    38583671            &                 " not match fine grid lower left corner.") 
    38593672         ENDIF 
     3673 
    38603674         ! look for i-direction right offset 
    3861          IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
     3675         IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
    38623676            DO ji=1,id_rho(jp_I)+2 
    3863                ii=il_shape1(jp_I)-ji+1 
     3677               ii=il_shape1(1)-ji+1 
    38643678               IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 
    3865                   grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji 
     3679                  grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji 
    38663680                  EXIT 
    38673681               ENDIF 
    … …  
    38723686         ENDIF 
    38733687 
    3874       ELSEIF( il_shape1(jp_I) == 1 )THEN 
    3875           
    3876          grid__get_fine_offset_cc(jp_I,:)=((id_rho(jp_I)-1)/2) 
    3877           
    3878          ! work on j-direction 
     3688      ELSE 
     3689         grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2) 
     3690      ENDIF 
     3691 
     3692      IF( il_shape1(2) > 1 )THEN 
    38793693 
    38803694         ! look for j-direction lower offset  
    … …  
    38823696            DO jj=1,id_rho(jp_J)+2 
    38833697               IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 
    3884                   grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj 
     3698                  grid__get_fine_offset_cc(2,1)=(id_rho(jp_J)+1)-jj 
    38853699                  EXIT 
    38863700               ENDIF 
    … …  
    38923706 
    38933707         ! look for j-direction upper offset  
    3894          IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
     3708         IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
    38953709            DO jj=1,id_rho(jp_J)+2 
    3896                ij=il_shape1(jp_J)-jj+1 
     3710               ij=il_shape1(2)-jj+1 
    38973711               IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 
    3898                   grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj 
     3712                  grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj 
    38993713                  EXIT 
    39003714               ENDIF 
    … …  
    39033717            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    39043718            &                 " not match fine grid upper right corner.") 
    3905          ENDIF          
    3906  
    3907       ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1  
    3908  
    3909          ! look for lower left offset 
    3910          IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0+1) )THEN 
    3911  
    3912             ii=1 
    3913             ij=1 
    3914             DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
    3915  
    3916                ll_ii=.FALSE. 
    3917                ll_ij=.FALSE. 
    3918  
    3919                IF( dl_lon1(ii,ij) >= dl_lon0(id_imin0+1,id_jmin0+1)-dp_delta .AND. & 
    3920                &   dd_lat1(ii,ij) >= dd_lat0(id_imin0+1,id_jmin0+1)-dp_delta )THEN 
    3921                   grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ii 
    3922                   grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-ij 
    3923                   EXIT 
    3924                ENDIF 
    3925  
    3926                IF( dl_lon1(ii+1,ij) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
    3927                &   dd_lat1(ii+1,ij) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
    3928                   ll_ii=.TRUE. 
    3929                ENDIF 
    3930                IF( dl_lon1(ii,ij+1) <= dl_lon0(id_imin0+1,id_jmin0+1)+dp_delta .AND. & 
    3931                &   dd_lat1(ii,ij+1) <= dd_lat0(id_imin0+1,id_jmin0+1)+dp_delta )THEN 
    3932                   ll_ij=.TRUE. 
    3933                ENDIF 
    3934  
    3935                IF( ll_ii ) ii=ii+1 
    3936                IF( ll_ij ) ij=ij+1 
    3937  
    3938             ENDDO 
    3939  
    3940          ELSE 
    3941             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3942             &                 " not match fine grid lower left corner.") 
    39433719         ENDIF 
    3944  
    3945          ! look for upper right offset 
    3946          IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > & 
    3947             & dl_lon0(id_imax0-1,id_jmax0-1) )THEN 
    3948  
    3949             ii=il_shape1(jp_I) 
    3950             ij=il_shape1(jp_J) 
    3951             DO ji=1,(id_rho(jp_I)+2)*(id_rho(jp_J)+2) 
    3952  
    3953                ll_ii=.FALSE. 
    3954                ll_ij=.FALSE. 
    3955  
    3956                IF( dl_lon1(ii,ij) <= dl_lon0(id_imax0-1,id_jmax0-1)+dp_delta .AND. & 
    3957                &   dd_lat1(ii,ij) <= dd_lat0(id_imax0-1,id_jmax0-1)+dp_delta )THEN 
    3958                   grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-(il_shape1(jp_I)+1-ii) 
    3959                   grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-(il_shape1(jp_J)+1-ij) 
    3960                   EXIT 
    3961                ENDIF 
    3962  
    3963                IF( dl_lon1(ii-1,ij) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
    3964                &   dd_lat1(ii-1,ij) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
    3965                   ll_ii=.TRUE. 
    3966                ENDIF 
    3967                IF( dl_lon1(ii,ij-1) >= dl_lon0(id_imax0-1,id_jmax0-1)-dp_delta .AND. & 
    3968                &   dd_lat1(ii,ij-1) >= dd_lat0(id_imax0-1,id_jmax0-1)-dp_delta )THEN 
    3969                   ll_ij=.TRUE. 
    3970                ENDIF 
    3971  
    3972                IF( ll_ii ) ii=ii-1 
    3973                IF( ll_ij ) ij=ij-1 
    3974  
    3975             ENDDO 
    3976  
    3977          ELSE 
    3978             CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    3979             &                 " not match fine grid upper right corner.") 
    3980          ENDIF 
    3981  
     3720      ELSE 
     3721         grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2) 
    39823722      ENDIF 
    39833723 
    … …  
    39923732   ! 
    39933733   !> @author J.Paul 
    3994    !> @date November, 2013- Initial Version 
     3734   !> - November, 2013- Initial Version 
    39953735   !> @date October, 2014 
    39963736   !> - work on mpp file structure instead of file structure 
    … …  
    40023742   !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain  
    40033743   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain   
    4004    !> @param[in] id_rho    array of refinement factor  
     3744   !> @param[in] id_rho    array of refinement factor (default 1)  
    40053745   !------------------------------------------------------------------- 
    40063746   SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, & 
    … …  
    43024042   !>  
    43034043   !> @author J.Paul 
    4304    !> @date November, 2013 - Initial Version 
     4044   !> - November, 2013- Initial Version 
    43054045   ! 
    43064046   !> @param[in] dd_lon0   array of coarse grid longitude 
    … …  
    43634103      dl_lon1 = dd_lon1(il_imin1, il_jmin1) 
    43644104      dl_lat1 = dd_lat1(il_imin1, il_jmin1) 
     4105 
    43654106 
    43664107      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. &  
    … …  
    44614202   ! 
    44624203   !> @author J.Paul 
    4463    !> @date November, 2013 - Initial Version 
     4204   !> - November, 2013- Initial Version 
    44644205   ! 
    44654206   !> @param[in] dd_lat0   array of coarse grid latitude  
    … …  
    45314272   !>  
    45324273   !> @author J.Paul 
    4533    !> @date November, 2013 - Initial version 
     4274   !> - November, 2013-Initial version 
    45344275   ! 
    45354276   !> @param[inout] td_var array of variable structure  
    … …  
    46074348   !>  
    46084349   !> @author J.Paul 
    4609    !> @date November, 2013 - Initial version 
     4350   !> - November, 2013-Initial version 
    46104351   ! 
    46114352   !> @param[inout] td_var array of variable structure  
    … …  
    46334374      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    46344375 
    4635          IF( ANY(id_ghost(:,:)/=0) )THEN 
    4636             CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//& 
    4637             &              TRIM(td_var%c_name) ) 
    4638          ENDIF 
     4376         CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//& 
     4377         &              TRIM(td_var%c_name) ) 
    46394378 
    46404379         ! copy variable 
    … …  
    46864425   !> 
    46874426   !> @author J.Paul 
    4688    !> @date September, 2014 - Initial Version 
     4427   !> - September, 2014- Initial Version 
    46894428   ! 
    46904429   !> @param[in] td_var variable sturcture  
    … …  
    48164555   !>  
    48174556   !> @author J.Paul 
    4818    !> @date September, 2014 - Initial Version 
     4557   !> - September, 2014 - Initial Version 
    48194558   !> @date October, 2014 
    48204559   !> - work on mpp file structure instead of file structure 
    … …  
    48534592          tl_mpp=mpp_copy(td_mpp) 
    48544593 
    4855           CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 
    48564594          IF( tl_mpp%i_perio < 0 )THEN 
    48574595             ! compute NEMO periodicity index 
    … …  
    48894627   !> 
    48904628   !> @author J.Paul 
    4891    !> @date November, 2013 - Initial Version 
     4629   !> - November, 2013- Initial Version 
    48924630   ! 
    48934631   !> @param[in] td_var    variable strucutre  
    … …  
    49564694                        il_tmp(jim:jip,jjm:jjp)=1 
    49574695                     END WHERE 
    4958  
    49594696                  ENDIF 
    49604697               ENDDO 
    … …  
    49834720   !> 
    49844721   !> @details 
    4985    !> the minimum size (number of point) of closed sea to be kept could be 
     4722   !> the minimum size (nbumber of point) of closed sea to be kept could be 
    49864723   !> sepcify with id_minsize. 
    49874724   !> By default only the biggest sea is preserve. 
    49884725   !> 
    49894726   !> @author J.Paul 
    4990    !> @date November, 2013 - Initial Version 
     4727   !> - November, 2013- Initial Version 
    49914728   !> 
    49924729   !> @param[inout] td_var    variable structure 
    … …  
    50454782 
    50464783   END SUBROUTINE grid_fill_small_dom 
    5047    !------------------------------------------------------------------- 
    5048    !> @brief This subroutine fill small domain inside bigger one.  
    5049    !> 
    5050    !> @details 
    5051    !> the minimum size (number of point) of domain sea to be kept could be 
    5052    !> is sepcified with id_minsize. 
    5053    !> smaller domain are included in the one they are embedded. 
    5054    !> 
    5055    !> @author J.Paul 
    5056    !> @date Ferbruay, 2015 - Initial Version 
    5057    !> 
    5058    !> @param[inout] id_mask      domain mask (from grid_split_domain) 
    5059    !> @param[in] id_minsize   minimum size of sea to be kept 
    5060    !------------------------------------------------------------------- 
    5061    SUBROUTINE grid_fill_small_msk(id_mask, id_minsize) 
    5062       IMPLICIT NONE 
    5063       ! Argument       
    5064       INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mask 
    5065       INTEGER(i4),                 INTENT(IN   ) :: id_minsize 
    5066  
    5067       ! local variable 
    5068       INTEGER(i4)                              :: il_ndom 
    5069       INTEGER(i4)                              :: il_minsize 
    5070       INTEGER(i4)                              :: il_msk 
    5071        
    5072       INTEGER(i4)                              :: jim 
    5073       INTEGER(i4)                              :: jjm 
    5074       INTEGER(i4)                              :: jip 
    5075       INTEGER(i4)                              :: jjp 
    5076  
    5077       INTEGER(i4), DIMENSION(2)                :: il_shape 
    5078       INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 
    5079  
    5080       ! loop indices 
    5081       INTEGER(i4) :: ii 
    5082       INTEGER(i4) :: ij 
    5083  
    5084       INTEGER(i4) :: ji 
    5085       INTEGER(i4) :: jj 
    5086       !---------------------------------------------------------------- 
    5087  
    5088       il_shape(:)=SHAPE(id_mask(:,:)) 
    5089       il_ndom=MINVAL(id_mask(:,:)) 
    5090  
    5091       ALLOCATE( il_tmp(il_shape(1),il_shape(2)) ) 
    5092       il_tmp(:,:)=0 
    5093       DO ji=-1,il_ndom,-1 
    5094          WHERE( id_mask(:,:)==ji )  
    5095             il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 
    5096          END WHERE 
    5097       ENDDO 
    5098  
    5099       DO WHILE( id_minsize > MINVAL(il_tmp(:,:)) ) 
    5100  
    5101          DO jj=1,il_shape(2) 
    5102             DO ji=1,il_shape(1) 
    5103  
    5104                IF( il_tmp(ji,jj) < il_minsize )THEN 
    5105                   jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1) 
    5106                   jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1) 
    5107                    
    5108                   il_msk=0 
    5109                   DO ij=jjm,jjp 
    5110                      DO ii=jim,jip 
    5111                         IF( id_mask(ii,ij) /= id_mask(ji,jj) )THEN 
    5112                            IF( il_msk == 0 )THEN 
    5113                               il_msk=id_mask(ii,ij) 
    5114                            ELSEIF( il_msk /= id_mask(ii,ij) )THEN 
    5115                               CALL logger_error("GRID FILL SMALL MSK: "//& 
    5116                               &  "small domain not embedded in bigger one"//& 
    5117                               &  ". point should be between two different"//& 
    5118                               &  " domain.") 
    5119                            ENDIF 
    5120                         ENDIF 
    5121                      ENDDO 
    5122                   ENDDO 
    5123                   IF( il_msk /= 0 ) id_mask(ji,jj)=il_msk 
    5124  
    5125                ENDIF 
    5126  
    5127             ENDDO 
    5128          ENDDO 
    5129  
    5130  
    5131          il_tmp(:,:)=0 
    5132          DO ji=-1,il_ndom,-1 
    5133             WHERE( id_mask(:,:)==ji )  
    5134                il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 
    5135             END WHERE 
    5136          ENDDO             
    5137  
    5138       ENDDO 
    5139  
    5140       DEALLOCATE( il_tmp ) 
    5141  
    5142  
    5143    END SUBROUTINE grid_fill_small_msk 
    51444784END MODULE grid 
    51454785 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp.f90

    r10248 r10251  
    2727!>    defining string character _cn\_varinfo_.<br/> 
    2828!>    Example: 
    29 !>       - cn_varinfo='varname1:int=cubic/rhoi', 'varname2:int=linear'  
     29!>       - cn_varinfo='varname1:cubic/rhoi', 'varname2:linear'  
    3030!> 
    3131!>    to create mixed grid (with coarse grid point needed to compute 
    … …  
    137137   !> 
    138138   !> @author J.Paul 
    139    !> @date November, 2013 - Initial Version 
     139   !> - November, 2013- Initial Version 
    140140   ! 
    141141   !> @param[in] cd_method interpolation method 
    … …  
    179179   !> 
    180180   !> @author J.Paul 
    181    !> @date November, 2013 - Initial Version 
     181   !> - November, 2013- Initial Version 
    182182   !> 
    183183   !> @param[in] td_mix mixed grid variable (to interpolate) 
    … …  
    244244   !> 
    245245   !> @author J.Paul 
    246    !> @date November, 2013 - Initial Version 
     246   !> - November, 2013- Initial Version 
    247247   ! 
    248248   !> @param[in] td_mix mixed grid variable (to interpolate) 
    … …  
    363363   !> 
    364364   !> @author J.Paul 
    365    !> @date November, 2013 - Initial Version 
     365   !> - November, 2013- Initial Version 
    366366   !> 
    367367   !> @param[in] td_var    coarse grid variable (should be extrapolated) 
    … …  
    449449   !> 
    450450   !> @author J.Paul 
    451    !> @date November, 2013 - Initial Version 
     451   !> - November, 2013- Initial Version 
    452452   !> 
    453453   !> @param[inout] td_mix mixed grid variable 
    … …  
    610610   !> 
    611611   !> @author J.Paul 
    612    !> @date November, 2013 - Initial Version 
     612   !> - November, 2013- Initial Version 
    613613   !> @date September, 2014 
    614614   !> - use offset to save useful domain 
    … …  
    716716   !> 
    717717   !> @author J.Paul 
    718    !> @date November, 2013 - Initial Version 
     718   !> - November, 2013- Initial Version 
    719719   !> 
    720720   !> @param[inout] td_var variable structure 
    … …  
    828828   !>  
    829829   !> @author J.Paul 
    830    !> @date November, 2013 - Initial Version 
     830   !> - November, 2013- Initial Version 
    831831   !> @date September, 2014 
    832832   !> - use interpolation method modules 
    … …  
    947947 
    948948      DEALLOCATE(il_detect) 
    949  
    950949      !4- save useful domain (remove offset) 
    951950      CALL interp_clean_mixed_grid( tl_mix, td_var, & 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90

    r10248 r10251  
    2626! REVISION HISTORY: 
    2727!> @date September, 2014 -Initial version 
    28 !> @date June, 2015 
    29 !> - use math module 
    3028!> 
    3129!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    3836   USE logger                          ! log file manager 
    3937   USE fct                             ! basic useful function 
    40    USE math                            ! mathematical function 
     38   USE extrap                          ! extrapolation manager 
    4139 
    4240   IMPLICIT NONE 
    … …  
    6361   !>  
    6462   !> @author J.Paul 
    65    !> @date September, 2014 - Initial Version 
    66    !> @date July, 2015  
    67    !> - reinitialise detect array for each level 
     63   !> - September, 2014- Initial Version 
    6864   !> 
    6965   !> @param[inout] dd_value  2D array of variable value  
    … …  
    8682 
    8783      ! local variable 
    88       INTEGER(i4), DIMENSION(4)                  :: il_shape 
    89  
    90       INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
    91  
    92       LOGICAL                                    :: ll_discont 
    93  
    94       REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ 
    95       REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I 
    96       REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J 
     84      INTEGER(i4), DIMENSION(4)                :: il_shape 
     85 
     86      LOGICAL                                  :: ll_discont 
     87 
     88      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ 
     89      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I 
     90      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J 
    9791       
    9892      ! loop indices 
    … …  
    119113      &                               id_rho(jp_J), ld_even(jp_J)) 
    120114 
    121       ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
    122  
    123115      DO jl=1,il_shape(4) 
    124          il_detect(:,:,:)=id_detect(:,:,:) 
    125116         ! loop on vertical level 
    126117         DO jk=1,il_shape(3) 
    … …  
    128119            ! I-J plan 
    129120            CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, & 
    130             &                     il_detect(:,:,jk),            & 
     121            &                     id_detect(:,:,jk),            & 
    131122            &                     dl_weight_IJ(:,:),            & 
    132123            &                     id_rho(jp_I), id_rho(jp_J),   & 
    133124            &                     ll_discont)             
    134             IF( ANY(il_detect(:,:,jk)==1) )THEN 
     125            IF( ANY(id_detect(:,:,jk)==1) )THEN 
    135126               ! I direction 
    136127               DO jj=1,il_shape(2) 
    137128                  CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, & 
    138                   &                      il_detect(:,jj,jk),            & 
     129                  &                      id_detect(:,jj,jk),            & 
    139130                  &                      dl_weight_I(:,:),              & 
    140131                  &                      id_rho(jp_I), ll_discont ) 
    141132               ENDDO 
    142                IF( ALL(il_detect(:,:,jk)==0) )THEN 
     133               IF( ALL(id_detect(:,:,jk)==0) )THEN 
    143134                  CYCLE 
    144135               ELSE 
    … …  
    146137                  DO ji=1,il_shape(1) 
    147138                     CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, & 
    148                      &                      il_detect(ji,:,jk),            & 
     139                     &                      id_detect(ji,:,jk),            & 
    149140                     &                      dl_weight_J(:,:),              & 
    150141                     &                      id_rho(jp_J), ll_discont ) 
    … …  
    156147      ENDDO 
    157148 
    158       id_detect(:,:,:)=il_detect(:,:,:) 
    159       DEALLOCATE(il_detect) 
    160  
    161149      DEALLOCATE(dl_weight_IJ) 
    162150      DEALLOCATE(dl_weight_I) 
    … …  
    171159   !> 
    172160   !> @author J.Paul 
    173    !> @date September, 2014 - Initial Version 
     161   !> - September, 2014- Initial Version 
    174162   !> 
    175163   !> @param[inout] dd_value  2D array of variable value  
    … …  
    193181      REAL(dp)                        , INTENT(IN   ) :: dd_fill  
    194182      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect 
    195       REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
     183      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight  
    196184      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi 
    197185      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj 
    … …  
    242230 
    243231         ! compute derivative on coarse grid 
    244          dl_dfdx(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont) 
    245          dl_dfdy(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont) 
     232         dl_dfdx(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont) 
     233         dl_dfdy(:,:)=extrap_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont) 
    246234 
    247235         ! compute cross derivative on coarse grid 
    248          dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont) 
     236         dl_d2fdxy(:,:)=extrap_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont) 
    249237 
    250238         ALLOCATE( dl_tmp(2,2) ) 
    … …  
    331319   !> 
    332320   !> @author J.Paul 
    333    !> @date September, 2014 - Initial Version 
     321   !> - September, 2014- Initial Version 
    334322   !> 
    335323   !> @param[inout] dd_value  1D array of variable value  
    … …  
    351339      REAL(dp)                        , INTENT(IN   ) :: dd_fill  
    352340      INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect 
    353       REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
     341      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight  
    354342      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi 
    355343      LOGICAL                         , INTENT(IN   ) :: ld_discont 
    … …  
    388376 
    389377         ! compute derivative on coarse grid 
    390          dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont) 
     378         dl_dfdx(:)=extrap_deriv_1D(dl_coarse(:), dd_fill, ld_discont) 
    391379 
    392380         ALLOCATE( dl_tmp(2) ) 
    … …  
    452440   !>  
    453441   !> @author J.Paul 
    454    !> @date September, 2014 - Initial Version 
     442   !> - September, 2014- Initial Version 
    455443   !> 
    456444   !> @param[in] dd_value  2D array of value 
    … …  
    515503   !>  
    516504   !> @author J.Paul 
    517    !> @date September, 2014 - Initial Version 
     505   !> - September, 2014- Initial Version 
    518506   !> 
    519507   !> @param[inout] dd_value  2D array of mixed grid value 
    … …  
    577565   !> 
    578566   !> @author J.Paul 
    579    !> @date September, 2014 - Initial Version 
     567   !> - September, 2014- Initial Version 
    580568   !> 
    581569   !> @param[in] dd_value  1D array of value 
    … …  
    620608   !>  
    621609   !> @author J.Paul 
    622    !> @date September, 2014 - Initial Version 
     610   !> - September, 2014- Initial Version 
    623611   !> 
    624612   !> @param[inout] dd_value  1D array of mixed grid value 
    … …  
    671659   !>  
    672660   !> @author J.Paul 
    673    !> @date September, 2014 - Initial Version 
     661   !> - September, 2014- Initial Version 
    674662   !> 
    675663   !> @param[in] dd_weight interpolation weight of 2D array 
    … …  
    752740   !>  
    753741   !> @author J.Paul 
    754    !> @date September, 2014 - Initial Version 
     742   !> - September, 2014- Initial Version 
    755743   !> 
    756744   !> @param[in] dd_weight interpolation weight of 1D array 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90

    r10248 r10251  
    2424!> J.Paul 
    2525! REVISION HISTORY: 
    26 !> @date September, 2014 - Initial version 
     26!> @date September, 2014 -Initial version 
    2727!> 
    2828!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6363   !> 
    6464   !> @author J.Paul 
    65    !> @date September, 2014 - Initial Version 
    66    !> @date July, 2015 - reinitialise detect array for each level 
     65   !> - September, 2014- Initial Version 
    6766   !> 
    6867   !> @param[inout] dd_value  2D array of variable value  
    … …  
    8584 
    8685      ! local variable 
    87       INTEGER(i4), DIMENSION(4)                  :: il_shape 
    88  
    89       INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
    90  
    91       LOGICAL                                    :: ll_discont 
    92   
    93       REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ 
    94       REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I 
    95       REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J 
     86      INTEGER(i4), DIMENSION(4)                :: il_shape 
     87 
     88      LOGICAL                                  :: ll_discont 
     89       
     90      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_IJ 
     91      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_I 
     92      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_weight_J 
    9693       
    9794      ! loop indices 
    … …  
    107104 
    108105      ! compute vect2D 
    109       ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) ) 
     106      ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) ) 
    110107      CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), & 
    111108      &                               id_rho(:), ld_even(:)) 
    112109 
    113       ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) ) 
    114       ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) ) 
     110      ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1)                 )) ) 
     111      ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) ) 
    115112      CALL interp_linear__get_weight1D(dl_weight_I(:,:), & 
    116113      &                               id_rho(jp_I), ld_even(jp_I)) 
    … …  
    118115      &                               id_rho(jp_J), ld_even(jp_J)) 
    119116 
    120       ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
    121  
    122117      DO jl=1,il_shape(4) 
    123          il_detect(:,:,:)=id_detect(:,:,:) 
    124118         ! loop on vertical level 
    125119         DO jk=1,il_shape(3) 
    … …  
    127121            ! I-J plan 
    128122            CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,& 
    129             &                     il_detect(:,:,jk),            & 
     123            &                     id_detect(:,:,jk),            & 
    130124            &                     dl_weight_IJ(:,:),            & 
    131125            &                     id_rho(jp_I), id_rho(jp_J),   & 
    132126            &                     ll_discont)             
    133             IF( ANY(il_detect(:,:,jk)==1) )THEN 
     127            IF( ANY(id_detect(:,:,jk)==1) )THEN 
    134128               ! I direction 
    135129               DO jj=1,il_shape(2) 
    136130                  CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,& 
    137                   &                       il_detect(:,jj,jk),           & 
     131                  &                       id_detect(:,jj,jk),           & 
    138132                  &                       dl_weight_I(:,:),             & 
    139133                  &                       id_rho(jp_I), ll_discont ) 
    140134               ENDDO 
    141                IF( ALL(il_detect(:,:,jk)==0) )THEN 
     135               IF( ALL(id_detect(:,:,jk)==0) )THEN 
    142136                  CYCLE 
    143137               ELSE 
    … …  
    145139                  DO ji=1,il_shape(1) 
    146140                     CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,& 
    147                      &                       il_detect(ji,:,jk),           & 
     141                     &                       id_detect(ji,:,jk),           & 
    148142                     &                       dl_weight_J(:,:),             & 
    149143                     &                       id_rho(jp_J), ll_discont ) 
    … …  
    155149      ENDDO 
    156150 
    157       id_detect(:,:,:)=il_detect(:,:,:) 
    158       DEALLOCATE(il_detect) 
    159  
    160151      DEALLOCATE(dl_weight_IJ) 
    161152      DEALLOCATE(dl_weight_I) 
    162153      DEALLOCATE(dl_weight_J) 
    163   
     154       
    164155   END SUBROUTINE interp_linear_fill 
    165156   !------------------------------------------------------------------- 
    … …  
    170161   !> 
    171162   !> @author J.Paul 
    172    !> @date September, 2014 - Initial Version 
     163   !> - September, 2014- Initial Version 
    173164   !> 
    174165   !> @param[inout] dd_value  2D array of variable value  
    … …  
    244235               IF( ALL(id_detect(ji:ji+id_rhoi,   & 
    245236               &                 jj:jj+id_rhoj)==0) ) CYCLE 
    246                ! check data needed to interpolate 
     237               ! check data to needed to interpolate 
    247238               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE 
    248239               ! check longitude discontinuity 
    … …  
    305296   !> 
    306297   !> @author J.Paul 
    307    !> @date September, 2014 - Initial Version 
     298   !> - September, 2014- Initial Version 
    308299   !> 
    309300   !> @param[inout] dd_value  1D array of variable value  
    … …  
    417408   !>  
    418409   !> @author J.Paul 
    419    !> @date September, 2014 - Initial Version 
     410   !> - September, 2014- Initial Version 
    420411   !> 
    421412   !> @param[in] dd_value  2D array of value 
    … …  
    454445   !>  
    455446   !> @author J.Paul 
    456    !> @date September, 2014 - Initial Version 
    457    !> 
     447   !> - September, 2014- Initial Version 
     448   !>  
    458449   !> @param[inout] dd_value  2D array of mixed grid value 
    459450   !> @param[inout] id_detect 2D array of point to be interpolated 
    … …  
    486477      !---------------------------------------------------------------- 
    487478 
    488       IF( ANY( dd_coef(:)==dd_fill ) )THEN 
    489          CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//& 
    490          &              "can not compute interpolation.") 
    491       ELSE 
    492  
    493          ii=0 
    494          DO jj=1,id_rhoj+1 
    495             DO ji=1,id_rhoi+1 
    496  
    497                ii=ii+1 
    498                IF(id_detect(ji,jj)==1)THEN 
    499  
    500                   dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii)) 
    501                   id_detect(ji,jj)=0 
    502  
    503                ENDIF 
    504  
     479         IF( ANY( dd_coef(:)==dd_fill ) )THEN 
     480            CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//& 
     481            &              "can not compute interpolation.") 
     482         ELSE 
     483 
     484            ii=0 
     485            DO jj=1,id_rhoj+1 
     486               DO ji=1,id_rhoi+1 
     487 
     488                  ii=ii+1 
     489                  IF(id_detect(ji,jj)==1)THEN 
     490 
     491                     dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii)) 
     492                     id_detect(ji,jj)=0 
     493 
     494                  ENDIF 
     495 
     496               ENDDO 
    505497            ENDDO 
    506          ENDDO 
    507  
    508       ENDIF 
     498 
     499         ENDIF 
    509500 
    510501   END SUBROUTINE interp_linear__2D_fill 
    … …  
    514505   !>  
    515506   !> @author J.Paul 
    516    !> @date September, 2014 - Initial Version 
     507   !> - September, 2014- Initial Version 
    517508   !> 
    518509   !> @param[in] dd_value  1D array of value 
    … …  
    549540   !>  
    550541   !> @author J.Paul 
    551    !> @date September, 2014 - Initial Version 
     542   !> - September, 2014- Initial Version 
    552543   !>  
    553544   !> @param[inout] dd_value  1D array of mixed grid value 
    … …  
    600591   !>  
    601592   !> @author J.Paul 
    602    !> @date September, 2014 - Initial Version 
     593   !> - September, 2014- Initial Version 
    603594   !> 
    604595   !> @param[in] dd_weight interpolation weight of 2D array 
    … …  
    669660   !>  
    670661   !> @author J.Paul 
    671    !> @date September, 2014 - Initial Version 
     662   !> - September, 2014- Initial Version 
    672663   !> 
    673664   !> @param[in] dd_weight interpolation weight of 1D array 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90

    r10248 r10251  
    2424!> J.Paul 
    2525! REVISION HISTORY: 
    26 !> @date September, 2014 - Initial version 
     26!> @date September, 2014 -Initial version 
    2727!> 
    2828!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5555   !>  
    5656   !> @author J.Paul 
    57    !> @date September, 2014 - Initial Version 
     57   !> - September, 2014- Initial Version 
    5858   !> 
    5959   !> @param[inout] dd_value  2D array of variable value  
    … …  
    6969 
    7070      ! local variable 
    71       INTEGER(i4), DIMENSION(4)                  :: il_shape 
    72  
    73       INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
     71      INTEGER(i4), DIMENSION(4)                :: il_shape 
    7472 
    7573      ! loop indices 
    … …  
    8280      il_shape(:)=SHAPE(dd_value) 
    8381 
    84       ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
    8582      DO jl=1,il_shape(4) 
    86          il_detect(:,:,:)=id_detect(:,:,:) 
    8783         ! loop on vertical level 
    8884         DO jk=1,il_shape(3) 
    … …  
    9086            ! I-J plan 
    9187            CALL interp_nearest__2D(dd_value(:,:,jk,jl),& 
    92             &                       il_detect(:,:,jk),  & 
     88            &                       id_detect(:,:,jk),  & 
    9389            &                       id_rho(jp_I), id_rho(jp_J) )             
    94             IF( ANY(il_detect(:,:,jk)==1) )THEN 
     90            IF( ANY(id_detect(:,:,jk)==1) )THEN 
    9591               ! I direction 
    9692               DO jj=1,il_shape(2) 
    9793                  CALL interp_nearest__1D( dd_value(:,jj,jk,jl),& 
    98                   &                        il_detect(:,jj,jk),  & 
     94                  &                        id_detect(:,jj,jk),  & 
    9995                  &                        id_rho(jp_I) ) 
    10096               ENDDO 
    101                IF( ALL(il_detect(:,:,jk)==0) )THEN 
     97               IF( ALL(id_detect(:,:,jk)==0) )THEN 
    10298                  CYCLE 
    10399               ELSE 
    … …  
    105101                  DO ji=1,il_shape(1) 
    106102                     CALL interp_nearest__1D( dd_value(ji,:,jk,jl),& 
    107                      &                        il_detect(ji,:,jk),  & 
     103                     &                        id_detect(ji,:,jk),  & 
    108104                     &                        id_rho(jp_J) ) 
    109105                  ENDDO 
    … …  
    114110      ENDDO 
    115111 
    116       id_detect(:,:,:)=il_detect(:,:,:) 
    117       DEALLOCATE(il_detect) 
    118  
    119112   END SUBROUTINE interp_nearest_fill 
    120113   !------------------------------------------------------------------- 
    … …  
    123116   !>  
    124117   !> @author J.Paul 
    125    !> @date September, 2014 - Initial Version 
     118   !> - September, 2014- Initial Version 
    126119   !> 
    127120   !> @param[inout] dd_value  2D array of variable value  
    … …  
    178171   !>  
    179172   !> @author J.Paul 
    180    !> @date September, 2014 - Initial Version 
     173   !> - September, 2014- Initial Version 
    181174   !> 
    182175   !> @param[inout] dd_value  1D array of variable value  
    … …  
    223216   !>  
    224217   !> @author J.Paul 
    225    !> @date September, 2014 - Initial Version 
     218   !> - September, 2014- Initial Version 
    226219   !> 
    227220   !> @param[inout] dd_value  2D array of mixed grid value 
    … …  
    307300   !>  
    308301   !> @author J.Paul 
    309    !> @date September, 2014 - Initial Version 
     302   !> - September, 2014- Initial Version 
    310303   !> 
    311304   !> @param[inout] dd_value  1D array of mixed grid value 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom.f90

    r10248 r10251  
    156156   !> 
    157157   !> @author J.Paul 
    158    !> @date November, 2013 - Initial Version 
     158   !> - November, 2013- Initial Version 
    159159   ! 
    160160   !> @param[inout] td_file file structure 
    … …  
    186186   !>  
    187187   !> @author J.Paul 
    188    !> @date November, 2013 - Initial Version 
     188   !> - November, 2013- Initial Version 
    189189   ! 
    190190   !> @param[inout] td_file file structure 
    … …  
    223223   !> 
    224224   !> @author J.Paul 
    225    !> @date November, 2013 - Initial Version 
     225   !> - November, 2013- Initial Version 
    226226   ! 
    227227   !> @param[inout] td_file file structure 
    … …  
    252252   ! 
    253253   !> @author J.Paul 
    254    !> @date November, 2013 - Initial Version 
     254   !> - November, 2013- Initial Version 
    255255   ! 
    256256   !> @param[in] td_file      file structure 
    … …  
    300300   !> 
    301301   !> @author J.Paul 
    302    !> @date November, 2013 - Initial Version 
     302   !> - November, 2013- Initial Version 
    303303   ! 
    304304   !> @param[in] td_file   file structure 
    … …  
    338338   ! 
    339339   !> @author J.Paul 
    340    !> @date November, 2013 - Initial Version 
     340   !> - November, 2013- Initial Version 
    341341   ! 
    342342   !> @param[in] td_file      file structure 
    … …  
    386386   ! 
    387387   !> @author J.Paul 
    388    !> @date November, 2013 - Initial Version 
     388   !> - November, 2013- Initial Version 
    389389   ! 
    390390   !> @param[in] td_file      file structure 
    … …  
    422422   ! 
    423423   !> @author J.Paul 
    424    !> @date November, 2013 - Initial Version 
     424   !> - November, 2013- Initial Version 
    425425   ! 
    426426   !> @param[in] td_file   file structure 
    … …  
    452452   ! 
    453453   !> @author J.Paul 
    454    !> @date November, 2013 - Initial Version 
     454   !> - November, 2013- Initial Version 
    455455   ! 
    456456   !> @param[in] td_file   file structure 
    … …  
    485485   ! 
    486486   !> @author J.Paul 
    487    !> @date November, 2013 - Initial Version 
     487   !> - November, 2013- Initial Version 
    488488   ! 
    489489   !> @param[in] td_file   file structure 
    … …  
    529529   ! 
    530530   !> @author J.Paul 
    531    !> @date November, 2013 - Initial Version 
     531   !> - November, 2013- Initial Version 
    532532   ! 
    533533   !> @param[in] td_file   file structure 
    … …  
    564564   !------------------------------------------------------------------- 
    565565   !> @brief This subroutine write file structure in an opened file. 
    566    !> 
    567    !> @details 
    568    !> optionally, you could specify dimension order (default 'xyzt') 
    569    !> 
    570    !> @author J.Paul 
    571    !> @date November, 2013 - Initial Version 
    572    !> @date July, 2015 - add dimension order option 
     566   ! 
     567   !> @author J.Paul 
     568   !> - November, 2013- Initial Version 
    573569   ! 
    574570   !> @param[in] td_file   file structure 
    575571   !------------------------------------------------------------------- 
    576    SUBROUTINE iom_write_file(td_file, cd_dimorder) 
    577       IMPLICIT NONE 
    578       ! Argument       
    579       TYPE(TFILE)     , INTENT(INOUT) :: td_file 
    580       CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder 
    581       !---------------------------------------------------------------- 
    582  
    583       ! open file 
    584       SELECT CASE(TRIM(td_file%c_type)) 
    585          CASE('cdf') 
    586             CALL iom_cdf_write_file(td_file, cd_dimorder) 
    587          CASE('dimg') 
    588             ! note: can not change dimension order in restart dimg file 
     572   SUBROUTINE iom_write_file(td_file) 
     573      IMPLICIT NONE 
     574      ! Argument       
     575      TYPE(TFILE), INTENT(INOUT) :: td_file 
     576      !---------------------------------------------------------------- 
     577 
     578      ! open file 
     579      SELECT CASE(TRIM(td_file%c_type)) 
     580         CASE('cdf') 
     581            CALL iom_cdf_write_file(td_file) 
     582         CASE('dimg') 
    589583            CALL iom_rstdimg_write_file(td_file) 
    590584         CASE DEFAULT 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90

    r10248 r10251  
    144144   !> 
    145145   !> @author J.Paul 
    146    !> @date November, 2013 - Initial Version 
    147    !> @date May, 2015 - add optional message to netcdf error message 
    148    !> 
     146   !> - November, 2013- Initial Version 
     147   ! 
    149148   !> @param[in] id_status error status 
    150    !> @param[in] cd_msg    message 
    151    !------------------------------------------------------------------- 
    152    SUBROUTINE iom_cdf__check(id_status, cd_msg) 
    153       IMPLICIT NONE 
    154       ! Argument       
    155       INTEGER(i4)     , INTENT(IN)           :: id_status 
    156       CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_msg 
    157       ! local variable 
    158       CHARACTER(LEN=lc) :: cl_msg 
    159       !---------------------------------------------------------------- 
    160  
    161       cl_msg="" 
    162       IF( PRESENT(cd_msg) ) cl_msg=cd_msg 
     149   !------------------------------------------------------------------- 
     150   SUBROUTINE iom_cdf__check(id_status) 
     151      IMPLICIT NONE 
     152      ! Argument       
     153      INTEGER(i4), INTENT(IN) :: id_status 
     154      !---------------------------------------------------------------- 
    163155 
    164156      IF( id_status /= NF90_NOERR )THEN 
    165          CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status))) 
     157         CALL logger_error(TRIM(NF90_STRERROR(id_status))) 
    166158      ENDIF 
    167159 
    … …  
    181173   !> 
    182174   !> @author J.Paul 
    183    !> @date November, 2013 - Initial Version 
     175   !> - November, 2013- Initial Version 
    184176   ! 
    185177   !> @param[inout] td_file   file structure 
    … …  
    211203            CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) ) 
    212204 
    213             il_status = NF90_CREATE(TRIM(td_file%c_name),& 
    214             &                       cmode=NF90_64BIT_OFFSET,& 
    215             &                       ncid=td_file%i_id) 
    216          !NF90_WRITE,               & 
    217             CALL iom_cdf__check(il_status," IOM CDF CREATE: ") 
     205            il_status = NF90_CREATE( TRIM(td_file%c_name),& 
     206            &                        NF90_WRITE,               & 
     207            &                        td_file%i_id) 
     208            CALL iom_cdf__check(il_status) 
    218209 
    219210            td_file%l_def=.TRUE. 
    … …  
    237228               &                      NF90_NOWRITE,         & 
    238229               &                      td_file%i_id) 
    239                CALL iom_cdf__check(il_status," IOM CDF OPEN: ") 
    240  
    241                CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//& 
    242                   &  TRIM(fct_str(td_file%i_id))) 
     230               CALL iom_cdf__check(il_status) 
     231 
     232               CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//TRIM(fct_str(td_file%i_id))) 
    243233            ELSE 
    244234 
    … …  
    249239               &                      NF90_WRITE,           & 
    250240               &                      td_file%i_id) 
    251                CALL iom_cdf__check(il_status,"IOM CDF OPEN: ") 
     241               CALL iom_cdf__check(il_status) 
    252242 
    253243            ENDIF 
    … …  
    277267   !> 
    278268   !> @author J.Paul 
    279    !> @date November, 2013 - Initial Version 
     269   !> - November, 2013- Initial Version 
    280270   ! 
    281271   !> @param[inout] td_file   file structure 
    … …  
    301291 
    302292         il_status = NF90_CLOSE(td_file%i_id) 
    303          CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ") 
     293         CALL iom_cdf__check(il_status) 
    304294 
    305295         td_file%i_id = 0 
    … …  
    317307   !> 
    318308   !> @author J.Paul 
    319    !> @date November, 2013 - Initial Version 
     309   !> - November, 2013- Initial Version 
    320310   ! 
    321311   !> @param[inout] td_file   file structure 
    … …  
    336326      il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, & 
    337327      &     td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt) 
    338       CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ") 
     328      CALL iom_cdf__check(il_status) 
    339329 
    340330      SELECT CASE(il_fmt) 
    … …  
    355345   ! 
    356346   !> @author J.Paul 
    357    !> @date November, 2013 - Initial Version 
     347   !> - November, 2013- Initial Version 
    358348   ! 
    359349   !> @param[inout] td_file   file structure 
    … …  
    406396   ! 
    407397   !> @author J.Paul 
    408    !> @date November, 2013 - Initial Version 
     398   !> - November, 2013- Initial Version 
    409399   !> @date September, 2014 
    410400   !> - use attribute periodicity read from the file if present. 
    … …  
    449439   ! 
    450440   !> @author J.Paul 
    451    !> @date November, 2013 - Initial Version 
     441   !> - November, 2013- Initial Version 
    452442   ! 
    453443   !> @param[inout] td_file   file structure 
    … …  
    490480 
    491481            ! look for depth id 
    492             IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'depth')/=0 )THEN 
     482            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'depth') /= 0 )THEN 
    493483               IF( td_file%i_depthid == 0 )THEN 
    494484                  td_file%i_depthid=ji 
    495485               ELSE 
    496486                  IF( td_file%i_depthid /= ji )THEN 
    497                      CALL logger_error("IOM CDF GET FILE VAR: find more"//& 
    498                         &  " than one depth variable in file "//& 
    499                         &  TRIM(td_file%c_name) ) 
     487                     CALL logger_error("IOM CDF GET FILE VAR: find more than one "//& 
     488                     &                 "depth variable in file "//& 
     489                     &                 TRIM(td_file%c_name) ) 
    500490                  ENDIF 
    501491               ENDIF 
    … …  
    503493 
    504494            ! look for time id 
    505             IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN 
     495            IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'time') /= 0 )THEN 
    506496               IF( td_file%i_timeid == 0 )THEN 
    507497                  td_file%i_timeid=ji 
    … …  
    514504                     td_file%i_timeid=ji 
    515505                  !ELSE 
    516                   !   CALL logger_error("IOM CDF GET FILE VAR: find more "//& 
    517                   !   &                 "than one time variable in file "//& 
     506                  !   print *,'error' 
     507                  !   CALL logger_error("IOM OPEN: find more than one "//& 
     508                  !   &                 "time variable in file "//& 
    518509                  !   &                 TRIM(td_file%c_name) ) 
    519510                  ENDIF 
    … …  
    535526   ! 
    536527   !> @author J.Paul 
    537    !> @date November, 2013 - Initial Version 
     528   !> - November, 2013- Initial Version 
    538529   ! 
    539530   !> @param[inout] td_file   file structure 
    … …  
    576567   ! 
    577568   !> @author J.Paul 
    578    !> @date November, 2013 - Initial Version 
    579    !> @date February, 2015 - create unused dimension, when reading dimension 
    580    !> of length less or equal to zero 
     569   !> - November, 2013- Initial Version 
    581570   ! 
    582571   !> @param[in] td_file   file structure 
    … …  
    594583      INTEGER(i4)       :: il_len 
    595584      CHARACTER(LEN=lc) :: cl_name 
    596       LOGICAL           :: ll_use 
    597585      !---------------------------------------------------------------- 
    598586 
    … …  
    613601         il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, & 
    614602         &                                cl_name, il_len ) 
    615          CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ") 
    616  
    617          ll_use=.TRUE. 
    618          IF( il_len <= 0 )THEN 
    619             CALL logger_warn( & 
    620          &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//& 
    621          &  " in file "//TRIM(td_file%c_name)//" is less or equel to zero") 
    622             il_len=1 
    623             ll_use=.FALSE. 
    624          ENDIF 
    625          iom_cdf__read_dim_id=dim_init(cl_name, il_len, ld_use=ll_use) 
     603         CALL iom_cdf__check(il_status) 
     604 
     605         iom_cdf__read_dim_id=dim_init(cl_name, il_len) 
    626606 
    627607      ENDIF 
    … …  
    633613   ! 
    634614   !> @author J.Paul 
    635    !> @date November, 2013 - Initial Version 
     615   !> - November, 2013- Initial Version 
    636616   ! 
    637617   !> @param[in] td_file   file structure 
    … …  
    654634 
    655635         CALL logger_error( & 
    656          &  " IOM CDF READ DIM: no id associated to file "//& 
    657          &  TRIM(td_file%c_name)) 
     636         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name)) 
    658637 
    659638      ELSE       
    … …  
    661640         il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), & 
    662641         &                         il_dimid) 
    663          CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ") 
     642         CALL iom_cdf__check(il_status) 
    664643 
    665644         iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid) 
    … …  
    673652   ! 
    674653   !> @author J.Paul 
    675    !> @date November, 2013 - Initial Version 
     654   !> - November, 2013- Initial Version 
    676655   ! 
    677656   !> @param[in] td_file   file structure 
    … …  
    735714         &                                il_len, & 
    736715         &                                il_attid ) 
    737          CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ") 
     716         CALL iom_cdf__check(il_status) 
    738717 
    739718         !! get attribute value 
    740          CALL logger_debug( " IOM CDF READ ATT: get attribute "//& 
    741             &            TRIM(cl_name)//" in file "//TRIM(td_file%c_name)) 
     719         CALL logger_debug( " IOM CDF READ ATT: get attribute "//TRIM(cl_name)//& 
     720         &               " in file "//TRIM(td_file%c_name)) 
    742721 
    743722         SELECT CASE( il_type ) 
    … …  
    749728 
    750729                  CALL logger_error( & 
    751                   &  " IOM CDF READ ATT: not enough space to put "//& 
    752                   &  "attribute "//TRIM(cl_name) ) 
     730                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
     731                  &  TRIM(cl_name) ) 
    753732 
    754733               ELSE 
    … …  
    758737                  &                      cl_name, & 
    759738                  &                      cl_value ) 
    760                   CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ") 
     739                  CALL iom_cdf__check(il_status) 
    761740 
    762741                  iom_cdf__read_att_name=att_init(cl_name, cl_value) 
    … …  
    779758                  &                      cl_name, & 
    780759                  &                      bl_value(:)) 
    781                   CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
     760                  CALL iom_cdf__check(il_status)    
    782761 
    783762                  iom_cdf__read_att_name=att_init(cl_name, bl_value(:)) 
    … …  
    794773 
    795774                  CALL logger_error( & 
    796                   &  " IOM CDF READ ATT: not enough space to put "//& 
    797                   &  "attribute "//TRIM(cl_name) ) 
     775                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
     776                  &  TRIM(cl_name) ) 
    798777 
    799778               ELSE 
    … …  
    803782                  &                      cl_name, & 
    804783                  &                      sl_value(:)) 
    805                   CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
     784                  CALL iom_cdf__check(il_status)    
    806785 
    807786                  iom_cdf__read_att_name=att_init(cl_name, sl_value(:)) 
    … …  
    818797 
    819798                  CALL logger_error( & 
    820                   &  " IOM CDF READ ATT: not enough space to put "//& 
    821                   &  "attribute "//TRIM(cl_name) ) 
     799                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
     800                  &  TRIM(cl_name) ) 
    822801 
    823802               ELSE 
    … …  
    827806                  &                      cl_name, & 
    828807                  &                      il_value(:)) 
    829                   CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
     808                  CALL iom_cdf__check(il_status)    
    830809 
    831810                  iom_cdf__read_att_name=att_init(cl_name, il_value(:)) 
    … …  
    841820 
    842821                  CALL logger_error( & 
    843                   &  " IOM CDF READ ATT: not enough space to put "//& 
    844                   &  "attribute "//TRIM(cl_name) ) 
     822                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
     823                  &  TRIM(cl_name) ) 
    845824 
    846825               ELSE 
    … …  
    850829                  &                      cl_name, & 
    851830                  &                      fl_value(:)) 
    852                   CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
     831                  CALL iom_cdf__check(il_status)    
    853832 
    854833                  iom_cdf__read_att_name=att_init(cl_name, fl_value(:)) 
    … …  
    865844 
    866845                  CALL logger_error( & 
    867                   &  " IOM CDF READ ATT: not enough space to put "//& 
    868                   &  "attribute "//TRIM(cl_name) ) 
     846                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
     847                  &  TRIM(cl_name) ) 
    869848 
    870849               ELSE 
    … …  
    874853                  &                      cl_name, & 
    875854                  &                      dl_value(:)) 
    876                   CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
     855                  CALL iom_cdf__check(il_status)    
    877856 
    878857                  iom_cdf__read_att_name=att_init(cl_name, dl_value(:)) 
    … …  
    894873   ! 
    895874   !> @author J.Paul 
    896    !> @date November, 2013 - Initial Version 
     875   !> - November, 2013- Initial Version 
    897876   ! 
    898877   !> @param[in] td_file   file structure 
    … …  
    923902         ! get attribute name 
    924903         il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name) 
    925          CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ") 
     904         CALL iom_cdf__check(il_status) 
    926905 
    927906         ! read attribute 
    … …  
    939918   ! 
    940919   !> @author J.Paul 
    941    !> @date November, 2013 - Initial Version 
     920   !> - November, 2013- Initial Version 
    942921   ! 
    943922   !> @param[in] td_file   file structure 
    … …  
    997976   ! 
    998977   !> @author J.Paul 
    999    !> @date November, 2013 - Initial Version 
     978   !> - November, 2013- Initial Version 
    1000979   ! 
    1001980   !> @param[in] td_file   file structure 
    … …  
    10641043   ! 
    10651044   !> @author J.Paul 
    1066    !> @date November, 2013 - Initial Version 
     1045   !> - November, 2013- Initial Version 
    10671046   ! 
    10681047   !> @param[inout] td_file   file structure 
    … …  
    11061085   ! 
    11071086   !> @author J.Paul 
    1108    !> @date November, 2013 - Initial Version 
     1087   !> - November, 2013- Initial Version 
    11091088   ! 
    11101089   !> @param[inout] td_file   file structure 
    … …  
    11691148   ! 
    11701149   !> @author J.Paul 
    1171    !> @date November, 2013 - Initial Version 
     1150   !> - November, 2013- Initial Version 
    11721151   ! 
    11731152   !> @param[inout] td_file   file structure 
    … …  
    12201199   ! 
    12211200   !> @author J.Paul 
    1222    !> @date November, 2013 - Initial Version 
     1201   !> - November, 2013- Initial Version 
    12231202   !> @date September, 2014 
    12241203   !> - force to use FillValue=1.e20 if no FillValue for coordinate variable. 
    … …  
    12611240 
    12621241         ! inquire variable 
    1263          CALL logger_debug( & 
     1242         CALL logger_trace( & 
    12641243         &  " IOM CDF READ VAR META: inquire variable "//& 
    12651244         &  TRIM(fct_str(id_varid))//& 
    … …  
    12741253         &                                il_dimid(:),& 
    12751254         &                                il_natt ) 
    1276          CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ") 
     1255         CALL iom_cdf__check(il_status) 
    12771256         !!! fill variable dimension structure 
    12781257         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) ) 
    1279  
    12801258         IF( il_natt /= 0 )THEN 
    12811259            ALLOCATE( tl_att(il_natt) ) 
    … …  
    12981276               ELSE 
    12991277                  ! create attribute _FillValue 
    1300                   SELECT CASE(TRIM(fct_lower(cl_name))) 
     1278                  SELECT CASE(TRIM(cl_name)) 
    13011279                     CASE DEFAULT 
    13021280                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
    13031281                        &                "zero for variable "//TRIM(cl_name) ) 
    13041282                        tl_fill=att_init('_FillValue',0.) 
    1305                      CASE('nav_lon','nav_lat', 'nav_lev', & 
     1283                     CASE('nav_lon','nav_lat', & 
    13061284                        &  'glamt','glamu','glamv','glamf', & 
    13071285                        &  'gphit','gphiu','gphiv','gphif') 
    … …  
    13331311            ALLOCATE(tl_att(il_natt+1) ) 
    13341312            ! create attribute _FillValue 
    1335             SELECT CASE(TRIM(fct_lower(cl_name))) 
     1313            SELECT CASE(TRIM(cl_name)) 
    13361314               CASE DEFAULT 
    13371315                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
    … …  
    13751353   ! 
    13761354   !> @author J.Paul 
    1377    !> @date November, 2013 - Initial Version 
    1378    !> @date July, 2015  
    1379    !> - Bug fix: use order to disorder table (see dim_init) 
    1380    !> 
     1355   !> - November, 2013- Initial Version 
     1356   ! 
    13811357   !> @param[in] td_file   file structure 
    13821358   !> @param[in] id_ndim   number of dimension 
    … …  
    13951371 
    13961372      ! local variable 
    1397       INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2 
     1373      INTEGER(i4), DIMENSION(ip_maxdim) :: il_2xyzt 
    13981374 
    13991375      TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 
    … …  
    14191395 
    14201396         DO ji = 1, id_ndim 
    1421             CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//& 
    1422                &  "dimension "//TRIM(fct_str(ji)) ) 
    1423  
    1424             il_xyzt2(ji)=td_file%t_dim(id_dimid(ji))%i_xyzt2 
     1397            CALL logger_trace( " IOM CDF READ VAR DIM: get variable dimension "//& 
     1398            &               TRIM(fct_str(ji)) ) 
     1399 
     1400            il_2xyzt(ji)=td_file%t_dim(id_dimid(ji))%i_2xyzt 
    14251401 
    14261402            ! read dimension information 
    1427             tl_dim(ji) = dim_init( td_file%t_dim(il_xyzt2(ji))%c_name, & 
    1428             &                      td_file%t_dim(il_xyzt2(ji))%i_len ) 
     1403            tl_dim(ji) = dim_init( td_file%t_dim(il_2xyzt(ji))%c_name, & 
     1404            &                      td_file%t_dim(il_2xyzt(ji))%i_len ) 
    14291405         ENDDO 
    14301406 
    14311407         ! reorder dimension to ('x','y','z','t') 
    14321408         CALL dim_reorder(tl_dim(:)) 
    1433   
     1409       
    14341410         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:)) 
    14351411 
    … …  
    14501426   ! 
    14511427   !> @author J.Paul 
    1452    !> @date November, 2013 - Initial Version 
     1428   !> - November, 2013- Initial Version 
    14531429   ! 
    14541430   !> @param[in] td_file   file structure 
    … …  
    14991475   ! 
    15001476   !> @author J.Paul 
    1501    !> @date November, 2013 - Initial Version 
    1502    !> @date June, 2015  
    1503    !> - use scale factor and offset, as soon as read variable value 
     1477   !> - November, 2013- Initial Version 
    15041478   ! 
    15051479   !> @param[in] td_file   file structure 
    … …  
    15081482   !> @param[in] id_count  number of indices selected along each dimension 
    15091483   !> @return variable structure completed  
     1484   ! 
     1485   !> @todo 
     1486   !> - warning do not change fill value when use scale factor.. 
    15101487   !------------------------------------------------------------------- 
    15111488   SUBROUTINE iom_cdf__read_var_value(td_file, td_var, & 
    … …  
    15191496 
    15201497      ! local variable 
    1521       INTEGER(i4)                                    :: il_status 
    1522       INTEGER(i4)                                    :: il_tmp1 
    1523       INTEGER(i4)                                    :: il_tmp2 
    1524       INTEGER(i4)                                    :: il_varid 
    1525       INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start 
    1526       INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count 
    1527       INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start_ord 
    1528       INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count_ord 
    1529  
     1498      INTEGER(i4)                       :: il_status 
     1499      INTEGER(i4)                       :: il_tmp1 
     1500      INTEGER(i4)                       :: il_tmp2 
     1501      INTEGER(i4)                       :: il_varid 
     1502      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
     1503      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 
     1504      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start_ord 
     1505      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count_ord 
    15301506      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value 
    15311507      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp 
    … …  
    15421518         IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. & 
    15431519             ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN 
    1544             CALL logger_warn( "IOM CDF READ VAR VALUE: id_start and id_count"//& 
    1545                & " should be both specify") 
     1520            CALL logger_warn( & 
     1521            &  "IOM CDF READ VAR VALUE: id_start and id_count should be both specify") 
    15461522         ENDIF 
    15471523         IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN 
    … …  
    15491525            IF( SIZE(id_start(:)) /= ip_maxdim .OR. & 
    15501526            &   SIZE(id_count(:)) /= ip_maxdim )THEN 
    1551                CALL logger_error("IOM CDF READ VAR: dimension of array start"//& 
    1552                   &  " or count are invalid to read variable "//& 
    1553                   &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name) ) 
     1527               CALL logger_error("IOM CDF READ VAR: dimension of array start or count "//& 
     1528               &      " are invalid to read variable "//TRIM(td_var%c_name)//& 
     1529               &      " in file "//TRIM(td_file%c_name) ) 
    15541530            ENDIF 
    15551531 
    … …  
    15881564            &    td_var%t_dim( 4 )%i_len & 
    15891565            &                                            /)) )THEN 
     1566 
     1567            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//& 
     1568            &  "variable dimension for "//TRIM(td_var%c_name) ) 
    15901569 
    15911570            DO ji = 1, ip_maxdim 
    … …  
    15961575               &  TRIM(fct_str(il_tmp2))) 
    15971576            ENDDO 
    1598             CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//& 
    1599             &  "variable dimension for "//TRIM(td_var%c_name) ) 
    16001577 
    16011578         ELSE 
    16021579 
    1603             ! Allocate space to hold variable value (disorder) 
     1580            ! Allocate space to hold variable value (unorder) 
    16041581            ALLOCATE(dl_value( il_count(1), & 
    16051582               &               il_count(2), & 
    … …  
    16241601            &                                       start = il_start(:),& 
    16251602            &                                       count = il_count(:) ) 
    1626             CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ") 
     1603            CALL iom_cdf__check(il_status) 
    16271604 
    16281605            ! Allocate space to hold variable value in structure 
    … …  
    16861663               CALL var_chg_FillValue(td_var) 
    16871664            ENDIF 
    1688  
    1689             ! use scale factor and offset 
    1690             WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
    1691                td_var%d_value(:,:,:,:) = & 
    1692                &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs 
    1693             END WHERE 
    1694  
    16951665         ENDIF 
    16961666      ELSE 
    … …  
    17031673   !------------------------------------------------------------------- 
    17041674   !> @brief This subroutine write file structure in an opened netcdf file. 
    1705    !> 
    1706    !> @details 
    1707    !> optionally, you could specify dimension order (default 'xyzt') 
    1708    !> 
    1709    !> @author J.Paul 
    1710    !> @date November, 2013 - Initial Version 
    1711    !> @date July, 2015  
    1712    !> - add dimension order option  
     1675   ! 
     1676   !> @author J.Paul 
     1677   !> - November, 2013- Initial Version 
    17131678   ! 
    17141679   !> @param[inout] td_file   file structure 
    17151680   !------------------------------------------------------------------- 
    1716    SUBROUTINE iom_cdf_write_file(td_file, cd_dimorder) 
    1717       IMPLICIT NONE 
    1718       ! Argument       
    1719       TYPE(TFILE)     , INTENT(INOUT) :: td_file 
    1720       CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder 
     1681   SUBROUTINE iom_cdf_write_file(td_file) 
     1682      IMPLICIT NONE 
     1683      ! Argument       
     1684      TYPE(TFILE), INTENT(INOUT) :: td_file 
    17211685 
    17221686      ! local variable 
    17231687      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value 
    1724  
    1725       CHARACTER(LEN=lc)                      :: cl_dimorder 
    17261688 
    17271689      TYPE(TVAR)                             :: tl_var 
    … …  
    17321694      INTEGER(i4) :: ji 
    17331695      INTEGER(i4) :: jj 
    1734       INTEGER(i4) :: jvar 
    1735       !---------------------------------------------------------------- 
    1736  
    1737       cl_dimorder='xyzt' 
    1738       IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder) 
     1696      !---------------------------------------------------------------- 
    17391697 
    17401698      ! check if file opened 
    … …  
    17681726            ENDIF 
    17691727 
    1770             ! change dimension order 
    1771             IF( TRIM(cl_dimorder) /= 'xyzt' )THEN 
    1772                CALL dim_reorder(td_file%t_dim(:),TRIM(cl_dimorder)) 
    1773                DO jvar=1,td_file%i_nvar 
    1774                   CALL logger_debug("VAR REORDER: "//TRIM(td_file%t_var(jvar)%c_name)) 
    1775                   CALL var_reorder(td_file%t_var(jvar),TRIM(cl_dimorder)) 
    1776                ENDDO 
    1777             ENDIF 
    1778  
    17791728            ! write dimension in file 
    17801729            DO ji = 1, ip_maxdim 
    … …  
    18271776   ! 
    18281777   !> @author J.Paul 
    1829    !> @date November, 2013 - Initial Version 
     1778   !> - November, 2013- Initial Version 
    18301779   ! 
    18311780   !> @param[inout] td_file   file structure 
    … …  
    18491798         ! Enter define mode 
    18501799         il_status=NF90_REDEF(td_file%i_id) 
    1851          CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ") 
     1800         CALL iom_cdf__check(il_status) 
    18521801 
    18531802         td_file%l_def=.TRUE. 
    … …  
    18641813            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), & 
    18651814            &                      NF90_UNLIMITED, td_dim%i_id) 
    1866             CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ") 
     1815            CALL iom_cdf__check(il_status) 
    18671816 
    18681817         ELSE 
    18691818            ! write not unlimited dimension 
    1870             CALL logger_debug( & 
     1819            CALL logger_trace( & 
    18711820            &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//& 
    18721821            &  " in file "//TRIM(td_file%c_name)) 
    … …  
    18741823            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), & 
    18751824            &                      td_dim%i_len, td_dim%i_id) 
    1876             CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ") 
     1825            CALL iom_cdf__check(il_status) 
    18771826 
    18781827         ENDIF 
    … …  
    18851834   ! 
    18861835   !> @author J.Paul 
    1887    !> @date November, 2013 - Initial Version 
     1836   !> - November, 2013- Initial Version 
    18881837   ! 
    18891838   !> @param[inout] td_file   file structure 
    … …  
    19101859         ! Enter define mode 
    19111860         il_status=NF90_REDEF(td_file%i_id) 
    1912          CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ") 
     1861         CALL iom_cdf__check(il_status) 
    19131862 
    19141863         td_file%l_def=.TRUE. 
    … …  
    19271876            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, & 
    19281877            &  td_att%c_name, td_att%c_value ) 
    1929             CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ") 
     1878            CALL iom_cdf__check(il_status) 
    19301879 
    19311880         CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE) 
    … …  
    19331882            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, & 
    19341883            &  td_att%c_name, td_att%d_value ) 
    1935             CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ") 
     1884            CALL iom_cdf__check(il_status) 
    19361885 
    19371886      END SELECT 
    … …  
    19421891   ! 
    19431892   !> @author J.Paul 
    1944    !> @date November, 2013 - Initial Version 
     1893   !> - November, 2013- Initial Version 
    19451894   ! 
    19461895   !> @param[inout] td_file   file structure 
    … …  
    19681917         ! Enter define mode 
    19691918         il_status=NF90_REDEF(td_file%i_id) 
    1970          CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ") 
     1919         CALL iom_cdf__check(il_status) 
    19711920 
    19721921         td_file%l_def=.TRUE. 
    19731922 
    19741923      ENDIF 
    1975   
     1924       
    19761925      ! check if file and variable dimension conform 
    19771926      IF( file_check_var_dim(td_file, td_var) )THEN 
    … …  
    19891938            ENDIF 
    19901939         ENDDO 
    1991          ! ugly patch until NEMO do not force to use 0. as FillValue  
    19921940         IF( ll_chg )THEN 
    19931941            ! not a dimension variable 
    19941942            ! change FillValue 
    1995             SELECT CASE( TRIM(fct_lower(td_var%c_name)) ) 
    1996                CASE DEFAULT 
    1997                   CALL var_chg_FillValue(td_var,0._dp) 
    1998                CASE('nav_lon','nav_lat', & 
    1999                   & 'glamt','glamu','glamv','glamf', & 
    2000                   & 'gphit','gphiu','gphiv','gphif') 
    2001             END SELECT 
     1943 
     1944            ! ugly patch until NEMO do not force to use 0. as FillValue  
     1945            CALL var_chg_FillValue(td_var,0._dp) 
    20021946         ENDIF 
    20031947 
    … …  
    20131957            ! Leave define mode 
    20141958            il_status=NF90_ENDDEF(td_file%i_id) 
    2015             CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ") 
     1959            CALL iom_cdf__check(il_status) 
    20161960 
    20171961            td_file%l_def=.FALSE. 
    … …  
    20311975   ! 
    20321976   !> @author J.Paul 
    2033    !> @date November, 2013 - Initial Version 
     1977   !> - November, 2013- Initial Version 
    20341978   ! 
    20351979   !> @param[in] td_file   file structure 
    … …  
    20582002      tl_var=var_copy(td_var) 
    20592003 
    2060       ! forced to use float type 
    2061       IF( tl_var%d_unf /= 1. .AND. tl_var%i_type==NF90_SHORT )THEN 
    2062          tl_var%i_type=NF90_FLOAT 
    2063       ENDIF 
    2064  
    20652004      IF( ALL( .NOT. tl_var%t_dim(:)%l_use ) )THEN 
    2066          CALL logger_debug( & 
    2067          &  "IOM CDF WRITE VAR DEF scalar: define variable "//& 
    2068          &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    20692005         ! scalar value 
    20702006         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name), & 
    20712007         &                        tl_var%i_type, varid=iom_cdf__write_var_def)  
    2072          CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
     2008         CALL iom_cdf__check(il_status) 
    20732009      ELSE 
    20742010 
    … …  
    20842020         ENDDO 
    20852021 
    2086          CALL logger_debug( & 
     2022         CALL logger_trace( & 
    20872023         &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//& 
    20882024         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    20892025 
    20902026         DO ji=1,jj 
    2091             CALL logger_debug("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) ) 
     2027            CALL logger_trace("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) ) 
    20922028         ENDDO 
    2093  
    20942029         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name),     & 
    20952030         &                        tl_var%i_type,                         & 
    20962031         &                        il_dimid(1:jj),                        & 
    20972032         &                        varid=iom_cdf__write_var_def           ) 
    2098          CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
     2033         CALL iom_cdf__check(il_status) 
    20992034      ENDIF 
    21002035 
    … …  
    21082043 
    21092044      DO ji = 1, tl_var%i_natt 
    2110          CALL logger_debug( & 
     2045         CALL logger_trace( & 
    21112046         &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(tl_var%t_att(ji)%c_name)//& 
    21122047         &  " for variable "//TRIM(tl_var%c_name)//& 
    21132048         &  " in file "//TRIM(td_file%c_name) ) 
    2114  
    2115          ! forced FillValue to have same type than variable 
    2116          IF( TRIM(tl_var%t_att(ji)%c_name) == '_FillValue' )THEN 
    2117             tl_var%t_att(ji)%i_type=tl_var%i_type 
    2118          ENDIF 
    21192049 
    21202050         IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN 
    … …  
    21232053               &                        TRIM(tl_var%t_att(ji)%c_name),        & 
    21242054               &                        TRIM(tl_var%t_att(ji)%c_value)        ) 
    2125                CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
     2055               CALL iom_cdf__check(il_status) 
    21262056            ENDIF 
    21272057         ELSE 
    … …  
    21522082                  &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    21532083                  &                        REAL(tl_var%t_att(ji)%d_value(:),dp)) 
    2154             END SELECT 
    2155             CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
     2084               END SELECT 
     2085            CALL iom_cdf__check(il_status) 
    21562086         ENDIF 
    21572087      ENDDO 
    … …  
    21672097   ! 
    21682098   !> @author J.Paul 
    2169    !> @date November, 2013 - Initial Version 
    2170    !> @date June, 2015 
    2171    !> - reuse scale factor and offset, before writing variable 
     2099   !> - November, 2013- Initial Version 
    21722100   ! 
    21732101   !> @param[in] td_file   file structure 
    … …  
    21942122      &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//& 
    21952123      &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    2196     
    2197       ! use scale factor and offset 
    2198       WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
    2199          td_var%d_value(:,:,:,:) = & 
    2200          &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf 
    2201       END WHERE 
    2202        
     2124 
    22032125      jj=0 
    22042126      DO ji = 1, ip_maxdim 
    … …  
    22312153 
    22322154      il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:)) 
    2233       CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ") 
     2155      CALL iom_cdf__check(il_status) 
    22342156 
    22352157      DEALLOCATE( dl_value ) 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_dom.f90

    r10248 r10251  
    7171   !> 
    7272   !> @author J.Paul 
    73    !> @date October, 2014 - Initial Version 
     73   !> - October, 2014- Initial Version 
    7474   ! 
    7575   !> @param[inout] td_mpp mpp structure 
    … …  
    106106   !> 
    107107   !> @author J.Paul 
    108    !> @date October, 2014 - Initial Version 
     108   !> - October, 2014- Initial Version 
    109109   ! 
    110110   !> @param[in] td_mpp mpp structure 
    … …  
    130130   !> 
    131131   !> @author J.Paul 
    132    !> @date October, 2014 - Initial Version 
     132   !> - October, 2014- Initial Version 
    133133   !> 
    134134   !> @param[in] td_mpp    mpp structure 
    … …  
    194194   ! 
    195195   !> @author J.Paul 
    196    !> @date October, 2014 - Initial Version 
     196   !> - October, 2014- Initial Version 
    197197   ! 
    198198   !> @param[in] td_mpp    mpp structure 
    … …  
    246246   !> 
    247247   !> @author J.Paul 
    248    !> @date October, 2014 - Initial Version 
     248   !> - October, 2014- Initial Version 
    249249   !> 
    250250   !> @todo 
    … …  
    411411   !> 
    412412   !> @author J.Paul 
    413    !> @date October, 2014 - Initial Version 
     413   !> - October, 2014- Initial Version 
    414414   ! 
    415415   !> @param[in] td_mpp    mpp structure 
    … …  
    465465   !> 
    466466   !> @author J.Paul 
    467    !> @date October, 2014 - Initial Version 
     467   !> - October, 2014- Initial Version 
    468468   !> 
    469469   !> @param[in] td_mpp    mpp structure 
    … …  
    524524   !> 
    525525   !> @author J.Paul 
    526    !> @date October, 2014 - Initial Version 
     526   !> - October, 2014- Initial Version 
    527527   !> 
    528528   !> @param[in] td_mpp    mpp structure 
    … …  
    636636   !> 
    637637   !> @author J.Paul 
    638    !> @date October, 2014 - Initial Version 
     638   !> - October, 2014- Initial Version 
    639639   ! 
    640640   !> @param[in] td_mpp    mpp structure 
    … …  
    663663   !> 
    664664   !> @author J.Paul 
    665    !> @date October, 2014 - Initial Version 
     665   !> - October, 2014- Initial Version 
    666666   ! 
    667667   !> @param[in] td_mpp    mpp structure 
    … …  
    691691   !> 
    692692   !> @author J.Paul 
    693    !> @date October, 2014 - Initial Version 
     693   !> - October, 2014- Initial Version 
    694694   ! 
    695695   !> @param[in] td_mpp    mpp structure 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90

    r10248 r10251  
    8787!> J.Paul 
    8888! REVISION HISTORY: 
    89 !> @date November, 2013 - Initial Version 
     89!> @date Nov, 2013 - Initial Version 
    9090!> 
    9191!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    137137   !> 
    138138   !> @author J.Paul 
    139    !> @date November, 2013 - Initial Version 
     139   !> - November, 2013- Initial Version 
    140140   ! 
    141141   !> @param[inout] td_mpp mpp structure 
    … …  
    161161 
    162162      ELSE 
    163          !  
    164          td_mpp%i_id=1 
    165  
    166163         ! if no processor file selected 
    167164         ! force to open all files  
    … …  
    224221   !>  
    225222   !> @author J.Paul 
    226    !> @date November, 2013 - Initial Version 
     223   !> - November, 2013- Initial Version 
    227224   ! 
    228225   !> @param[inout] td_mpp mpp structure 
    … …  
    251248   !> 
    252249   !> @author J.Paul 
    253    !> @date November, 2013 - Initial Version 
     250   !> - November, 2013- Initial Version 
    254251   ! 
    255252   !> @param[in] td_mpp mpp structure 
    … …  
    270267 
    271268      ELSE 
    272          !  
    273          td_mpp%i_id=0          
    274  
    275269         DO ji=1,td_mpp%i_nproc 
    276270            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
    … …  
    291285   !> 
    292286   !> @author J.Paul 
    293    !> @date November, 2013 - Initial Version 
     287   !> - November, 2013- Initial Version 
    294288   !> @date October, 2014 
    295289   !> - use start and count array instead of domain structure. 
    … …  
    320314         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    321315 
    322       ELSEIF( td_mpp%i_id == 0 )THEN 
    323  
    324          CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 
    325          &               " can not read variable in "//TRIM(td_mpp%c_name))    
    326        
    327316      ELSE 
    328  
    329317 
    330318         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN 
    … …  
    367355   ! 
    368356   !> @author J.Paul 
    369    !> @date November, 2013 - Initial Version 
     357   !> - November, 2013- Initial Version 
    370358   !> @date October, 2014 
    371359   !> - use start and count array instead of domain structure. 
    … …  
    396384         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    397385 
    398       ELSEIF( td_mpp%i_id == 0 )THEN 
    399  
    400          CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 
    401          &               " can not read variable in "//TRIM(td_mpp%c_name))    
    402        
    403386      ELSE 
    404387 
    … …  
    417400               CALL logger_error( & 
    418401               &  " IOM MPP READ VAR: there is no variable with "//& 
    419                &  "name or standard name "//TRIM(cd_name)//& 
     402               &  "name or standard name"//TRIM(cd_name)//& 
    420403               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    421404            ENDIF 
    … …  
    433416   ! 
    434417   !> @author J.Paul 
    435    !> @date November, 2013 - Initial Version 
     418   !> - November, 2013- Initial Version 
    436419   !> @date October, 2014 
    437420   !> - use start and count array instead of domain structure. 
    … …  
    484467      IF( PRESENT(id_count) ) il_count(:)=id_count(:) 
    485468 
    486       CALL logger_debug("IOM MPP READ VAR VALUE: start "//& 
    487                &  TRIM(fct_str(il_start(jp_I)))//","//& 
    488                &  TRIM(fct_str(il_start(jp_J)))//","//& 
    489                &  TRIM(fct_str(il_start(jp_K)))//","//& 
    490                &  TRIM(fct_str(il_start(jp_L))) ) 
    491       CALL logger_debug("IOM MPP READ VAR VALUE: count "//& 
    492                &  TRIM(fct_str(il_count(jp_I)))//","//& 
    493                &  TRIM(fct_str(il_count(jp_J)))//","//& 
    494                &  TRIM(fct_str(il_count(jp_K)))//","//& 
    495                &  TRIM(fct_str(il_count(jp_L))) ) 
    496  
    497469      DO jk=1,ip_maxdim 
    498470         IF( .NOT. td_var%t_dim(jk)%l_use )THEN 
    … …  
    504476      ENDDO 
    505477 
     478 
    506479      IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN 
    507             CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//& 
    508                &  TRIM(fct_str(il_end(jp_I)))//","//& 
    509                &  TRIM(fct_str(il_end(jp_J)))//","//& 
    510                &  TRIM(fct_str(il_end(jp_K)))//","//& 
    511                &  TRIM(fct_str(il_end(jp_L))) ) 
    512             CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//& 
    513                &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//& 
    514                &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//& 
    515                &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//& 
    516                &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) ) 
    517480            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//& 
    518481            &                 "exceed dimension bound.") 
    … …  
    620583   ! 
    621584   !> @details 
    622    !> optionally, you could specify the dimension order (default 'xyzt') 
    623585   ! 
    624586   !> @author J.Paul 
    625    !> @date November, 2013 - Initial Version 
    626    !> @date July, 2015 - add dimension order option  
     587   !> - November, 2013- Initial Version 
    627588   ! 
    628589   !> @param[inout] td_mpp mpp structure 
    629    !> @param[In] cd_dimorder dimension order 
    630    !------------------------------------------------------------------- 
    631    SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder) 
     590   !------------------------------------------------------------------- 
     591   SUBROUTINE iom_mpp_write_file(td_mpp) 
    632592      IMPLICIT NONE 
    633593      ! Argument       
    634       TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
    635       CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder 
     594      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
    636595 
    637596      ! local variable 
    … …  
    651610               !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 
    652611 
    653                CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
     612               CALL iom_write_file(td_mpp%t_proc(ji)) 
    654613            ELSE 
    655614               CALL logger_debug( " MPP WRITE: no id associated to file "//& 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90

    r10248 r10251  
    131131   !> 
    132132   !> @author J.Paul 
    133    !> @date November, 2013 - Initial Version 
     133   !> - November, 2013- Initial Version 
    134134   ! 
    135135   !> @param[inout] td_file   file structure 
    … …  
    284284   !> 
    285285   !> @author J.Paul 
    286    !> @date November, 2013 - Initial Version 
     286   !> - November, 2013- Initial Version 
    287287   ! 
    288288   !> @param[inout] td_file   file structure 
    … …  
    328328   !> 
    329329   !> @author J.Paul 
    330    !> @date November, 2013 - Initial Version 
     330   !> - November, 2013- Initial Version 
    331331   ! 
    332332   !> @param[inout] td_file   file structure 
    … …  
    394394   !> 
    395395   !> @author J.Paul 
    396    !> @date November, 2013 - Initial Version 
     396   !> - November, 2013- Initial Version 
    397397   ! 
    398398   !> @param[inout] td_file   file structure 
    … …  
    544544   ! 
    545545   !> @author J.Paul 
    546    !> @date November, 2013 - Initial Version 
     546   !> - November, 2013- Initial Version 
    547547   ! 
    548548   !> @param[inout] td_file   file structure 
    … …  
    636636   ! 
    637637   !> @author J.Paul 
    638    !> @date November, 2013 - Initial Version 
     638   !> - November, 2013- Initial Version 
    639639   ! 
    640640   !> @param[inout] td_file   file structure 
    … …  
    688688   ! 
    689689   !> @author J.Paul 
    690    !> @date November, 2013 - Initial Version 
     690   !> - November, 2013- Initial Version 
    691691   ! 
    692692   !> @param[inout] td_file   file structure 
    … …  
    733733   ! 
    734734   !> @author J.Paul 
    735    !> @date November, 2013 - Initial Version 
     735   !> - November, 2013- Initial Version 
    736736   ! 
    737737   !> @param[inout] td_file   file structure 
    … …  
    778778   ! 
    779779   !> @author J.Paul 
    780    !> @date November, 2013 - Initial Version 
     780   !> - November, 2013- Initial Version 
    781781   ! 
    782782   !> @param[inout] td_file   file structure 
    … …  
    820820   ! 
    821821   !> @author J.Paul 
    822    !> @date November, 2013 - Initial Version 
     822   !> - Nov, 2013- Initial Version 
    823823   ! 
    824824   !> @param[in] td_file   file structure 
    … …  
    863863   ! 
    864864   !> @author J.Paul 
    865    !> @date November, 2013 - Initial Version 
     865   !> - Nov, 2013- Initial Version 
    866866   ! 
    867867   !> @param[in] td_file   file structure 
    … …  
    907907   ! 
    908908   !> @author J.Paul 
    909    !> @date November, 2013 - Initial Version 
     909   !> - November, 2013- Initial Version 
    910910   ! 
    911911   !> @param[in] td_file   file structure 
    … …  
    972972   ! 
    973973   !> @author J.Paul 
    974    !> @date November, 2013 - Initial Version 
     974   !> - November, 2013- Initial Version 
    975975   ! 
    976976   !> @param[in] td_file   file structure 
    … …  
    10371037   !> 
    10381038   !> @author J.Paul 
    1039    !> @date November, 2013 - Initial Version 
     1039   !> - November, 2013- Initial Version 
    10401040   ! 
    10411041   !> @param[in] td_file   file structure 
    … …  
    10581058      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start 
    10591059      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count 
    1060  
    10611060      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    10621061 
    … …  
    12051204      ENDIF 
    12061205 
    1207       ! force to change _FillValue to avoid mistake  
    1208       ! with dummy zero _FillValue 
    1209       IF( td_var%d_fill == 0._dp )THEN 
    1210          CALL var_chg_FillValue(td_var) 
    1211       ENDIF 
    1212  
    1213       ! use scale factor and offset 
    1214       WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
    1215          td_var%d_value(:,:,:,:) = & 
    1216          &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs 
    1217       END WHERE 
    1218  
    12191206   END SUBROUTINE iom_rstdimg__read_var_value 
    12201207   !------------------------------------------------------------------- 
    … …  
    12251212   !> 
    12261213   !> @author J.Paul 
    1227    !> @date November, 2013 - Initial Version 
     1214   !> - November, 2013- Initial Version 
    12281215   !> @date September, 2014 
    12291216   !> - use iom_rstdimg__get_rec 
    … …  
    13211308   !> 
    13221309   !> @author J.Paul 
    1323    !> @date September, 2014 - Initial Version 
     1310   !> - September, 2014- Initial Version 
    13241311   ! 
    13251312   !> @param[inout] td_file   file structure 
    … …  
    14261413   ! 
    14271414   !> @author J.Paul 
    1428    !> @date November, 2013 - Initial Version 
     1415   !> - November, 2013- Initial Version 
    14291416   ! 
    14301417   !> @param[inout] td_file   file structure 
    … …  
    16431630   !> 
    16441631   !> @author J.Paul 
    1645    !> @date November, 2013 - Initial Version 
    1646    !> @date July, 2015 
    1647    !> - bug fix: do not use scale factor an offset for case no0d, no1d... 
     1632   !> - November, 2013- Initial Version 
    16481633   !> 
    1649    !> @param[in] td_file file structure 
     1634   !> @param[in] id_fileid file id 
    16501635   !------------------------------------------------------------------- 
    16511636   SUBROUTINE iom_rstdimg__write_var(td_file) 
    … …  
    16821667            CASE('no0d','no1d','no2d','no3d') 
    16831668            CASE DEFAULT 
    1684                 
    1685                ! use scale factor and offset 
    1686                WHERE( td_file%t_var(ji)%d_value(:,:,:,:) /= & 
    1687                &      td_file%t_var(ji)%d_fill ) 
    1688                   td_file%t_var(ji)%d_value(:,:,:,:) = & 
    1689                   &   ( td_file%t_var(ji)%d_value(:,:,:,:) - & 
    1690                   &     td_file%t_var(ji)%d_ofs ) / & 
    1691                   &   td_file%t_var(ji)%d_scf 
    1692                END WHERE 
    1693  
    16941669               DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len 
    16951670                  SELECT CASE (td_file%t_var(ji)%i_ndim) 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/logger.f90

    r10248 r10251  
    1616!> but not necessarily "wrong".  
    1717!>    - error : Other runtime errors or unexpected conditions. 
    18 !>    - fatal : Severe errors that cause premature termination. 
     18!>    - fatal : Severe errors that cause premature termination.<br /> 
    1919!>  default verbosity is warning 
    20 !>    - none  : to not create and write any information in logger file.<br /> 
    2120! 
    2221!> If total number of error exceeded maximum number  
    … …  
    2524!> to open/create logger file:<br/> 
    2625!> @code 
    27 !>    CALL logger_open(cd_file, [cd_verbosity,] [id_maxerror,] [id_loggerid]) 
     26!>    CALL logger_open(cd_file, [cd_verbosity,] [id_loggerid,] [id_maxerror]) 
    2827!> @endcode 
    2928!> - cd_file is logger file name 
    … …  
    121120!> J.Paul 
    122121! REVISION HISTORY: 
    123 !> @date November, 2013 - Initial Version 
    124 !> @date February, 2015 
    125 !> - check verbosity validity 
    126 !> - add 'none' verbosity level to not used logger file 
     122!> @date November, 2013- Initial Version 
    127123!> 
    128124!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    155151 
    156152   PRIVATE :: logger__write     ! cut message to get maximum of 80 character by line in log file 
    157    PRIVATE :: logger__check_verb! check verbosity validity 
    158153 
    159154   TYPE TLOGGER   !< logger structure 
    160155      INTEGER(i4)       :: i_id = 0                 !< log file id 
    161       LOGICAL           :: l_use=.TRUE.             !< use logger or not 
    162156      CHARACTER(LEN=lc) :: c_name                   !< log file name 
    163157      CHARACTER(LEN=lc) :: c_verbosity = "warning"  !< verbosity choose 
    … …  
    169163 
    170164   !  module variable 
    171    INTEGER(i4), PARAMETER :: im_nverbosity=7     !< number of log level 
     165   INTEGER(i4), PARAMETER :: im_nverbosity=6     !< number of log level 
    172166   CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array  
    173167   &               (/ 'trace   ',& 
    … …  
    176170   &                  'warning ',& 
    177171   &                  'error   ',& 
    178    &                  'fatal   ',& 
    179    &                  'none    '/) 
     172   &                  'fatal   '/) 
    180173 
    181174   TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure 
    … …  
    191184   !> 
    192185   !> @author J.Paul 
    193    !> @date November, 2013 - Initial Version 
     186   !> - November, 2013- Initial Version 
    194187   ! 
    195188   !> @param[in] cd_file      log file name 
    196189   !> @param[in] cd_verbosity log file verbosity 
     190   !> @param[in] id_logid     log file id (use to flush) 
    197191   !> @param[in] id_maxerror  maximum number of error 
    198    !> @param[in] id_logid     log file id (use to flush) 
    199    !------------------------------------------------------------------- 
    200    SUBROUTINE logger_open(cd_file, cd_verbosity, id_maxerror, id_logid) 
     192   !------------------------------------------------------------------- 
     193   SUBROUTINE logger_open(cd_file, cd_verbosity, id_logid, id_maxerror) 
    201194      IMPLICIT NONE 
    202195      ! Argument 
    203196      CHARACTER(len=*), INTENT(IN) :: cd_file                ! log file name 
    204197      CHARACTER(len=*), INTENT(IN), OPTIONAL :: cd_verbosity ! log file verbosity 
     198      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id 
    205199      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error 
    206       INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id 
    207200 
    208201      ! local variable 
    209202      INTEGER(i4) :: il_status 
    210203 
    211       LOGICAL     :: ll_valid 
    212  
    213204      ! loop 
    214205      INTEGER(i4) :: ji 
    215206      !---------------------------------------------------------------- 
     207      ! get id if not already define 
     208      IF( PRESENT(id_logid) )THEN 
     209         tm_logger%i_id=id_logid 
     210      ELSE 
     211         tm_logger%i_id=fct_getunit() 
     212      ENDIF 
     213 
     214      ! open log file 
     215      OPEN( tm_logger%i_id, & 
     216      &     STATUS="unknown",    & 
     217      &     FILE=TRIM(ADJUSTL(cd_file)),  & 
     218      &     ACTION="write",      & 
     219      &     POSITION="append",   & 
     220      &     IOSTAT=il_status) 
     221      CALL fct_err(il_status) 
     222 
     223      ! keep filename 
     224      tm_logger%c_name=TRIM(ADJUSTL(cd_file)) 
    216225 
    217226      ! if present, change verbosity value 
    218227      IF( PRESENT(cd_verbosity) )THEN 
    219          ll_valid=logger__check_verb(TRIM(ADJUSTL(cd_verbosity))) 
    220          IF( ll_valid )THEN 
    221             tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity)) 
    222          ENDIF 
    223       ENDIF 
    224  
    225       IF( TRIM(tm_logger%c_verbosity) == 'none' ) tm_logger%l_use=.FALSE. 
    226        
    227       IF( tm_logger%l_use )THEN 
    228  
    229          ! get id if not already define 
    230          IF( PRESENT(id_logid) )THEN 
    231             tm_logger%i_id=id_logid 
    232          ELSE 
    233             tm_logger%i_id=fct_getunit() 
    234          ENDIF 
    235  
    236          ! open log file 
    237          OPEN( tm_logger%i_id, & 
    238          &     STATUS="unknown",    & 
    239          &     FILE=TRIM(ADJUSTL(cd_file)),  & 
    240          &     ACTION="write",      & 
    241          &     POSITION="append",   & 
    242          &     IOSTAT=il_status) 
    243          CALL fct_err(il_status) 
    244  
    245          ! keep filename 
    246          tm_logger%c_name=TRIM(ADJUSTL(cd_file)) 
    247  
    248          ! compute "tab" of verbosity to be used 
    249          IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN 
    250             DO ji=im_nverbosity,1,-1 
    251                tm_logger%c_verb = & 
    252                &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji))) 
    253                IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN 
    254                   EXIT 
    255                ENDIF 
    256             ENDDO 
    257          ENDIF 
    258  
    259          IF( PRESENT(id_maxerror) )THEN 
    260             tm_logger%i_maxerror=id_maxerror 
    261          ENDIF 
    262  
     228         tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity)) 
     229      ENDIF 
     230 
     231      ! compute "tab" of verbosity to be used 
     232      IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN 
     233         DO ji=im_nverbosity,1,-1 
     234            tm_logger%c_verb = & 
     235            &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji))) 
     236            IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN 
     237               EXIT 
     238            ENDIF 
     239         ENDDO 
     240      ENDIF 
     241 
     242      IF( PRESENT(id_maxerror) )THEN 
     243         tm_logger%i_maxerror=id_maxerror 
    263244      ENDIF 
    264245 
    … …  
    268249   !> 
    269250   !> @author J.Paul 
    270    !> @date November, 2013 - Initial Version 
     251   !> - November, 2013- Initial Version 
    271252   !------------------------------------------------------------------- 
    272253   SUBROUTINE logger_close() 
    … …  
    275256      INTEGER(i4) :: il_status 
    276257      !---------------------------------------------------------------- 
    277       IF( tm_logger%l_use )THEN 
    278          IF( tm_logger%i_id /= 0 )THEN 
    279             tm_logger%i_id = 0 
    280             CLOSE( tm_logger%i_id, & 
    281             &      IOSTAT=il_status)       
    282             CALL fct_err(il_status) 
    283          ELSE 
    284              CALL logger_open('logger.log') 
    285              CALL logger_header() 
    286              CALL logger_fatal('you must have create logger to use logger_close') 
    287          ENDIF 
     258      IF( tm_logger%i_id /= 0 )THEN 
     259         tm_logger%i_id = 0 
     260         CLOSE( tm_logger%i_id, & 
     261         &      IOSTAT=il_status)       
     262         CALL fct_err(il_status) 
     263      ELSE 
     264          CALL logger_open('logger.log') 
     265          CALL logger_header() 
     266          CALL logger_fatal('you must have create logger to use logger_close') 
    288267      ENDIF 
    289268 
    … …  
    293272   !> 
    294273   !> @author J.Paul 
    295    !> @date November, 2013 - Initial Version 
     274   !> - November, 2013- Initial Version 
    296275   !------------------------------------------------------------------- 
    297276   SUBROUTINE logger_flush() 
    298277      IMPLICIT NONE 
    299278      !---------------------------------------------------------------- 
    300       IF( tm_logger%l_use )THEN 
    301          IF( tm_logger%i_id /= 0 )THEN 
    302             CALL logger_close() 
    303             CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, & 
    304             &                 tm_logger%i_maxerror, tm_logger%i_id )      
    305          ELSE 
    306              CALL logger_open('logger.log') 
    307              CALL logger_header() 
    308              CALL logger_fatal('you must have create logger to use logger_flush') 
    309          ENDIF 
     279      IF( tm_logger%i_id /= 0 )THEN 
     280         CALL logger_close() 
     281         CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, tm_logger%i_id, & 
     282         &              tm_logger%i_maxerror )      
     283      ELSE 
     284          CALL logger_open('logger.log') 
     285          CALL logger_header() 
     286          CALL logger_fatal('you must have create logger to use logger_flush') 
    310287      ENDIF 
    311288 
    … …  
    315292   !> 
    316293   !> @author J.Paul 
    317    !> @date November, 2013 - Initial Version 
     294   !> - November, 2013- Initial Version 
    318295   !------------------------------------------------------------------- 
    319296   RECURSIVE SUBROUTINE logger_header() 
    … …  
    322299      INTEGER(i4)       :: il_status 
    323300      !---------------------------------------------------------------- 
    324       IF( tm_logger%l_use )THEN 
    325          IF( tm_logger%i_id /= 0 )THEN 
    326             WRITE( tm_logger%i_id,    & 
    327                &   FMT='(4(a/))',     & 
    328                &   IOSTAT=il_status ) & 
    329                &   "--------------------------------------------------",& 
    330                &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),& 
    331                &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), & 
    332                &   "--------------------------------------------------" 
    333             CALL fct_err(il_status) 
    334          ELSE 
    335              CALL logger_open('logger.log') 
    336              CALL logger_header() 
    337              CALL logger_fatal('you must have create logger to use logger_header') 
    338          ENDIF 
     301      IF( tm_logger%i_id /= 0 )THEN 
     302         WRITE( tm_logger%i_id,    & 
     303            &   FMT='(4(a/))',     & 
     304            &   IOSTAT=il_status ) & 
     305            &   "--------------------------------------------------",& 
     306            &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),& 
     307            &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), & 
     308            &   "--------------------------------------------------" 
     309         CALL fct_err(il_status) 
     310      ELSE 
     311          CALL logger_open('logger.log') 
     312          CALL logger_header() 
     313          CALL logger_fatal('you must have create logger to use logger_header') 
    339314      ENDIF 
    340315 
    … …  
    344319   !> 
    345320   !> @author J.Paul 
    346    !> @date November, 2013 - Initial Version 
     321   !> - November, 2013- Initial Version 
    347322   !------------------------------------------------------------------- 
    348323   SUBROUTINE logger_footer() 
    … …  
    351326      INTEGER(i4)       :: il_status 
    352327      !---------------------------------------------------------------- 
    353       IF( tm_logger%l_use )THEN 
    354          IF( tm_logger%i_id /= 0 )THEN 
    355             WRITE( tm_logger%i_id,    & 
    356                &   FMT='(4(/a))',     & 
    357                &   IOSTAT=il_status ) & 
    358                &   "--------------------------------------------------",& 
    359                &   "END      : log ended ",              & 
    360                &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   & 
    361                &   " ERROR detected ",                                  & 
    362                &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   & 
    363                &   " FATAL detected ",                                  & 
    364                &   "--------------------------------------------------" 
    365             CALL fct_err(il_status) 
    366          ELSE 
    367              CALL logger_open('logger.log') 
    368              CALL logger_header() 
    369              CALL logger_fatal('you must have create logger to use logger_footer') 
    370          ENDIF 
     328      IF( tm_logger%i_id /= 0 )THEN 
     329         WRITE( tm_logger%i_id,    & 
     330            &   FMT='(4(/a))',     & 
     331            &   IOSTAT=il_status ) & 
     332            &   "--------------------------------------------------",& 
     333            &   "END      : log ended ",              & 
     334            &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   & 
     335            &   " ERROR detected ",                                  & 
     336            &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   & 
     337            &   " FATAL detected ",                                  & 
     338            &   "--------------------------------------------------" 
     339         CALL fct_err(il_status) 
     340      ELSE 
     341          CALL logger_open('logger.log') 
     342          CALL logger_header() 
     343          CALL logger_fatal('you must have create logger to use logger_footer') 
    371344      ENDIF 
    372345   END SUBROUTINE logger_footer 
    … …  
    377350   !> 
    378351   !> @author J.Paul 
    379    !> @date November, 2013 - Initial Version 
     352   !> - November, 2013- Initial Version 
    380353   ! 
    381354   !> @param[in] cd_msg    message to write 
    … …  
    388361      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    389362      !---------------------------------------------------------------- 
    390       IF( tm_logger%l_use )THEN 
    391          IF( tm_logger%i_id /= 0 )THEN 
    392             IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN 
    393  
    394                CALL logger__write("TRACE   :",cd_msg) 
    395  
    396                IF( PRESENT(ld_flush) )THEN 
    397                   IF( ld_flush )THEN 
    398                      CALL logger_flush() 
    399                   ENDIF 
    400                ENDIF       
    401             ENDIF 
    402          ELSE 
    403              CALL logger_open('logger.log') 
    404              CALL logger_header() 
    405              CALL logger_fatal('you must have create logger to use logger_trace') 
     363      IF( tm_logger%i_id /= 0 )THEN 
     364         IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN 
     365 
     366            CALL logger__write("TRACE   :",cd_msg) 
     367 
     368            IF( PRESENT(ld_flush) )THEN 
     369               IF( ld_flush )THEN 
     370                  CALL logger_flush() 
     371               ENDIF 
     372            ENDIF       
    406373         ENDIF 
     374      ELSE 
     375          CALL logger_open('logger.log') 
     376          CALL logger_header() 
     377          CALL logger_fatal('you must have create logger to use logger_trace') 
    407378      ENDIF 
    408379   END SUBROUTINE logger_trace 
    … …  
    413384   !> 
    414385   !> @author J.Paul 
    415    !> @date November, 2013 - Initial Version 
     386   !> - November, 2013- Initial Version 
    416387   ! 
    417388   !> @param[in] cd_msg    message to write 
    … …  
    424395      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    425396      !---------------------------------------------------------------- 
    426       IF( tm_logger%l_use )THEN 
    427          IF( tm_logger%i_id /= 0 )THEN 
    428             IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN 
    429  
    430                CALL logger__write("DEBUG   :",cd_msg) 
    431  
    432                IF( PRESENT(ld_flush) )THEN 
    433                   IF( ld_flush )THEN 
    434                      CALL logger_flush() 
    435                   ENDIF 
    436                ENDIF       
    437             ENDIF 
    438          ELSE 
    439              CALL logger_open('logger.log') 
    440              CALL logger_header() 
    441              CALL logger_fatal('you must have create logger to use logger_debug') 
     397      IF( tm_logger%i_id /= 0 )THEN 
     398         IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN 
     399 
     400            CALL logger__write("DEBUG   :",cd_msg) 
     401 
     402            IF( PRESENT(ld_flush) )THEN 
     403               IF( ld_flush )THEN 
     404                  CALL logger_flush() 
     405               ENDIF 
     406            ENDIF       
    442407         ENDIF 
     408      ELSE 
     409          CALL logger_open('logger.log') 
     410          CALL logger_header() 
     411          CALL logger_fatal('you must have create logger to use logger_debug') 
    443412      ENDIF 
    444413   END SUBROUTINE logger_debug 
    … …  
    449418   !> 
    450419   !> @author J.Paul 
    451    !> @date November, 2013 - Initial Version 
     420   !> - November, 2013- Initial Version 
    452421   ! 
    453422   !> @param[in] cd_msg    message to write 
    … …  
    460429      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    461430      !---------------------------------------------------------------- 
    462       IF( tm_logger%l_use )THEN 
    463          IF( tm_logger%i_id /= 0 )THEN 
    464             IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN 
    465  
    466                CALL logger__write("INFO    :",cd_msg) 
    467  
    468                IF( PRESENT(ld_flush) )THEN 
    469                   IF( ld_flush )THEN 
    470                      CALL logger_flush() 
    471                   ENDIF 
    472                ENDIF       
    473             ENDIF 
    474          ELSE 
    475              CALL logger_open('logger.log') 
    476              CALL logger_header() 
    477              CALL logger_fatal('you must have create logger to use logger_info') 
     431      IF( tm_logger%i_id /= 0 )THEN 
     432         IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN 
     433 
     434            CALL logger__write("INFO    :",cd_msg) 
     435 
     436            IF( PRESENT(ld_flush) )THEN 
     437               IF( ld_flush )THEN 
     438                  CALL logger_flush() 
     439               ENDIF 
     440            ENDIF       
    478441         ENDIF 
     442      ELSE 
     443          CALL logger_open('logger.log') 
     444          CALL logger_header() 
     445          CALL logger_fatal('you must have create logger to use logger_info') 
    479446      ENDIF 
    480447   END SUBROUTINE logger_info 
    … …  
    485452   !> 
    486453   !> @author J.Paul 
    487    !> @date November, 2013 - Initial Version 
     454   !> - November, 2013- Initial Version 
    488455   ! 
    489456   !> @param[in] cd_msg    message to write 
    … …  
    496463      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    497464      !---------------------------------------------------------------- 
    498       IF( tm_logger%l_use )THEN 
    499          IF( tm_logger%i_id /= 0 )THEN 
    500             IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN 
    501  
    502                CALL logger__write("WARNING :",cd_msg) 
    503  
    504                IF( PRESENT(ld_flush) )THEN 
    505                   IF( ld_flush )THEN 
    506                      CALL logger_flush() 
    507                   ENDIF 
    508                ENDIF       
    509             ENDIF 
    510          ELSE 
    511              CALL logger_open('logger.log') 
    512              CALL logger_header() 
    513              CALL logger_fatal('you must have create logger to use logger_warn') 
     465      IF( tm_logger%i_id /= 0 )THEN 
     466         IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN 
     467 
     468            CALL logger__write("WARNING :",cd_msg) 
     469 
     470            IF( PRESENT(ld_flush) )THEN 
     471               IF( ld_flush )THEN 
     472                  CALL logger_flush() 
     473               ENDIF 
     474            ENDIF       
    514475         ENDIF 
     476      ELSE 
     477          CALL logger_open('logger.log') 
     478          CALL logger_header() 
     479          CALL logger_fatal('you must have create logger to use logger_warn') 
    515480      ENDIF 
    516481   END SUBROUTINE logger_warn 
    … …  
    521486   !> 
    522487   !> @author J.Paul 
    523    !> @date November, 2013 - Initial Version 
     488   !> - November, 2013- Initial Version 
    524489   ! 
    525490   !> @param[in] cd_msg    message to write 
    … …  
    535500      CHARACTER(LEN=lc) :: cl_nerror 
    536501      !---------------------------------------------------------------- 
    537       IF( tm_logger%l_use )THEN 
    538          IF( tm_logger%i_id /= 0 )THEN 
    539             IF( TRIM(tm_logger%c_verb) /= 'none' )THEN 
    540                ! increment the error number 
    541                tm_logger%i_nerror=tm_logger%i_nerror+1 
    542             ENDIF 
    543  
    544             IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN 
    545  
    546                CALL logger__write("ERROR   :",cd_msg) 
    547  
    548                IF( PRESENT(ld_flush) )THEN 
    549                   IF( ld_flush )THEN 
    550                      CALL logger_flush() 
    551                   ENDIF 
    552                ENDIF       
    553             ENDIF 
    554  
    555             IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN 
    556                WRITE(cl_nerror,*) tm_logger%i_maxerror 
    557                CALL logger_fatal(& 
    558                &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) ) 
    559             ENDIF 
    560          ELSE 
    561              CALL logger_open('logger.log') 
    562              CALL logger_header() 
    563              CALL logger_fatal('you must have create logger to use logger_error') 
     502      IF( tm_logger%i_id /= 0 )THEN 
     503         ! increment the error number 
     504         tm_logger%i_nerror=tm_logger%i_nerror+1 
     505 
     506         IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN 
     507 
     508            CALL logger__write("ERROR   :",cd_msg) 
     509 
     510            IF( PRESENT(ld_flush) )THEN 
     511               IF( ld_flush )THEN 
     512                  CALL logger_flush() 
     513               ENDIF 
     514            ENDIF       
    564515         ENDIF 
    565       ENDIF 
     516 
     517         IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN 
     518            WRITE(cl_nerror,*) tm_logger%i_maxerror 
     519            CALL logger_fatal(& 
     520            &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) ) 
     521         ENDIF 
     522      ELSE 
     523          CALL logger_open('logger.log') 
     524          CALL logger_header() 
     525          CALL logger_fatal('you must have create logger to use logger_error') 
     526      ENDIF 
     527 
    566528   END SUBROUTINE logger_error 
    567529   !------------------------------------------------------------------- 
    … …  
    570532   !> 
    571533   !> @author J.Paul 
    572    !> @date November, 2013 - Initial Version 
     534   !> - November, 2013- Initial Version 
    573535   ! 
    574536   !> @param[in] cd_msg message to write 
    … …  
    579541      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg 
    580542      !---------------------------------------------------------------- 
    581       IF( tm_logger%l_use )THEN 
    582          IF( tm_logger%i_id /= 0 )THEN 
    583             IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN 
    584                ! increment the error number 
    585                tm_logger%i_nfatal=tm_logger%i_nfatal+1 
    586  
    587                CALL logger__write("FATAL   :",cd_msg) 
    588  
    589                CALL logger_footer() 
    590                CALL logger_close() 
    591  
    592                WRITE(*,*) 'FATAL ERROR' 
    593                STOP 
    594             ENDIF 
    595          ELSE 
    596              CALL logger_open('logger.log') 
    597              CALL logger_header() 
    598              CALL logger_fatal('you must have create logger to use logger_fatal') 
     543      IF( tm_logger%i_id /= 0 )THEN 
     544         IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN 
     545            ! increment the error number 
     546            tm_logger%i_nfatal=tm_logger%i_nfatal+1 
     547 
     548            CALL logger__write("FATAL   :",cd_msg) 
     549 
     550            CALL logger_footer() 
     551            CALL logger_close() 
     552 
     553            WRITE(*,*) 'FATAL ERROR' 
     554            STOP 
    599555         ENDIF 
     556      ELSE 
     557          CALL logger_open('logger.log') 
     558          CALL logger_header() 
     559          CALL logger_fatal('you must have create logger to use logger_fatal') 
    600560      ENDIF 
    601561   END SUBROUTINE logger_fatal 
    … …  
    605565   !> 
    606566   !> @author J.Paul 
    607    !> @date November, 2013 - Initial Version 
     567   !> - November, 2013- Initial Version 
    608568   ! 
    609569   !> @param[in] cd_verb   verbosity of the message to write 
    … …  
    655615 
    656616   END SUBROUTINE logger__write 
    657    !------------------------------------------------------------------- 
    658    !> @brief This function check validity of verbosity. 
    659    !> 
    660    !> @author J.Paul 
    661    !> @date February, 2015 - Initial Version 
    662    ! 
    663    !> @param[in] cd_verb   verbosity of the message to write 
    664    !> @return verbosity is valid or not 
    665    !------------------------------------------------------------------- 
    666    FUNCTION logger__check_verb(cd_verb) 
    667       IMPLICIT NONE 
    668       ! Argument 
    669       CHARACTER(LEN=*),           INTENT(IN) :: cd_verb 
    670  
    671       !function 
    672       LOGICAL           :: logger__check_verb 
    673  
    674       ! local variable 
    675       ! loop indices 
    676       INTEGER(i4) :: ji 
    677  
    678       !---------------------------------------------------------------- 
    679       logger__check_verb=.FALSE. 
    680  
    681       DO ji=1,im_nverbosity 
    682          IF( TRIM(cd_verb) == TRIM(cm_verbosity(ji)) )THEN 
    683             logger__check_verb=.TRUE. 
    684             EXIT 
    685          ENDIF 
    686       ENDDO 
    687  
    688       IF( .NOT. logger__check_verb )THEN 
    689          CALL logger_open('logger.log') 
    690          CALL logger_header() 
    691          CALL logger_fatal('LOGGER : invalid verbosity, check namelist.'//& 
    692          &                 ' default one will be used.') 
    693          CALL logger_footer() 
    694       ENDIF 
    695    END FUNCTION logger__check_verb 
    696617END MODULE logger 
    697618 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90

    r10248 r10251  
    2828!> @endcode 
    2929!>     
    30 !> @note  
    31 !>    you could find a template of the namelist in templates directory. 
    32 !> 
    3330!>    merge_bathy.nam comprise 8 namelists: 
    3431!>       - logger namelist (namlog) 
    … …  
    4845!>       - cn_logfile   : logger filename 
    4946!>       - cn_verbosity : verbosity ('trace','debug','info', 
    50 !>  'warning','error','fatal','none') 
     47!>  'warning','error','fatal') 
    5148!>       - in_maxerror  : maximum number of error allowed 
    5249!> 
    … …  
    6562!>    * _variable namelist (namvar)_: 
    6663!>       - cn_varinfo : list of variable and extra information about request(s)  
    67 !>       to be used (separated by ',').<br/> 
     64!>       to be used.<br/> 
    6865!>          each elements of *cn_varinfo* is a string character.<br/> 
    6966!>          it is composed of the variable name follow by ':',  
    7067!>          then request(s) to be used on this variable.<br/>  
    7168!>          request could be: 
    72 !>             - int = interpolation method 
     69!>             - interpolation method 
    7370!>  
    7471!>                requests must be separated by ';'.<br/> 
    … …  
    7774!>          informations about available method could be find in  
    7875!>          @ref interp modules.<br/> 
    79 !>          Example: 'bathymetry: int=cubic' 
     76!>          Example: 'bathymetry: cubic' 
    8077!>          @note  
    8178!>             If you do not specify a method which is required,  
    … …  
    9895!>          segments are separated by '|'.<br/> 
    9996!>          each segments of the boundary is composed of: 
    100 !>             - indice of velocity (orthogonal to boundary .ie.  
    101 !>                for north boundary, J-indice).  
    102 !>             - indice of segment start (I-indice for north boundary)  
    103 !>             - indice of segment end  (I-indice for north boundary)<br/> 
    104 !>                indices must be separated by ':' .<br/> 
     97!>             - orthogonal indice (.ie. for north boundary, 
     98!>             J-indice where boundary are).  
     99!>             - first indice of boundary (I-indice for north boundary)  
     100!>             - last  indice of boundary (I-indice for north boundary)<br/> 
     101!>                indices must be separated by ',' .<br/> 
    105102!>             - optionally, boundary size could be added between '(' and ')'  
    106103!>             in the first segment defined. 
    … …  
    109106!> 
    110107!>          Examples: 
    111 !>             - cn_north='index1,first1:last1(width)' 
    112 !>             - cn_north='index1(width),first1:last1|index2,first2:last2' 
    113 !> 
     108!>             - cn_north='index1,first1,last1(width)' 
     109!>             - cn_north='index1(width),first1,last1|index2,first2,last2' 
    114110!>       - cn_south : south boundary indices on fine grid<br/> 
    115111!>       - cn_east  : east  boundary indices on fine grid<br/> 
    … …  
    125121!> @date Sepember, 2014  
    126122!> - add header for user 
    127 !> @date July, 2015  
    128 !> - extrapolate all land points 
    129 !> - add attributes with boundary string character (as in namelist) 
    130123!> 
    131124!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    160153   CHARACTER(LEN=lc)                                  :: cl_namelist 
    161154   CHARACTER(LEN=lc)                                  :: cl_date 
    162    CHARACTER(LEN=lc)                                  :: cl_tmp 
    163155 
    164156   INTEGER(i4)                                        :: il_narg 
    … …  
    170162   INTEGER(i4)                                        :: il_jmin0 
    171163   INTEGER(i4)                                        :: il_jmax0 
    172    INTEGER(i4)                                        :: il_shift 
    173164   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho 
    174165   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind 
    … …  
    240231   NAMELIST /namlog/ &  !< logger namelist 
    241232   &  cn_logfile,    &  !< log file 
    242    &  cn_verbosity,  &  !< log verbosity 
    243    &  in_maxerror       !< logger maximum error 
     233   &  cn_verbosity      !< log verbosity 
    244234 
    245235   NAMELIST /namcfg/ &  !< config namelist 
    … …  
    308298      READ( il_fileid, NML = namlog ) 
    309299      ! define log file 
    310       CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 
     300      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity), in_maxerror) 
    311301      CALL logger_header() 
    312302 
    … …  
    520510   ENDIF 
    521511 
    522  
    523    IF( tl_bdy(jp_north)%l_use )THEN 
    524       ! add shift on north boundary 
    525       ! boundary compute on T point but express on U or V point 
    526       il_shift=1 
    527  
    528       cl_tmp=TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_index-il_shift))//','//& 
    529          &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_first))//':'//& 
    530          &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_last))//& 
    531          &   '('//TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_width))//')' 
    532       DO ji=2,tl_bdy(jp_north)%i_nseg 
    533          cl_tmp=TRIM(cl_tmp)//'|'//& 
    534             &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_index-il_shift))//','//& 
    535             &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_first))//':'//& 
    536             &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_last)) 
    537       ENDDO 
    538       tl_att=att_init("bdy_north",TRIM(cl_tmp)) 
    539       CALL file_add_att(tl_fileout, tl_att) 
    540    ENDIF 
    541  
    542    IF( tl_bdy(jp_south)%l_use )THEN 
    543        
    544       cl_tmp=TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_index))//','//& 
    545          &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_first))//':'//& 
    546          &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_last))//& 
    547          &   '('//TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_width))//')' 
    548       DO ji=2,tl_bdy(jp_south)%i_nseg 
    549          cl_tmp=TRIM(cl_tmp)//'|'//& 
    550             &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_index))//','//& 
    551             &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_first))//':'//& 
    552             &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_last)) 
    553       ENDDO 
    554  
    555       tl_att=att_init("bdy_south",TRIM(cl_tmp)) 
    556       CALL file_add_att(tl_fileout, tl_att) 
    557    ENDIF 
    558  
    559    IF( tl_bdy(jp_east)%l_use )THEN 
    560       ! add shift on east boundary 
    561       ! boundary compute on T point but express on U or V point 
    562       il_shift=1 
    563  
    564       cl_tmp=TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_index-il_shift))//','//& 
    565          &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_first))//':'//& 
    566          &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_last))//& 
    567          &   '('//TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_width))//')' 
    568       DO ji=2,tl_bdy(jp_east)%i_nseg 
    569          cl_tmp=TRIM(cl_tmp)//'|'//& 
    570             &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_index-il_shift))//','//& 
    571             &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_first))//':'//& 
    572             &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_last)) 
    573       ENDDO 
    574  
    575       tl_att=att_init("bdy_east",TRIM(cl_tmp)) 
    576       CALL file_add_att(tl_fileout, tl_att) 
    577    ENDIF 
    578  
    579    IF( tl_bdy(jp_west)%l_use )THEN 
    580  
    581       cl_tmp=TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_index))//','//& 
    582          &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_first))//':'//& 
    583          &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_last))//& 
    584          &   '('//TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_width))//')' 
    585       DO ji=2,tl_bdy(jp_west)%i_nseg 
    586          cl_tmp=TRIM(cl_tmp)//'|'//& 
    587             &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_index))//','//& 
    588             &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_first))//':'//& 
    589             &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_last)) 
    590       ENDDO 
    591  
    592       tl_att=att_init("bdy_west",TRIM(cl_tmp)) 
    593       CALL file_add_att(tl_fileout, tl_att) 
    594    ENDIF 
    595  
    596512   ! create file 
    597513   CALL iom_create(tl_fileout) 
    … …  
    609525   CALL mpp_clean(tl_bathy0) 
    610526   DEALLOCATE(dl_weight) 
    611    CALL boundary_clean(tl_bdy(:)) 
    612527 
    613528   ! close log file 
    … …  
    993908 
    994909      ! extrapolate variable 
    995       CALL extrap_fill_value( td_var ) 
     910      CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), & 
     911      &                               id_rho=id_rho(:),         & 
     912      &                               id_iext=il_iext, id_jext=il_jext ) 
    996913 
    997914      ! interpolate Bathymetry 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/mpp.f90

    r10248 r10251  
    165165!>    to get processors to be used:<br/> 
    166166!> @code 
    167 !>    CALL mpp_get_use( td_mpp, id_imin, id_imax, &  
    168 !>    &                         id_jmin, id_jmax ) 
     167!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, &  
     168!>    &                         id_jmin, id_jmax, id_jdim ) 
    169169!> @endcode 
    170170!>       - id_imin  
    171171!>       - id_imax  
     172!>       - id_idim  
    172173!>       - id_jmin  
    173174!>       - id_jmax  
     175!>       - id_jdim  
    174176!> 
    175177!>    to get sub domains which form global domain contour:<br/> 
    … …  
    350352   !> 
    351353   !> @author J.Paul 
    352    !> @date November, 2013 - Initial Version 
     354   !> - November, 2013- Initial Version 
    353355   !> @date November, 2014 
    354356   !>    - use function instead of overload assignment operator  
    … …  
    377379      ! copy mpp variable 
    378380      mpp__copy_unit%c_name     = TRIM(td_mpp%c_name) 
    379       mpp__copy_unit%i_id       = td_mpp%i_id 
    380381      mpp__copy_unit%i_niproc   = td_mpp%i_niproc 
    381382      mpp__copy_unit%i_njproc   = td_mpp%i_njproc 
    … …  
    424425   !> 
    425426   !> @author J.Paul 
    426    !> @date November, 2013 - Initial Version 
     427   !> - November, 2013- Initial Version 
    427428   !> @date November, 2014 
    428429   !>    - use function instead of overload assignment operator  
    … …  
    453454   ! 
    454455   !> @author J.Paul 
    455    !> @date November, 2013 - Initial Version 
     456   !> - Nov, 2013- Initial Version 
    456457   ! 
    457458   !> @param[in] td_mpp mpp structure 
    … …  
    494495      ! print dimension 
    495496      IF(  td_mpp%i_ndim /= 0 )THEN 
    496          WRITE(*,'(/a)') " MPP dimension" 
     497         WRITE(*,'(/a)') " File dimension" 
    497498         DO ji=1,ip_maxdim 
    498499            IF( td_mpp%t_dim(ji)%l_use )THEN 
    … …  
    697698      CALL dim_clean(tl_dim) 
    698699 
    699       IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. & 
     700      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. & 
    700701          ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN 
    701702          CALL logger_warn( "MPP INIT: number of processors following I and J "//& 
    … …  
    911912   !> 
    912913   !> @author J.Paul 
    913    !> @date November, 2013 - Initial Version 
     914   !> - November, 2013- Initial Version 
    914915   ! 
    915916   !> @param[in] td_file   file strcuture 
    … …  
    10271028            ! create some attributes for domain decomposition (use with dimg file) 
    10281029            tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc ) 
    1029             CALL mpp_move_att(mpp__init_file, tl_att) 
     1030            CALL mpp_add_att(mpp__init_file, tl_att) 
    10301031 
    10311032            tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 
    1032             CALL mpp_move_att(mpp__init_file, tl_att) 
     1033            CALL mpp_add_att(mpp__init_file, tl_att) 
    10331034 
    10341035            tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 
    1035             CALL mpp_move_att(mpp__init_file, tl_att) 
     1036            CALL mpp_add_att(mpp__init_file, tl_att) 
    10361037 
    10371038            tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 
    1038             CALL mpp_move_att(mpp__init_file, tl_att) 
     1039            CALL mpp_add_att(mpp__init_file, tl_att) 
    10391040 
    10401041            tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 
    1041             CALL mpp_move_att(mpp__init_file, tl_att) 
     1042            CALL mpp_add_att(mpp__init_file, tl_att) 
    10421043 
    10431044            tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 
    1044             CALL mpp_move_att(mpp__init_file, tl_att) 
     1045            CALL mpp_add_att(mpp__init_file, tl_att) 
    10451046 
    10461047            tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 
    1047             CALL mpp_move_att(mpp__init_file, tl_att) 
     1048            CALL mpp_add_att(mpp__init_file, tl_att) 
    10481049 
    10491050            tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 
    1050             CALL mpp_move_att(mpp__init_file, tl_att) 
     1051            CALL mpp_add_att(mpp__init_file, tl_att) 
    10511052 
    10521053            tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 
    1053             CALL mpp_move_att(mpp__init_file, tl_att) 
     1054            CALL mpp_add_att(mpp__init_file, tl_att) 
    10541055             
    10551056            ! clean 
    … …  
    11211122      CALL file_clean(tl_file) 
    11221123 
     1124      CALL logger_debug("MPP INIT READ: fin init_read ") 
    11231125   END FUNCTION mpp__init_file 
    11241126   !------------------------------------------------------------------- 
    … …  
    11291131   ! 
    11301132   !> @author J.Paul 
    1131    !> @date November, 2013 - Initial Version 
    1132    !> @date July, 2015 - add only use dimension in MPP structure 
     1133   !> - November, 2013- Initial Version 
    11331134   !> 
    11341135   !> @param[in] td_file   file strcuture 
    … …  
    11621163         IF( td_file%i_id == 0 )THEN 
    11631164            CALL logger_info(" id "//TRIM(fct_str(td_file%i_id)))  
    1164             CALL logger_error("MPP INIT READ: netcdf file "//& 
    1165                &  TRIM(td_file%c_name)//" not opened") 
     1165            CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//& 
     1166            &  " not opened") 
    11661167         ELSE 
    11671168 
    … …  
    11901191               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    11911192            ENDIF 
    1192  
    1193             IF( td_file%t_dim(3)%l_use )THEN 
    1194                tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 
    1195                CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    1196             ENDIF 
    1197  
    1198             IF( td_file%t_dim(4)%l_use )THEN 
    1199                tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 
    1200                CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    1201             ENDIF 
     1193            tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 
     1194            CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
     1195 
     1196            tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 
     1197            CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    12021198 
    12031199            ! initialise file/processor 
    … …  
    13161312   ! 
    13171313   !> @author J.Paul 
    1318    !> @date November, 2013 - Initial Version 
     1314   !> - November, 2013- Initial Version 
    13191315   ! 
    13201316   !> @param[in] td_file   file strcuture 
    … …  
    15361532   ! 
    15371533   !> @author J.Paul 
    1538    !> @date November, 2013 - Initial Version 
     1534   !> - Nov, 2013- Initial Version 
    15391535   ! 
    15401536   !> @param[in] td_mpp    mpp structure 
    … …  
    16281624            IF( il_varid /= 0 )THEN 
    16291625 
     1626               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//& 
     1627               &  ", standard name "//TRIM(td_var%c_stdname)//& 
     1628               &  ", already in mpp "//TRIM(td_mpp%c_name) ) 
     1629 
    16301630               DO ji=1,td_mpp%t_proc(1)%i_nvar 
    16311631                  CALL logger_debug( " MPP ADD VAR: in mpp structure : & 
    … …  
    16341634                  &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) ) 
    16351635               ENDDO 
    1636                CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//& 
    1637                &  ", standard name "//TRIM(td_var%c_stdname)//& 
    1638                &  ", already in mpp "//TRIM(td_mpp%c_name) ) 
    16391636 
    16401637            ELSE 
    … …  
    16781675   ! 
    16791676   !> @author J.Paul 
    1680    !> @date November, 2013 - Initial Version 
     1677   !> - November, 2013- Initial Version 
    16811678   ! 
    16821679   !> @param[in] td_mpp    mpp structure 
    … …  
    18431840   !> @author J.Paul 
    18441841   !> @date November, 2013 - Initial version 
    1845    !> @date February, 2015  
    1846    !> - define local variable structure to avoid mistake with pointer 
    18471842   ! 
    18481843   !> @param[inout] td_mpp    mpp strcuture 
    … …  
    18571852      ! local variable 
    18581853      INTEGER(i4)       :: il_varid 
    1859       TYPE(TVAR)        :: tl_var 
    18601854      !---------------------------------------------------------------- 
    18611855      ! check if mpp exist 
    … …  
    18881882            ELSE 
    18891883 
    1890                tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid)) 
    1891                CALL mpp_del_var(td_mpp, tl_var) 
     1884               CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid))  
    18921885 
    18931886            ENDIF 
    … …  
    22002193   !> 
    22012194   !> @author J.Paul 
    2202    !> @date November, 2013 - Initial Version 
    2203    !> @date July, 2015  
    2204    !> - rewrite the same as way var_add_dim 
     2195   !> - November, 2013- Initial Version 
    22052196   !> 
    22062197   !> @param[inout] td_mpp mpp structure 
    … …  
    22172208 
    22182209      ! loop indices 
     2210      INTEGER(i4) :: ji 
    22192211      !---------------------------------------------------------------- 
    22202212      IF( td_mpp%i_ndim <= ip_maxdim )THEN 
    22212213 
    2222          ! check if dimension already used in mpp structure 
    2223          il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
    2224          IF( il_ind == 0 )THEN 
    2225             CALL logger_warn( & 
    2226             &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
    2227             &  ", short name "//TRIM(td_dim%c_sname)//& 
    2228             &  ", will not be added in mpp "//TRIM(td_mpp%c_name) ) 
    2229          ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN 
    2230             CALL logger_error( & 
    2231             &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
    2232             &  ", short name "//TRIM(td_dim%c_sname)//& 
    2233             &  ", already used in mpp "//TRIM(td_mpp%c_name) ) 
     2214         ! check if dimension already in mpp structure 
     2215         il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 
     2216         IF( il_ind /= 0 )THEN 
     2217 
     2218            IF( td_mpp%t_dim(il_ind)%l_use )THEN 
     2219               CALL logger_error( & 
     2220               &  "MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
     2221               &  ", short name "//TRIM(td_dim%c_sname)//& 
     2222               &  ", already used in mpp "//TRIM(td_mpp%c_name) ) 
     2223            ELSE 
     2224               ! replace dimension 
     2225               td_mpp%t_dim(il_ind)=dim_copy(td_dim) 
     2226               td_mpp%t_dim(il_ind)%i_id=il_ind 
     2227               td_mpp%t_dim(il_ind)%l_use=.TRUE. 
     2228            ENDIF 
     2229 
    22342230         ELSE 
    22352231 
    2236             ! back to disorder dimension array  
    2237             CALL dim_disorder(td_mpp%t_dim(:)) 
    2238  
    2239             ! add new dimension 
    2240             td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim) 
    2241  
    2242             ! update number of attribute 
    2243             td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
     2232            IF( td_mpp%i_ndim == ip_maxdim )THEN 
     2233               CALL logger_error( & 
     2234               &  "MPP ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//& 
     2235               &  ", short name "//TRIM(td_dim%c_sname)//& 
     2236               &  ", in mpp "//TRIM(td_mpp%c_name)//". Already "//& 
     2237               &  TRIM(fct_str(ip_maxdim))//" dimensions." ) 
     2238            ELSE 
     2239               ! search empty dimension 
     2240               DO ji=1,ip_maxdim 
     2241                  IF( td_mpp%t_dim(ji)%i_id == 0 )THEN 
     2242                     il_ind=ji  
     2243                     EXIT 
     2244                  ENDIF 
     2245               ENDDO 
     2246  
     2247               ! add new dimension     
     2248               td_mpp%t_dim(il_ind)=dim_copy(td_dim) 
     2249               ! update number of attribute 
     2250               td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
     2251 
     2252               td_mpp%t_dim(il_ind)%l_use=.TRUE. 
     2253               td_mpp%t_dim(il_ind)%i_id=td_mpp%i_ndim 
     2254            ENDIF 
    22442255 
    22452256         ENDIF 
    2246          ! reorder dimension to ('x','y','z','t') 
    2247          CALL dim_reorder(td_mpp%t_dim(:)) 
    22482257 
    22492258      ELSE 
    … …  
    22592268   !> 
    22602269   !> @author J.Paul 
    2261    !> @date November, 2013 - Initial Version 
    2262    !> @date July, 2015  
    2263    !> - rewrite the same as way var_del_dim 
     2270   !> - November, 2013- Initial Version 
    22642271   !> 
    22652272   !> @param[inout] td_mpp mpp structure 
    … …  
    22732280 
    22742281      ! local variable 
     2282      INTEGER(i4) :: il_status 
    22752283      INTEGER(i4) :: il_ind 
    2276       TYPE(TDIM)  :: tl_dim 
     2284      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim 
    22772285 
    22782286      ! loop indices 
    2279       !---------------------------------------------------------------- 
    2280  
    2281  
    2282       IF( td_mpp%i_ndim <= ip_maxdim )THEN 
    2283  
    2284          CALL logger_trace( & 
    2285          &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 
     2287      INTEGER(i4) :: ji 
     2288      !---------------------------------------------------------------- 
     2289      ! check if dimension already in mpp structure 
     2290      il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 
     2291      IF( il_ind == 0 )THEN 
     2292 
     2293         CALL logger_error( & 
     2294         &  "MPP DEL DIM: no dimension "//TRIM(td_dim%c_name)//& 
    22862295         &  ", short name "//TRIM(td_dim%c_sname)//& 
    22872296         &  ", in mpp "//TRIM(td_mpp%c_name) ) 
    2288           
    2289          ! check if dimension already in variable structure 
    2290          il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
    2291  
    2292          ! replace dimension by empty one 
    2293          td_mpp%t_dim(il_ind)=dim_copy(tl_dim) 
    2294  
    2295          ! update number of dimension 
    2296          td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
    2297  
    2298          ! reorder dimension to ('x','y','z','t') 
    2299          CALL dim_reorder(td_mpp%t_dim) 
    23002297 
    23012298      ELSE 
    2302          CALL logger_error( & 
    2303          &  " MPP DEL DIM: too much dimension in mpp "//& 
    2304          &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")") 
     2299 
     2300         ALLOCATE( tl_dim(td_mpp%i_ndim-1), stat=il_status ) 
     2301         IF(il_status /= 0 )THEN 
     2302 
     2303            CALL logger_error( & 
     2304            &  "MPP DEL DIM: not enough space to put dimensions from "//& 
     2305            &  TRIM(td_mpp%c_name)//" in temporary dimension structure") 
     2306 
     2307         ELSE 
     2308 
     2309            ! save temporary dimension's mpp structure 
     2310            tl_dim( 1 : il_ind-1 ) = dim_copy(td_mpp%t_dim( 1 : il_ind-1 )) 
     2311            tl_dim( il_ind : td_mpp%i_ndim-1 ) = & 
     2312            &           dim_copy(td_mpp%t_dim( il_ind+1 : td_mpp%i_ndim )) 
     2313 
     2314            ! remove dimension from file 
     2315            CALL dim_clean(td_mpp%t_dim(:)) 
     2316            ! copy dimension in file, except one 
     2317            td_mpp%t_dim(1:td_mpp%i_ndim)=dim_copy(tl_dim(:)) 
     2318 
     2319            ! update number of dimension 
     2320            td_mpp%i_ndim=td_mpp%i_ndim-1 
     2321 
     2322            ! update dimension id 
     2323            DO ji=1,td_mpp%i_ndim 
     2324               td_mpp%t_dim(ji)%i_id=ji 
     2325            ENDDO 
     2326 
     2327            ! clean 
     2328            CALL dim_clean(tl_dim(:)) 
     2329            DEALLOCATE(tl_dim) 
     2330 
     2331         ENDIF 
     2332 
    23052333      ENDIF 
    23062334 
    … …  
    23122340   !> 
    23132341   !> @author J.Paul 
    2314    !> @date November, 2013 - Initial Version 
     2342   !> - November, 2013- Initial Version 
    23152343   !> 
    23162344   !> @param[inout] td_mpp mpp structure 
    … …  
    24602488            &  ", in mpp structure "//TRIM(td_mpp%c_name) ) 
    24612489 
    2462             IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN 
     2490            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN 
    24632491               DO ji=1,td_mpp%t_proc(1)%i_natt 
    24642492                  CALL logger_debug( "MPP DEL ATT: in mpp structure : & 
    2465                   &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) ) 
     2493                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) ) 
    24662494               ENDDO 
    24672495            ENDIF 
    … …  
    24882516   !> @author J.Paul 
    24892517   !> @date November, 2013 - Initial version 
    2490    !> @date February, 2015  
    2491    !> - define local attribute structure to avoid mistake with pointer 
    24922518   ! 
    24932519   !> @param[inout] td_mpp    mpp strcuture 
    … …  
    25012527 
    25022528      ! local variable 
    2503       INTEGER(i4) :: il_attid 
    2504       TYPE(TATT)  :: tl_att 
     2529      INTEGER(i4)       :: il_attid 
    25052530      !---------------------------------------------------------------- 
    25062531      ! check if mpp exist 
    … …  
    25262551            IF( il_attid == 0 )THEN 
    25272552 
    2528                CALL logger_debug( & 
     2553               CALL logger_warn( & 
    25292554               &  "MPP DEL ATT : there is no attribute with "//& 
    25302555               &  "name "//TRIM(cd_name)//" in mpp structure "//& 
    … …  
    25332558            ELSE 
    25342559 
    2535                tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid)) 
    2536                CALL mpp_del_att(td_mpp, tl_att)  
     2560               CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid))  
    25372561 
    25382562            ENDIF 
    … …  
    28392863 
    28402864            CALL logger_info("MPP OPTIMIZ: number of processor "//& 
    2841             &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2842             &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
     2865            &  TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28432866            IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 
    28442867            &   tl_mpp%i_nproc <= il_maxproc )THEN 
    28452868               ! save optimiz decomposition  
    2846  
    2847                CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
    2848                &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2849                &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28502869 
    28512870               ! clean mpp 
    … …  
    31273146   !> 
    31283147   !> @author J.Paul 
    3129    !> @date November, 2013 - Initial version 
     3148   !> @date November, 2013 
    31303149   !> 
    31313150   !> @param[inout] td_mpp mpp strcuture 
    … …  
    31653184   !> 
    31663185   !> @author J.Paul 
    3167    !> @date November, 2013 - Initial version 
     3186   !> @date November, 2013 
    31683187   !> 
    31693188   !> @param[in] td_mpp    mpp strcuture 
    … …  
    32303249   ! 
    32313250   !> @author J.Paul 
    3232    !> @date November, 2013 - Initial version 
     3251   !> @date November, 2013 
    32333252   ! 
    32343253   !> @param[in] td_mpp    mpp strcuture 
    … …  
    32923311   !> 
    32933312   !> @author J.Paul 
    3294    !> @date November, 2013 - Initial version 
     3313   !> @date November, 2013 
    32953314   !> 
    32963315   !> @param[inout] td_mpp mpp strcuture 
    … …  
    33853404   !> 
    33863405   !> @author J.Paul 
    3387    !> @date November, 2013 - Initial Version 
     3406   !> - November, 2013- Initial Version 
    33883407   !> 
    33893408   !> @param[in] td_mpp mpp structure 
    … …  
    33983417 
    33993418      ! local variable 
     3419      INTEGER(i4) :: il_ndim 
    34003420 
    34013421      ! loop indices 
    … …  
    34093429         mpp__check_var_dim=.FALSE. 
    34103430 
     3431         CALL logger_error( & 
     3432         &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
     3433         &  " for variable "//TRIM(td_var%c_name)//& 
     3434         &  " and mpp "//TRIM(td_mpp%c_name)) 
     3435 
    34113436         CALL logger_debug( & 
    34123437         &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//& 
    34133438         &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) ) 
    3414          DO ji = 1, ip_maxdim 
     3439         il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim ) 
     3440         DO ji = 1, il_ndim 
    34153441            CALL logger_debug( & 
    34163442            &  "MPP CHECK DIM: for dimension "//& 
    … …  
    34223448            &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use))) 
    34233449         ENDDO 
    3424  
    3425          CALL logger_error( & 
    3426          &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
    3427          &  " for variable "//TRIM(td_var%c_name)//& 
    3428          &  " and mpp "//TRIM(td_mpp%c_name)) 
    3429  
    34303450      ENDIF 
    34313451 
    … …  
    34363456   ! 
    34373457   !> @author J.Paul 
    3438    !> @date November, 2013 - Initial Version 
     3458   !> - November, 2013- Initial Version 
    34393459   ! 
    34403460   !> @param[in] td_file   array of file structure 
    … …  
    34763496   ! 
    34773497   !> @author J.Paul 
    3478    !> @date Ocotber, 2014 - Initial Version 
     3498   !> - Ocotber, 2014- Initial Version 
    34793499   ! 
    34803500   !> @param[in] td_mpp   mpp file structure 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/multi.f90

    r10248 r10251  
    6161!> @date October, 2014 
    6262!> - use mpp file structure instead of file 
    63 !> @date November, 2014  
    64 !> - Fix memory leaks bug 
     63!> @date November, 2014 - Fix memory leaks bug 
    6564! 
    6665!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    119118   !>    
    120119   !> @author J.Paul 
    121    !> @date November, 2013 - Initial Version 
     120   !> - November, 2013- Initial Version 
    122121   !> @date November, 2014 
    123122   !>    - use function instead of overload assignment operator (to avoid memory leak) 
    … …  
    170169   !> 
    171170   !> @author J.Paul 
    172    !> @date November, 2013 - Initial Version 
    173    !> @date July, 2015  
    174    !> - check if variable to be read is in file 
     171   !> - November, 2013- Initial Version 
    175172   !> 
    176173   !> @param[in] cd_varfile   variable location information (from namelist)  
    … …  
    193190 
    194191      INTEGER(i4)       :: il_nvar 
    195       INTEGER(i4)       :: il_varid 
    196192 
    197193      LOGICAL           :: ll_dim 
    … …  
    246242                  ! define variable 
    247243                  IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 
    248  
    249                      ! check if variable is in file 
    250                      il_varid=var_get_index(tl_mpp%t_proc(1)%t_var(:),cl_lower) 
    251                      IF( il_varid == 0 )THEN 
    252                         CALL logger_fatal("MULTI INIT: variable "//& 
    253                            & TRIM(cl_name)//" not in file "//& 
    254                            & TRIM(cl_file) ) 
    255                      ENDIF 
    256244 
    257245                     ! clean var 
    … …  
    329317   ! 
    330318   !> @author J.Paul 
    331    !> @date November, 2013 - Initial Version 
     319   !> - November, 2013- Initial Version 
    332320   ! 
    333321   !> @param[in] td_multi  multi file structure 
    … …  
    360348   ! 
    361349   !> @author J.Paul 
    362    !> @date November, 2013 - Initial Version 
     350   !> - November, 2013- Initial Version 
    363351   ! 
    364352   !> @param[in] td_multi multi file structure 
    … …  
    403391   ! 
    404392   !> @author J.Paul 
    405    !> @date November, 2013 - Initial Version 
     393   !> - November, 2013- Initial Version 
    406394   !> @date October, 2014 
    407395   !> - use mpp file structure instead of file 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/phycst.f90

    r10248 r10251  
    2525   PUBLIC :: dp_rearth  !< earth radius (km) 
    2626   PUBLIC :: dp_deg2rad !< degree to radian ratio  
    27    PUBLIC :: dp_rad2deg !< radian to degree ratio  
    2827   PUBLIC :: dp_delta   !<   
    2928 
    … …  
    3231   REAL(dp), PARAMETER :: dp_rearth = 6871._dp 
    3332   REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0 
    34    REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi 
    3533 
    36    REAL(dp), PARAMETER :: dp_delta=1.e-6 
     34   REAL(dp), PARAMETER :: dp_delta=1.e-2 
    3735END MODULE phycst 
    3836 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/variable.f90

    r10248 r10251  
    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 
    287283! 
    288284!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    297293   USE att                             ! attribute manager 
    298294   USE dim                             ! dimension manager 
    299    USE math                            ! mathematical function 
    300295   IMPLICIT NONE 
    301296   ! NOTE_avoid_public_variables_if_possible 
    … …  
    323318   PUBLIC :: var_concat        !< concatenate two variables 
    324319   PUBLIC :: var_limit_value   !< forced min and max value 
    325    PUBLIC :: var_chg_unit      !< change variable unit and value 
    326320   PUBLIC :: var_max_dim       !< get array of maximum dimension use 
    327321   PUBLIC :: var_reorder       !< reorder table of value in variable structure 
    … …  
    388382   PRIVATE :: var__get_max       ! get maximum value from namelist  
    389383   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 
    392384   PRIVATE :: var__get_interp    ! get interpolation method from namelist 
    393385   PRIVATE :: var__get_extrap    ! get extrapolation method from namelist 
    … …  
    409401      TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes 
    410402      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension 
    411   
     403       
    412404      LOGICAL           :: l_file = .FALSE.  !< variable read in a file 
    413405 
    … …  
    422414      REAL(dp)          :: d_min = dp_fill      !< minimum value  
    423415      REAL(dp)          :: d_max = dp_fill      !< maximum value  
    424   
    425       CHARACTER(LEN=lc) :: c_unt = ''           !< new variables units (linked to units factor) 
    426       REAL(dp)          :: d_unf = 1._dp        !< units factor 
    427  
     416       
    428417      !!! netcdf4 
    429418      LOGICAL           :: l_contiguous = .FALSE. !< use contiguous storage or not 
    … …  
    529518   !> 
    530519   !> @author J.Paul 
    531    !> @date November, 2013 - Initial Version 
     520   !> - November, 2013- Initial Version 
    532521   !> @date November, 2014 
    533522   !> - use function instead of overload assignment operator (to avoid memory leak) 
    … …  
    559548      var__copy_unit%d_min      = td_var%d_min 
    560549      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 
    564550 
    565551      var__copy_unit%i_type     = td_var%i_type 
    … …  
    591577      var__copy_unit%c_units    = TRIM(td_var%c_units) 
    592578      var__copy_unit%c_axis     = TRIM(td_var%c_axis) 
    593       var__copy_unit%d_unf      = td_var%d_unf 
    594579      var__copy_unit%d_scf      = td_var%d_scf 
    595580      var__copy_unit%d_ofs      = td_var%d_ofs 
    … …  
    642627   !> 
    643628   !> @author J.Paul 
    644    !> @date November, 2013 - Initial Version 
     629   !> - November, 2013- Initial Version 
    645630   !> @date November, 2014 
    646631   !> - use function instead of overload assignment operator  
    … …  
    671656   !> 
    672657   !> @author J.Paul 
    673    !> @date November, 2013 - Initial Version 
     658   !> - November, 2013- Initial Version 
    674659   !> 
    675660   !> @param[inout] td_var variable strucutre 
    … …  
    710695   ! 
    711696   !> @author J.Paul 
    712    !> @date September, 2014 - Initial Version 
     697   !> - September, 2014- Initial Version 
    713698   ! 
    714699   !> @param[inout] td_var array of variable strucutre 
    … …  
    733718   ! 
    734719   !> @author J.Paul 
    735    !> @date September, 2014 - Initial Version 
     720   !> - September, 2014- Initial Version 
    736721   ! 
    737722   !> @param[inout] td_var array of variable strucutre 
    … …  
    759744   ! 
    760745   !> @author J.Paul 
    761    !> @date September, 2014 - Initial Version 
     746   !> - September, 2014- Initial Version 
    762747   ! 
    763748   !> @param[inout] td_var array of variable strucutre 
    … …  
    803788   !>   - id_id : variable id (read from a file). 
    804789   !>   - id_ew : number of point composing east west wrap band. 
    805    !>   - dd_unf : real(8) value for units factor attribute. 
    806790   !>   - dd_scf : real(8) value for scale factor attribute. 
    807791   !>   - dd_ofs : real(8) value for add offset attribute. 
    … …  
    817801   !>   - cd_extrap  : a array of character defining extrapolation method. 
    818802   !>   - 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 
    821803   !> 
    822804   !>  @note most of these optionals arguments will be inform automatically, 
    … …  
    824806   !> 
    825807   !> @author J.Paul 
    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) 
     808   !> - November, 2013- Initial Version 
    831809   !> 
    832810   !> @param[in] cd_name         variable name 
    … …  
    855833   !> @param[in] cd_extrap       extrapolation method 
    856834   !> @param[in] cd_filter       filter method 
    857    !> @param[in] cd_unt          new units (linked to units factor) 
    858    !> @param[in] dd_unf          units factor 
    859835   !> @return variable structure 
    860836   !------------------------------------------------------------------- 
    … …  
    867843   &                              ld_contiguous, ld_shuffle,& 
    868844   &                              ld_fletcher32, id_deflvl, id_chunksz, & 
    869    &                              cd_interp, cd_extrap, cd_filter, & 
    870    &                              cd_unt, dd_unf ) 
     845   &                              cd_interp, cd_extrap, cd_filter ) 
    871846      IMPLICIT NONE 
    872847      ! Argument 
    … …  
    896871      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
    897872      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 
    900873 
    901874 
    … …  
    960933               tl_att=att_init('_FillValue', INT(dd_fill,i4) ) 
    961934            CASE(NF90_FLOAT) 
    962                tl_att=att_init('_FillValue', REAL(dd_fill,sp) ) 
     935               tl_att=att_init('_FillValue', INT(dd_fill,sp) ) 
    963936            CASE DEFAULT ! NF90_DOUBLE 
    964                tl_att=att_init('_FillValue', dd_fill ) 
     937                     tl_att=att_init('_FillValue', dd_fill ) 
    965938         END SELECT 
    966939         CALL var_move_att(var__init, tl_att) 
    … …  
    10651038      ENDIF 
    10661039 
    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  
    10791040      ! add extra information 
    10801041      CALL var__get_extra(var__init) 
    … …  
    10861047      CALL var_del_att(var__init, 'filter') 
    10871048      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') 
    10901049      CALL var_del_att(var__init, 'valid_min') 
    10911050      CALL var_del_att(var__init, 'valid_max') 
    … …  
    11131072   ! 
    11141073   !> @author J.Paul 
    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    !> 
     1074   !> - November, 2013- Initial Version 
     1075   ! 
    11211076   !> @param[in] cd_name         variable name 
    11221077   !> @param[in] dd_value        1D array of real(8) value 
    … …  
    11451100   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use 
    11461101   !> @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 
    11521102   !> @return variable structure 
    11531103   !------------------------------------------------------------------- 
    … …  
    11601110   &                                    dd_min, dd_max,           & 
    11611111   &                                    ld_contiguous, ld_shuffle,& 
    1162    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    1163    &                                    cd_interp, cd_extrap, cd_filter, & 
    1164    &                                    cd_unt, dd_unf) 
     1112   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    11651113      IMPLICIT NONE 
    11661114      ! Argument 
    … …  
    11901138      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    11911139      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 
    11971140 
    11981141      ! local variable 
    … …  
    12501193      &                          ld_fletcher32=ld_fletcher32,        & 
    12511194      &                          id_deflvl=id_deflvl,                & 
    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 ) 
     1195      &                          id_chunksz=id_chunksz(:)) 
    12571196    
    12581197      ! add value 
    … …  
    13001239   ! 
    13011240   !> @author J.Paul 
    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) 
     1241   !> - November, 2013- Initial Version 
    13111242   ! 
    13121243   !> @param[in] cd_name         variable name 
    … …  
    13381269   !> no deflation is in use 
    13391270   !> @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 
    13451271   !> @return variable structure 
    13461272   !------------------------------------------------------------------- 
    … …  
    13531279   &                                    dd_min, dd_max,           & 
    13541280   &                                    ld_contiguous, ld_shuffle,& 
    1355    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    1356    &                                    cd_interp, cd_extrap, cd_filter, & 
    1357    &                                    cd_unt, dd_unf) 
     1281   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    13581282      IMPLICIT NONE 
    13591283      ! Argument 
    … …  
    13831307      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    13841308      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 
    13901309 
    13911310      ! local variable 
    … …  
    14311350      ENDIF 
    14321351 
    1433       il_count(:)=tl_dim(:)%i_len 
     1352      il_count(:)=tl_dim(1)%i_len 
    14341353      IF( PRESENT(id_count) )THEN 
    14351354         IF( SIZE(id_count(:)) /= 2 )THEN 
    … …  
    14621381      &                          ld_fletcher32=ld_fletcher32,        & 
    14631382      &                          id_deflvl=id_deflvl,                & 
    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 ) 
     1383      &                          id_chunksz=id_chunksz(:)) 
    14691384    
    14701385      ! add value 
    … …  
    15161431   ! 
    15171432   !> @author J.Paul 
    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    !> 
     1433   !> - November, 2013- Initial Version 
     1434   ! 
    15241435   !> @param[in] cd_name         variable name 
    15251436   !> @param[in] dd_value        1D array of real(8) value 
    … …  
    15501461   !> deflation is in use 
    15511462   !> @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 
    15571463   !> @return variable structure 
    15581464   !------------------------------------------------------------------- 
    … …  
    15651471   &                                    dd_min, dd_max,           & 
    15661472   &                                    ld_contiguous, ld_shuffle,& 
    1567    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    1568    &                                    cd_interp, cd_extrap, cd_filter, & 
    1569    &                                    cd_unt, dd_unf) 
     1473   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    15701474      IMPLICIT NONE 
    15711475      ! Argument 
    … …  
    15951499      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    15961500      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 
    16021501 
    16031502      ! local variable 
    … …  
    16781577      &                          ld_fletcher32=ld_fletcher32,        & 
    16791578      &                          id_deflvl=id_deflvl,                & 
    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 ) 
     1579      &                          id_chunksz=id_chunksz(:)) 
    16851580    
    16861581      ! add value 
    … …  
    17281623   ! 
    17291624   !> @author J.Paul 
    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    !> 
     1625   !> - November, 2013- Initial Version 
     1626   ! 
    17361627   !> @param[in] cd_name         variable name 
    17371628   !> @param[in] dd_value        4D array of real(8) value 
    … …  
    17621653   !> deflation is in use 
    17631654   !> @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 
    17691655   !> @return variable structure 
    17701656   !------------------------------------------------------------------- 
    … …  
    17771663   &                                 dd_min, dd_max,           & 
    17781664   &                                 ld_contiguous, ld_shuffle,& 
    1779    &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
    1780    &                                 cd_interp, cd_extrap, cd_filter, & 
    1781    &                                 cd_unt, dd_unf ) 
     1665   &                                 ld_fletcher32, id_deflvl, id_chunksz) 
    17821666      IMPLICIT NONE 
    17831667      ! Argument 
    … …  
    18071691      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    18081692      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 
    18141693 
    18151694      ! local variable 
    … …  
    18441723      &                       ld_fletcher32=ld_fletcher32,        & 
    18451724      &                       id_deflvl=id_deflvl,                & 
    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 ) 
     1725      &                       id_chunksz=id_chunksz(:)) 
    18511726  
    18521727      ! add value 
    … …  
    18831758   ! 
    18841759   !> @author J.Paul 
    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) 
     1760   !> - November, 2013- Initial Version 
    18901761   ! 
    18911762   !> @param[in] cd_name         variable name 
    … …  
    19171788   !> deflation is in use 
    19181789   !> @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 
    19241790   !> @return variable structure 
    19251791   !------------------------------------------------------------------- 
    … …  
    19321798   &                                    dd_min, dd_max,           & 
    19331799   &                                    ld_contiguous, ld_shuffle,& 
    1934    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    1935    &                                    cd_interp, cd_extrap, cd_filter, & 
    1936    &                                    cd_unt, dd_unf) 
     1800   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    19371801 
    19381802      IMPLICIT NONE 
    … …  
    19631827      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    19641828      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  
    19711829 
    19721830      ! local variable 
    … …  
    20121870      &                         ld_fletcher32=ld_fletcher32,        & 
    20131871      &                         id_deflvl=id_deflvl,                & 
    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 ) 
     1872      &                         id_chunksz=id_chunksz(:)) 
    20191873  
    20201874      DEALLOCATE( dl_value ) 
    … …  
    20381892   ! 
    20391893   !> @author J.Paul 
    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) 
     1894   !> - November, 2013- Initial Version 
    20451895   ! 
    20461896   !> @param[in] cd_name         : variable name 
    … …  
    20721922   !> deflation is in use 
    20731923   !> @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 
    20791924   !> @return variable structure 
    20801925   !------------------------------------------------------------------- 
    … …  
    20871932   &                                    dd_min, dd_max,           & 
    20881933   &                                    ld_contiguous, ld_shuffle,& 
    2089    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    2090    &                                    cd_interp, cd_extrap, cd_filter, & 
    2091    &                                    cd_unt, dd_unf) 
     1934   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    20921935 
    20931936      IMPLICIT NONE 
    … …  
    21181961      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    21191962      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 
    21251963 
    21261964      ! local variable 
    … …  
    21682006      &                         ld_fletcher32=ld_fletcher32,        & 
    21692007      &                         id_deflvl=id_deflvl,                & 
    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 ) 
     2008      &                         id_chunksz=id_chunksz(:)) 
    21752009       
    21762010      DEALLOCATE( dl_value ) 
    … …  
    21942028   ! 
    21952029   !> @author J.Paul 
    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) 
     2030   !> - November, 2013- Initial Version 
    22012031   ! 
    22022032   !> @param[in] cd_name         : variable name 
    … …  
    22282058   !> deflation is in use 
    22292059   !> @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 
    22352060   !> @return variable structure 
    22362061   !------------------------------------------------------------------- 
    … …  
    22432068   &                                    dd_min, dd_max,           & 
    22442069   &                                    ld_contiguous, ld_shuffle,& 
    2245    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    2246    &                                    cd_interp, cd_extrap, cd_filter, & 
    2247    &                                    cd_unt, dd_unf) 
     2070   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    22482071 
    22492072      IMPLICIT NONE 
    … …  
    22742097      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    22752098      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 
    22812099 
    22822100      ! local variable 
    … …  
    23252143      &                         ld_fletcher32=ld_fletcher32,        & 
    23262144      &                         id_deflvl=id_deflvl,                & 
    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) 
     2145      &                         id_chunksz=id_chunksz(:)) 
    23322146       
    23332147      DEALLOCATE( dl_value ) 
    … …  
    23512165   ! 
    23522166   !> @author J.Paul 
    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) 
     2167   !> - November, 2013- Initial Version 
    23582168   ! 
    23592169   !> @param[in] cd_name         variable name 
    … …  
    23852195   !> deflation is in use 
    23862196   !> @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 
    23922197   !> @return variable structure 
    23932198   !------------------------------------------------------------------- 
    … …  
    24002205   &                                 dd_min, dd_max,           & 
    24012206   &                                 ld_contiguous, ld_shuffle,& 
    2402    &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
    2403    &                                 cd_interp, cd_extrap, cd_filter, & 
    2404    &                                 cd_unt, dd_unf) 
     2207   &                                 ld_fletcher32, id_deflvl, id_chunksz) 
    24052208 
    24062209      IMPLICIT NONE 
    … …  
    24312234      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    24322235      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 
    24382236 
    24392237      ! local variable 
    … …  
    24832281      &                      ld_fletcher32=ld_fletcher32,        & 
    24842282      &                      id_deflvl=id_deflvl,                & 
    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) 
     2283      &                      id_chunksz=id_chunksz(:)) 
    24902284       
    24912285      DEALLOCATE( dl_value ) 
    … …  
    25092303   ! 
    25102304   !> @author J.Paul 
    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) 
     2305   !> - November, 2013- Initial Version 
    25162306   ! 
    25172307   !> @param[in] cd_name         : variable name 
    … …  
    25432333   !> deflation is in use 
    25442334   !> @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 
    25502335   !> @return variable structure 
    25512336   !------------------------------------------------------------------- 
    … …  
    25582343   &                                    dd_min, dd_max,           & 
    25592344   &                                    ld_contiguous, ld_shuffle,& 
    2560    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    2561    &                                    cd_interp, cd_extrap, cd_filter, & 
    2562    &                                    cd_unt, dd_unf) 
     2345   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    25632346 
    25642347      IMPLICIT NONE 
    … …  
    25892372      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    25902373      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 
    25962374 
    25972375      ! local variable 
    … …  
    26372415      &                         ld_fletcher32=ld_fletcher32,        & 
    26382416      &                         id_deflvl=id_deflvl,                & 
    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) 
     2417      &                         id_chunksz=id_chunksz(:)) 
    26442418  
    26452419      DEALLOCATE( dl_value ) 
    … …  
    26632437   ! 
    26642438   !> @author J.Paul 
    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) 
     2439   !> - November, 2013- Initial Version 
    26702440   ! 
    26712441   !> @param[in] cd_name         variable name 
    … …  
    26952465   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use 
    26962466   !> @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 
    27022467   !> @return variable structure 
    27032468   !------------------------------------------------------------------- 
    … …  
    27102475   &                                    dd_min, dd_max,           & 
    27112476   &                                    ld_contiguous, ld_shuffle,& 
    2712    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    2713    &                                    cd_interp, cd_extrap, cd_filter, & 
    2714    &                                    cd_unt, dd_unf) 
     2477   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    27152478 
    27162479      IMPLICIT NONE 
    … …  
    27412504      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    27422505      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 
    27482506 
    27492507      ! local variable 
    … …  
    27912549      &                         ld_fletcher32=ld_fletcher32,        & 
    27922550      &                         id_deflvl=id_deflvl,                & 
    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) 
     2551      &                         id_chunksz=id_chunksz(:)) 
    27982552       
    27992553      DEALLOCATE( dl_value ) 
    … …  
    28172571   ! 
    28182572   !> @author J.Paul 
    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) 
     2573   !> - November, 2013- Initial Version 
    28242574   ! 
    28252575   !> @param[in] cd_name         variable name 
    … …  
    28512601   !> deflation is in use 
    28522602   !> @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 
    28582603   !> @return variable structure 
    28592604   !------------------------------------------------------------------- 
    … …  
    28662611   &                                    dd_min, dd_max,           & 
    28672612   &                                    ld_contiguous, ld_shuffle,& 
    2868    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    2869    &                                    cd_interp, cd_extrap, cd_filter, & 
    2870    &                                    cd_unt, dd_unf) 
     2613   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    28712614 
    28722615      IMPLICIT NONE 
    … …  
    28972640      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    28982641      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 
    29042642 
    29052643      ! local variable 
    … …  
    29482686      &                         ld_fletcher32=ld_fletcher32,        & 
    29492687      &                         id_deflvl=id_deflvl,                & 
    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) 
     2688      &                         id_chunksz=id_chunksz(:)) 
    29552689       
    29562690      DEALLOCATE( dl_value ) 
    … …  
    29742708   ! 
    29752709   !> @author J.Paul 
    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) 
     2710   !> - November, 2013- Initial Version 
    29812711   ! 
    29822712   !> @param[in] cd_name         variable name 
    … …  
    30082738   !> deflation is in use 
    30092739   !> @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 
    30152740   !> @return variable structure 
    30162741   !------------------------------------------------------------------- 
    … …  
    30232748   &                                 dd_min, dd_max,           & 
    30242749   &                                 ld_contiguous, ld_shuffle,& 
    3025    &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
    3026    &                                 cd_interp, cd_extrap, cd_filter, & 
    3027    &                                 cd_unt, dd_unf) 
     2750   &                                 ld_fletcher32, id_deflvl, id_chunksz) 
    30282751 
    30292752      IMPLICIT NONE 
    … …  
    30542777      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    30552778      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  
    30622779 
    30632780      ! local variable 
    … …  
    31072824      &                      ld_fletcher32=ld_fletcher32,        & 
    31082825      &                      id_deflvl=id_deflvl,                & 
    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) 
     2826      &                      id_chunksz=id_chunksz(:)) 
    31142827       
    31152828      DEALLOCATE( dl_value ) 
    … …  
    31332846   ! 
    31342847   !> @author J.Paul 
    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) 
     2848   !> - November, 2013- Initial Version 
    31402849   ! 
    31412850   !> @param[in] cd_name         variable name 
    … …  
    31672876   !> deflation is in use 
    31682877   !> @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 
    31742878   !> @return variable structure 
    31752879   !------------------------------------------------------------------- 
    … …  
    31822886   &                                    dd_min, dd_max,           & 
    31832887   &                                    ld_contiguous, ld_shuffle,& 
    3184    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    3185    &                                    cd_interp, cd_extrap, cd_filter, & 
    3186    &                                    cd_unt, dd_unf) 
     2888   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    31872889 
    31882890      IMPLICIT NONE 
    … …  
    32132915      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    32142916      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 
    32202917 
    32212918      ! local variable 
    … …  
    32612958      &                         ld_fletcher32=ld_fletcher32,        & 
    32622959      &                         id_deflvl=id_deflvl,                & 
    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) 
     2960      &                         id_chunksz=id_chunksz(:)) 
    32682961  
    32692962      DEALLOCATE( dl_value ) 
    … …  
    32872980   ! 
    32882981   !> @author J.Paul 
    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) 
     2982   !> - November, 2013- Initial Version 
    32942983   ! 
    32952984   !> @param[in] cd_name         variable name 
    … …  
    33213010   !> deflation is in use 
    33223011   !> @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 
    33283012   !> @return variable structure 
    33293013   !------------------------------------------------------------------- 
    … …  
    33363020   &                                    dd_min, dd_max,           & 
    33373021   &                                    ld_contiguous, ld_shuffle,& 
    3338    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    3339    &                                    cd_interp, cd_extrap, cd_filter, & 
    3340    &                                    cd_unt, dd_unf) 
     3022   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    33413023 
    33423024      IMPLICIT NONE 
    … …  
    33673049      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    33683050      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 
    33743051 
    33753052      ! local variable 
    … …  
    34173094      &                         ld_fletcher32=ld_fletcher32,        & 
    34183095      &                         id_deflvl=id_deflvl,                & 
    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) 
     3096      &                         id_chunksz=id_chunksz(:)) 
    34243097       
    34253098      DEALLOCATE( dl_value ) 
    … …  
    34433116   ! 
    34443117   !> @author J.Paul 
    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) 
     3118   !> - November, 2013- Initial Version 
    34503119   ! 
    34513120   !> @param[in] cd_name         variable name 
    … …  
    34773146   !> deflation is in use 
    34783147   !> @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 
    34843148   !> @return variable structure 
    34853149   !------------------------------------------------------------------- 
    … …  
    34923156   &                                    dd_min, dd_max,           & 
    34933157   &                                    ld_contiguous, ld_shuffle,& 
    3494    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    3495    &                                    cd_interp, cd_extrap, cd_filter, & 
    3496    &                                    cd_unt, dd_unf) 
     3158   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    34973159 
    34983160      IMPLICIT NONE 
    … …  
    35233185      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    35243186      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 
    35303187 
    35313188      ! local variable 
    … …  
    35743231      &                         ld_fletcher32=ld_fletcher32,        & 
    35753232      &                         id_deflvl=id_deflvl,                & 
    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) 
     3233      &                         id_chunksz=id_chunksz(:)) 
    35813234       
    35823235      DEALLOCATE( dl_value ) 
    … …  
    36003253   ! 
    36013254   !> @author J.Paul 
    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) 
     3255   !> - November, 2013- Initial Version 
    36073256   ! 
    36083257   !> @param[in] cd_name         variable name 
    … …  
    36343283   !> deflation is in use 
    36353284   !> @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  
    36423285   !> @return variable structure 
    36433286   !------------------------------------------------------------------- 
    … …  
    36503293   &                                 dd_min, dd_max,           & 
    36513294   &                                 ld_contiguous, ld_shuffle,& 
    3652    &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
    3653    &                                 cd_interp, cd_extrap, cd_filter, & 
    3654    &                                 cd_unt, dd_unf) 
     3295   &                                 ld_fletcher32, id_deflvl, id_chunksz) 
    36553296 
    36563297      IMPLICIT NONE 
    … …  
    36813322      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    36823323      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 
    36883324 
    36893325      ! local variable 
    … …  
    37333369      &                      ld_fletcher32=ld_fletcher32,        & 
    37343370      &                      id_deflvl=id_deflvl,                & 
    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) 
     3371      &                      id_chunksz=id_chunksz(:)) 
    37403372       
    37413373      DEALLOCATE( dl_value ) 
    … …  
    37593391   ! 
    37603392   !> @author J.Paul 
    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) 
     3393   !> - November, 2013- Initial Version 
    37663394   ! 
    37673395   !> @param[in] cd_name         variable name 
    … …  
    37933421   !> deflation is in use 
    37943422   !> @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 
    38003423   !> @return variable structure 
    38013424   !------------------------------------------------------------------- 
    … …  
    38083431   &                                    dd_min, dd_max,           & 
    38093432   &                                    ld_contiguous, ld_shuffle,& 
    3810    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    3811    &                                    cd_interp, cd_extrap, cd_filter, & 
    3812    &                                    cd_unt, dd_unf) 
     3433   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    38133434 
    38143435      IMPLICIT NONE 
    … …  
    38393460      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    38403461      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  
    38473462 
    38483463      ! local variable 
    … …  
    38883503      &                         ld_fletcher32=ld_fletcher32,        & 
    38893504      &                         id_deflvl=id_deflvl,                & 
    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) 
     3505      &                         id_chunksz=id_chunksz(:)) 
    38953506  
    38963507      DEALLOCATE( dl_value ) 
    … …  
    39143525   ! 
    39153526   !> @author J.Paul 
    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) 
     3527   !> - November, 2013- Initial Version 
    39213528   ! 
    39223529   !> @param[in] cd_name         variable name 
    … …  
    39483555   !> deflation is in use 
    39493556   !> @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 
    39553557   !> @return variable structure 
    39563558   !------------------------------------------------------------------- 
    … …  
    39633565   &                                    dd_min, dd_max,           & 
    39643566   &                                    ld_contiguous, ld_shuffle,& 
    3965    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    3966    &                                    cd_interp, cd_extrap, cd_filter, & 
    3967    &                                    cd_unt, dd_unf) 
     3567   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    39683568 
    39693569      IMPLICIT NONE 
    … …  
    39943594      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    39953595      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  
    40023596 
    40033597      ! local variable 
    … …  
    40453639      &                         ld_fletcher32=ld_fletcher32,        & 
    40463640      &                         id_deflvl=id_deflvl,                & 
    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) 
     3641      &                         id_chunksz=id_chunksz(:)) 
    40523642       
    40533643      DEALLOCATE( dl_value ) 
    … …  
    40713661   ! 
    40723662   !> @author J.Paul 
    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) 
     3663   !> - November, 2013- Initial Version 
    40783664   ! 
    40793665   !> @param[in] cd_name         variable name 
    … …  
    41053691   !> deflation is in use 
    41063692   !> @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 
    41123693   !> @return variable structure 
    41133694   !------------------------------------------------------------------- 
    … …  
    41203701   &                                    dd_min, dd_max,           & 
    41213702   &                                    ld_contiguous, ld_shuffle,& 
    4122    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    4123    &                                    cd_interp, cd_extrap, cd_filter, & 
    4124    &                                    cd_unt, dd_unf) 
     3703   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    41253704 
    41263705      IMPLICIT NONE 
    … …  
    41513730      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    41523731      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 
    41583732 
    41593733      ! local variable 
    … …  
    42023776      &                         ld_fletcher32=ld_fletcher32,        & 
    42033777      &                         id_deflvl=id_deflvl,                & 
    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) 
     3778      &                         id_chunksz=id_chunksz(:)) 
    42093779       
    42103780      DEALLOCATE( dl_value ) 
    … …  
    42283798   ! 
    42293799   !> @author J.Paul 
    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) 
     3800   !> - November, 2013- Initial Version 
    42353801   ! 
    42363802   !> @param[in] cd_name         variable name 
    … …  
    42623828   !> deflation is in use 
    42633829   !> @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 
    42693830   !> @return variable structure 
    42703831   !------------------------------------------------------------------- 
    … …  
    42773838   &                                 dd_min, dd_max,           & 
    42783839   &                                 ld_contiguous, ld_shuffle,& 
    4279    &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
    4280    &                                 cd_interp, cd_extrap, cd_filter, & 
    4281    &                                 cd_unt, dd_unf) 
     3840   &                                 ld_fletcher32, id_deflvl, id_chunksz) 
    42823841 
    42833842      IMPLICIT NONE 
    … …  
    43083867      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    43093868      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 
    43153869 
    43163870      ! local variable 
    … …  
    43603914      &                      ld_fletcher32=ld_fletcher32,        & 
    43613915      &                      id_deflvl=id_deflvl,                & 
    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) 
     3916      &                      id_chunksz=id_chunksz(:)) 
    43673917       
    43683918      DEALLOCATE( dl_value ) 
    … …  
    43863936   ! 
    43873937   !> @author J.Paul 
    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) 
     3938   !> - November, 2013- Initial Version 
    43933939   ! 
    43943940   !> @param[in] cd_name         variable name 
    … …  
    44203966   !> deflation is in use 
    44213967   !> @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 
    44273968   !> @return variable structure 
    44283969   !------------------------------------------------------------------- 
    … …  
    44353976   &                                    dd_min, dd_max,           & 
    44363977   &                                    ld_contiguous, ld_shuffle,& 
    4437    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    4438    &                                    cd_interp, cd_extrap, cd_filter, & 
    4439    &                                    cd_unt, dd_unf) 
     3978   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    44403979 
    44413980      IMPLICIT NONE 
    … …  
    44664005      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    44674006      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 
    44734007 
    44744008      ! local variable 
    … …  
    45144048      &                         ld_fletcher32=ld_fletcher32,        & 
    45154049      &                         id_deflvl=id_deflvl,                & 
    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) 
     4050      &                         id_chunksz=id_chunksz(:)) 
    45214051  
    45224052      DEALLOCATE( dl_value ) 
    … …  
    45404070   ! 
    45414071   !> @author J.Paul 
    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) 
     4072   !> - November, 2013- Initial Version 
    45474073   ! 
    45484074   !> @param[in] cd_name         variable name 
    … …  
    45744100   !> deflation is in use 
    45754101   !> @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 
    45814102   !> @return variable structure 
    45824103   !------------------------------------------------------------------- 
    … …  
    45894110   &                                    dd_min, dd_max,           & 
    45904111   &                                    ld_contiguous, ld_shuffle,& 
    4591    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    4592    &                                    cd_interp, cd_extrap, cd_filter, & 
    4593    &                                    cd_unt, dd_unf) 
     4112   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    45944113 
    45954114      IMPLICIT NONE 
    … …  
    46204139      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    46214140      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 
    46274141 
    46284142      ! local variable 
    … …  
    46704184      &                         ld_fletcher32=ld_fletcher32,        & 
    46714185      &                         id_deflvl=id_deflvl,                & 
    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) 
     4186      &                         id_chunksz=id_chunksz(:)) 
    46774187       
    46784188      DEALLOCATE( dl_value ) 
    … …  
    46964206   ! 
    46974207   !> @author J.Paul 
    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) 
     4208   !> - November, 2013- Initial Version 
    47034209   ! 
    47044210   !> @param[in] cd_name         variable name 
    … …  
    47304236   !> deflation is in use 
    47314237   !> @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 
    47374238   !> @return variable structure 
    47384239   !------------------------------------------------------------------- 
    … …  
    47454246   &                                    dd_min, dd_max,           & 
    47464247   &                                    ld_contiguous, ld_shuffle,& 
    4747    &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
    4748    &                                    cd_interp, cd_extrap, cd_filter, & 
    4749    &                                    cd_unt, dd_unf) 
     4248   &                                    ld_fletcher32, id_deflvl, id_chunksz) 
    47504249 
    47514250      IMPLICIT NONE 
    … …  
    47764275      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    47774276      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 
    47834277 
    47844278      ! local variable 
    … …  
    48274321      &                         ld_fletcher32=ld_fletcher32,        & 
    48284322      &                         id_deflvl=id_deflvl,                & 
    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) 
     4323      &                         id_chunksz=id_chunksz(:)) 
    48344324       
    48354325      DEALLOCATE( dl_value ) 
    … …  
    48534343   ! 
    48544344   !> @author J.Paul 
    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) 
     4345   !> - November, 2013- Initial Version 
    48604346   ! 
    48614347   !> @param[in] cd_name         variable name 
    … …  
    48874373   !> deflation is in use 
    48884374   !> @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 
    48944375   !> @return variable structure 
    48954376   !------------------------------------------------------------------- 
    … …  
    49024383   &                                 dd_min, dd_max,           & 
    49034384   &                                 ld_contiguous, ld_shuffle,& 
    4904    &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
    4905    &                                 cd_interp, cd_extrap, cd_filter, & 
    4906    &                                 cd_unt, dd_unf) 
     4385   &                                 ld_fletcher32, id_deflvl, id_chunksz) 
    49074386 
    49084387      IMPLICIT NONE 
    … …  
    49334412      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    49344413      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 
    49404414 
    49414415      ! local variable 
    … …  
    49854459      &                      ld_fletcher32=ld_fletcher32,        & 
    49864460      &                      id_deflvl=id_deflvl,                & 
    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) 
     4461      &                      id_chunksz=id_chunksz(:)) 
    49924462       
    49934463      DEALLOCATE( dl_value ) 
    … …  
    50034473   !> 
    50044474   !> @author J.Paul 
    5005    !> @date November, 2013 - Initial Version 
     4475   !> - November, 2013- Initial Version 
    50064476   ! 
    50074477   !> @param[in] td_var1   variable structure 
    … …  
    50534523   !>  
    50544524   !> @author J.Paul 
    5055    !> @date November, 2013 - Initial Version 
     4525   !> - November, 2013- Initial Version 
    50564526   ! 
    50574527   !> @param[in] td_var1   variable structure 
    … …  
    51254595   !>  
    51264596   !> @author J.Paul 
    5127    !> @date November, 2013 - Initial Version 
     4597   !> - November, 2013- Initial Version 
    51284598   ! 
    51294599   !> @param[in] td_var1   variable structure 
    … …  
    52004670   !>  
    52014671   !> @author J.Paul 
    5202    !> @date November, 2013 - Initial Version 
     4672   !> - November, 2013- Initial Version 
    52034673   ! 
    52044674   !> @param[in] td_var1   variable structure 
    … …  
    52754745   !>  
    52764746   !> @author J.Paul 
    5277    !> @date November, 2013 - Initial Version 
     4747   !> - November, 2013- Initial Version 
    52784748   ! 
    52794749   !> @param[in] td_var1   variable structure 
    … …  
    53504820   !> 
    53514821   !> @author J.Paul 
    5352    !> @date November, 2013 - Initial Version 
    5353    !> @date June, 2015  
    5354    !> - add all element of the array in the same time 
     4822   !> - November, 2013- Initial Version 
    53554823   !> 
    53564824   !> @param[inout] td_var variable structure 
    … …  
    53654833      ! local variable 
    53664834      INTEGER(i4) :: il_natt 
    5367       INTEGER(i4) :: il_status 
    5368       INTEGER(i4) :: il_ind 
    5369       TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
    53704835 
    53714836      ! loop indices 
    … …  
    53754840      il_natt=SIZE(td_att(:)) 
    53764841 
    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 
    54304842      DO ji=1,il_natt 
    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 
     4843         CALL var_add_att(td_var, td_att(ji)) 
    54394844      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  
    54764845 
    54774846   END SUBROUTINE var__add_att_arr 
    … …  
    54814850   ! 
    54824851   !> @author J.Paul 
    5483    !> @date November, 2013 - Initial Version 
    5484    !> @date June, 2015  
    5485    !> - use var__add_att_arr subroutine 
     4852   !> - November, 2013- Initial Version 
    54864853   ! 
    54874854   !> @param[inout] td_var variable structure 
    … …  
    54954862 
    54964863      ! local variable 
    5497       TYPE(TATT), DIMENSION(1) :: tl_att 
     4864      INTEGER(i4) :: il_status 
     4865      INTEGER(i4) :: il_ind 
     4866      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
    54984867 
    54994868      ! loop indices 
     4869      INTEGER(i4) :: ji 
    55004870      !---------------------------------------------------------------- 
    55014871 
    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(:) ) 
     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 
    55074977 
    55084978   END SUBROUTINE var__add_att_unit 
    … …  
    55124982   ! 
    55134983   !> @author J.Paul 
    5514    !> @date November, 2013 - Initial Version 
    5515    !> @date February, 2015  
    5516    !> - define local attribute structure to avoid mistake  
    5517    !> with pointer 
     4984   !> - November, 2013- Initial Version 
    55184985   ! 
    55194986   !> @param[inout] td_var variable structure 
    … …  
    55294996      INTEGER(i4) :: il_ind 
    55304997 
    5531       TYPE(TATT)  :: tl_att 
    55324998      ! loop indices 
    55334999      !---------------------------------------------------------------- 
    … …  
    55415007      IF( il_ind == 0 )THEN 
    55425008 
    5543          CALL logger_debug( & 
     5009         CALL logger_warn( & 
    55445010         &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//& 
    55455011         &  ", in variable "//TRIM(td_var%c_name) ) 
    … …  
    55475013      ELSE 
    55485014          
    5549          tl_att=att_copy(td_var%t_att(il_ind)) 
    5550          CALL var_del_att(td_var, tl_att) 
     5015         CALL var_del_att(td_var, td_var%t_att(il_ind)) 
    55515016 
    55525017      ENDIF 
    … …  
    55585023   ! 
    55595024   !> @author J.Paul 
    5560    !> @date November, 2013- Initial Version 
    5561    !> @date February, 2015  
    5562    !> - delete highlight attribute too, when attribute  
    5563    !> is deleted 
     5025   !> - November, 2013- Initial Version 
    55645026   ! 
    55655027   !> @param[inout] td_var variable structure 
    … …  
    55785040 
    55795041      ! loop indices 
     5042      !INTEGER(i4) :: ji 
    55805043      !---------------------------------------------------------------- 
    55815044 
    … …  
    55885051      IF( il_ind == 0 )THEN 
    55895052 
    5590          CALL logger_debug( & 
     5053         CALL logger_warn( & 
    55915054         &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//& 
    55925055         &  ", in variable "//TRIM(td_var%c_name) ) 
    … …  
    56405103               td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 
    56415104 
     5105               !! change attribute id 
     5106               !DO ji=1,td_var%i_natt 
     5107               !   td_var%t_att(ji)%i_id=ji 
     5108               !ENDDO 
     5109 
    56425110               ! clean 
    56435111               CALL att_clean(tl_att(:)) 
    … …  
    56455113            ENDIF  
    56465114         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  
    56705115      ENDIF 
    56715116 
    … …  
    56765121   ! 
    56775122   !> @author J.Paul 
    5678    !> @date November, 2013 - Initial Version 
     5123   !> - November, 2013- Initial Version 
    56795124   ! 
    56805125   !> @param[inout] td_var variable structure 
    … …  
    57115156   ! 
    57125157   !> @author J.Paul 
    5713    !> @date November, 2013 - Initial Version 
     5158   !> - November, 2013- Initial Version 
    57145159   ! 
    57155160   !> @param[inout] td_var variable structure 
    … …  
    57505195   ! 
    57515196   !> @author J.Paul 
    5752    !> @date November, 2013 - Initial Version 
     5197   !> - November, 2013- Initial Version 
    57535198   ! 
    57545199   !> @param[inout] td_var variable structure 
    … …  
    57665211      !---------------------------------------------------------------- 
    57675212 
    5768       IF( td_var%i_ndim <= ip_maxdim )THEN 
     5213      IF( td_var%i_ndim <= 4 )THEN 
    57695214 
    57705215         ! check if dimension already used in variable structure 
    … …  
    57825227         ELSE 
    57835228 
    5784             ! back to disorder dimension array  
    5785             CALL dim_disorder(td_var%t_dim(:)) 
    5786  
     5229         ! back to unorder dimension array  
     5230         CALL dim_unorder(td_var%t_dim(:)) 
    57875231            ! add new dimension 
    57885232            td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim) 
    … …  
    58095253   ! 
    58105254   !> @author J.Paul 
    5811    !> @date November, 2013 - Initial Version 
     5255   !> - November, 2013- Initial Version 
    58125256   ! 
    58135257   !> @param[inout] td_var variable structure 
    … …  
    58285272      !---------------------------------------------------------------- 
    58295273 
    5830       IF( td_var%i_ndim <= ip_maxdim )THEN 
     5274      IF( td_var%i_ndim <= 4 )THEN 
    58315275 
    58325276         CALL logger_trace( & 
    … …  
    58735317   ! 
    58745318   !> @author J.Paul 
    5875    !> @date November, 2013 - Initial Version 
     5319   !> - November, 2013- Initial Version 
    58765320   ! 
    58775321   !> @param[inout] td_var variable structure 
    … …  
    59165360   !> 
    59175361   !> @author J.Paul 
    5918    !> @date June, 2014 - Initial Version 
     5362   !> - June, 2014- Initial Version 
    59195363   ! 
    59205364   !> @param[in] td_var array of variables structure 
    … …  
    59425386   !> 
    59435387   !> @author J.Paul 
    5944    !> @date November, 2013 - Initial Version 
     5388   !> - November, 2013- Initial Version 
    59455389   ! 
    59465390   !> @param[in] td_var    variable structure 
    … …  
    60495493   !> 
    60505494   !> @author J.Paul 
    6051    !> @date November, 2013 - Initial Version 
     5495   !> - November, 2013- Initial Version 
    60525496   !> 
    60535497   !> @param[inout] td_var variable structure 
    … …  
    61875631   !> 
    61885632   !> @author J.Paul 
    6189    !> @date November, 2013 - Initial Version 
     5633   !> - November, 2013- Initial Version 
    61905634   !> 
    61915635   !> @param[inout] td_var variable structure 
    … …  
    62415685   !> 
    62425686   !> @author J.Paul 
    6243    !> @date November, 2013 - Initial Version 
     5687   !> - November, 2013- Initial Version 
    62445688   ! 
    62455689   !> @param[inout] td_var variable structure 
    … …  
    63175761   ! 
    63185762   !> @author J.Paul 
    6319    !> @date November, 2013 - Initial Version 
     5763   !> - November, 2013- Initial Version 
    63205764   ! 
    63215765   !> @param[inout] td_var variabele structure 
    … …  
    63935837   ! 
    63945838   !> @author J.Paul 
    6395    !> @date November, 2013 - Initial Version 
     5839   !> - November, 2013- Initial Version 
    63965840   ! 
    63975841   !> @param[inout] td_var variabele structure 
    … …  
    64695913   ! 
    64705914   !> @author J.Paul 
    6471    !> @date November, 2013 - Initial Version 
     5915   !> - November, 2013- Initial Version 
    64725916   ! 
    64735917   !> @param[inout] td_var variabele structure 
    … …  
    65435987   !> 
    65445988   !> @author J.Paul 
    6545    !> @date November, 2013 - Initial Version 
     5989   !> - November, 2013- Initial Version 
    65465990   ! 
    65475991   !> @param[inout] td_var variable structure 
    … …  
    66136057   !> 
    66146058   !> @author J.Paul 
    6615    !> @date November, 2013 - Initial Version 
     6059   !> - November, 2013- Initial Version 
    66166060   !> 
    66176061   !> @param[inout] td_var variable structure 
    … …  
    66366080   !> 
    66376081   !> @author J.Paul 
    6638    !> @date September, 2014 - Initial Version 
     6082   !> - September, 2014- Initial Version 
    66396083   !> 
    66406084   !> @param[in] td_var       array of variable structure 
    … …  
    67016145   !> 
    67026146   !> @author J.Paul 
    6703    !> @date November, 2013 - Initial Version 
     6147   !> - November, 2013- Initial Version 
    67046148   ! 
    67056149   !> @param[in] td_var       array of variable structure 
    … …  
    67566200   !> 
    67576201   !> @author J.Paul 
    6758    !> @date November, 2013 - Initial Version 
     6202   !> - November, 2013- Initial Version 
    67596203   ! 
    67606204   !> @param[in] td_var array of variable structure 
    … …  
    67956239   !>  
    67966240   !> @author J.Paul 
    6797    !> @date November, 2013 - Initial Version 
     6241   !> - November, 2013- Initial Version 
    67986242   ! 
    67996243   !> @param[inout] td_var array of variable structure 
    … …  
    68786322   !>  
    68796323   !> @author J.Paul 
    6880    !> @date November, 2013 - Initial Version 
    6881    !> @date June, 2015  
    6882    !> - new namelist format to get extra information (interpolation,...) 
     6324   !> - November, 2013- Initial Version 
    68836325   ! 
    68846326   !> @param[in] cd_file   configuration file of variable 
    … …  
    69156357 
    69166358         il_fileid=fct_getunit() 
     6359         CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file)) 
    69176360         OPEN( il_fileid, FILE=TRIM(cd_file), & 
    69186361         &                FORM='FORMATTED',   & 
    … …  
    69236366         CALL fct_err(il_status) 
    69246367         IF( il_status /= 0 )THEN 
    6925             CALL logger_fatal("VAR DEF EXTRA: can not open file "//& 
    6926             &                 TRIM(cd_file)) 
     6368            CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file)) 
    69276369         ENDIF 
    69286370 
    … …  
    69336375         DO WHILE( il_status == 0 ) 
    69346376 
    6935          ! search line not beginning with comment character 
     6377         ! search line do not beginning with comment character 
    69366378            IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 
    69376379               il_nvar=il_nvar+1 
    … …  
    69776419                  tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3)) 
    69786420                  tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4)) 
    6979  
    6980                   cl_interp='int='//TRIM(fct_split(cl_line,5)) 
     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)) 
    69816425                  tg_varextra(ji)%c_interp(:) = & 
    69826426                  &  var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp) 
    69836427                  CALL logger_debug("VAR DEF EXTRA: "//& 
    69846428                  &  TRIM(tg_varextra(ji)%c_name)//& 
    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)) 
     6429                  &  " "//TRIM(cl_interp)) 
    69896430               ELSE 
    69906431                  ji=ji-1 
    … …  
    70176458   !> @details  
    70186459   !> string character format must be : <br/> 
    7019    !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/> 
     6460   !> "varname:interp; filter; extrap; > min; < max"<br/> 
    70206461   !> you could specify only interpolation, filter or extrapolation method,  
    70216462   !> whatever the order. you could find more 
    … …  
    70236464   !> \ref extrap module.<br/> 
    70246465   !> Examples:  
    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 
     6466   !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.' 
     6467   !> cn_varinfo='votemper:cubic; dist_weight; <40.' 
    70316468   !> 
    70326469   !> @note If you do not specify a method which is required, default one is 
    … …  
    70346471   !> 
    70356472   !> @author J.Paul 
    7036    !> @date November, 2013 - Initial Version 
    7037    !> @date July, 2015  
    7038    !> - get unit and unit factor (to change unit)  
     6473   !> - November, 2013- Initial Version 
    70396474   ! 
    70406475   !> @param[in] cd_varinfo   variable information from namelist 
    … …  
    70516486      CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap 
    70526487      CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter 
    7053       CHARACTER(LEN=lc)                            :: cl_unt 
    70546488 
    70556489      INTEGER(i4)                                  :: il_ind 
    … …  
    70586492      REAL(dp)                                     :: dl_min 
    70596493      REAL(dp)                                     :: dl_max 
    7060       REAL(dp)                                     :: dl_unf 
    70616494 
    70626495      TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra 
    … …  
    70756508            dl_min=var__get_min(cl_name, cl_method) 
    70766509            dl_max=var__get_max(cl_name, cl_method) 
    7077             dl_unf=var__get_unf(cl_name, cl_method) 
    70786510            cl_interp(:)=var__get_interp(cl_name, cl_method) 
    70796511            cl_extrap(:)=var__get_extrap(cl_name, cl_method) 
    70806512            cl_filter(:)=var__get_filter(cl_name, cl_method) 
    7081             cl_unt=var__get_unt(cl_name, cl_method) 
    7082  
    70836513 
    70846514            il_ind=var_get_index(tg_varextra(:), TRIM(cl_name)) 
    … …  
    70866516               IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min 
    70876517               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 
    70906518               IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:) 
    70916519               IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:) 
    … …  
    71236551               &                               cd_filter=cl_filter(:), & 
    71246552               &                               dd_min = dl_min, & 
    7125                &                               dd_max = dl_max, & 
    7126                &                               cd_unt = cl_unt, & 
    7127                &                               dd_unf = dl_unf ) 
     6553               &                               dd_max = dl_max ) 
    71286554 
    71296555            ENDIF 
    71306556 
    71316557            ji=ji+1 
    7132             CALL logger_debug( "VAR CHG EXTRA: name       "//& 
     6558            CALL logger_trace( "VAR CHG EXTRA: name       "//& 
    71336559            &                  TRIM(tg_varextra(il_ind)%c_name) ) 
    7134             CALL logger_debug( "VAR CHG EXTRA: interp     "//& 
     6560            CALL logger_trace( "VAR CHG EXTRA: interp     "//& 
    71356561            &                  TRIM(tg_varextra(il_ind)%c_interp(1)) )          
    7136             CALL logger_debug( "VAR CHG EXTRA: filter     "//& 
     6562            CALL logger_trace( "VAR CHG EXTRA: filter     "//& 
    71376563            &                  TRIM(tg_varextra(il_ind)%c_filter(1)) )          
    7138             CALL logger_debug( "VAR CHG EXTRA: extrap     "//& 
     6564            CALL logger_trace( "VAR CHG EXTRA: extrap     "//& 
    71396565            &                  TRIM(tg_varextra(il_ind)%c_extrap(1)) ) 
    71406566            IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN 
    7141                CALL logger_debug( "VAR CHG EXTRA: min value  "//& 
     6567               CALL logger_trace( "VAR CHG EXTRA: min value  "//& 
    71426568               &                  TRIM(fct_str(tg_varextra(il_ind)%d_min)) ) 
    71436569            ENDIF 
    71446570            IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN 
    7145                CALL logger_debug( "VAR CHG EXTRA: max value  "//& 
     6571               CALL logger_trace( "VAR CHG EXTRA: max value  "//& 
    71466572               &                  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)) ) 
    71556573            ENDIF 
    71566574         ENDDO 
    … …  
    71756593   !> 
    71766594   !> @author J.Paul 
    7177    !> @date November, 2013 - Initial Version 
     6595   !> - November, 2013- Initial Version 
    71786596   ! 
    71796597   !> @param[inout] td_var variable structure 
    … …  
    72696687   !>  
    72706688   !> @author J.Paul 
    7271    !> @date November, 2013 - Initial Version 
     6689   !> - November, 2013- Initial Version 
    72726690   !> 
    72736691   !> @param[inout] td_var variable structure 
    … …  
    73906808            ENDIF 
    73916809 
    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  
     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))) 
    74046819         ENDIF 
    74056820 
    … …  
    74186833   !>  
    74196834   !> @details 
    7420    !> minimum value is assume to follow string "min =" 
     6835   !> minimum value is assume to follow sign '>' 
    74216836   !> 
    74226837   !> @author J.Paul 
    7423    !> @date November, 2013 - Initial Version 
    7424    !> @date June, 2015  
    7425    !> - change way to get information in namelist,  
    7426    !> value follows string "min =" 
     6838   !> - November, 2013- Initial Version 
    74276839   ! 
    74286840   !> @param[in] cd_name      variable name 
    … …  
    74556867      cl_tmp=fct_split(cd_varinfo,ji,';') 
    74566868      DO WHILE( TRIM(cl_tmp) /= '' ) 
    7457          il_ind=INDEX(TRIM(cl_tmp),'min') 
     6869         il_ind=SCAN(TRIM(cl_tmp),'>') 
    74586870         IF( il_ind /= 0 )THEN 
    7459             cl_min=fct_split(cl_tmp,2,'=') 
     6871            cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 
    74606872            EXIT 
    74616873         ENDIF 
    … …  
    74656877 
    74666878      IF( TRIM(cl_min) /= '' )THEN 
    7467          IF( fct_is_real(cl_min) )THEN 
     6879         IF( fct_is_num(cl_min) )THEN 
    74686880            READ(cl_min,*) var__get_min 
    74696881            CALL logger_debug("VAR GET MIN: will use minimum value of "//& 
    … …  
    74826894   !>  
    74836895   !> @details 
    7484    !> maximum value is assume to follow string "max =" 
     6896   !> maximum value is assume to follow sign '<' 
    74856897   !> 
    74866898   !> @author J.Paul 
    7487    !> @date November, 2013 - Initial Version 
    7488    !> @date June, 2015  
    7489    !> - change way to get information in namelist,  
    7490    !> value follows string "max =" 
     6899   !> - November, 2013- Initial Version 
    74916900   ! 
    74926901   !> @param[in] cd_name      variable name 
    … …  
    75196928      cl_tmp=fct_split(cd_varinfo,ji,';') 
    75206929      DO WHILE( TRIM(cl_tmp) /= '' ) 
    7521          il_ind=INDEX(TRIM(cl_tmp),'max') 
     6930         il_ind=SCAN(TRIM(cl_tmp),'<') 
    75226931         IF( il_ind /= 0 )THEN 
    7523             cl_max=fct_split(cl_tmp,2,'=') 
     6932            cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 
    75246933            EXIT 
    75256934         ENDIF 
    … …  
    75296938 
    75306939      IF( TRIM(cl_max) /= '' )THEN 
    7531          IF( fct_is_real(cl_max) )THEN 
     6940         IF( fct_is_num(cl_max) )THEN 
    75326941            READ(cl_max,*) var__get_max 
    75336942            CALL logger_debug("VAR GET MAX: will use maximum value of "//& 
    … …  
    75436952   !> @brief 
    75446953   !> 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  
    76106954   !> interpolation method and return it if true.  
    76116955   !>  
    76126956   !> @details  
    7613    !> interpolation method is assume to follow string "int =" 
    7614    !> 
     6957   !> split namelist information, using ';' as separator. 
    76156958   !> compare method name with the list of interpolation method available (see 
    76166959   !> module global). 
    76176960   !> check if factor (*rhoi, /rhoj..) are present.<br/> 
    76186961   !> Example:<br/>  
    7619    !> - int=cubic/rhoi ; ext=dist_weight 
    7620    !> - int=bilin 
     6962   !> - cubic/rhoi ; dist_weight 
     6963   !> - bilin 
    76216964   !> see @ref interp module for more information. 
    76226965   !> 
    76236966   !> @author J.Paul 
    7624    !> @date November, 2013 - Initial Version 
    7625    !> @date June, 2015  
    7626    !> - change way to get information in namelist,  
    7627    !> value follows string "int =" 
     6967   !> - November, 2013- Initial Version 
    76286968   ! 
    76296969   !> @param[in] cd_name      variable name 
    … …  
    76426982      ! local variable 
    76436983      CHARACTER(LEN=lc) :: cl_tmp 
    7644       CHARACTER(LEN=lc) :: cl_int 
    76456984      CHARACTER(LEN=lc) :: cl_factor 
    76466985       
    … …  
    76617000      cl_tmp=fct_split(cd_varinfo,ji,';') 
    76627001      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 
    76737002         DO jj=1,ip_ninterp 
    7674             il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj))) 
     7003            il_ind= INDEX(fct_lower(cl_tmp),TRIM(cp_interp_list(jj))) 
    76757004            IF( il_ind /= 0 )THEN 
    76767005 
    … …  
    76807009               ! look for factor 
    76817010               IF( il_ind==1 )THEN 
    7682                   cl_factor=cl_int(il_len+1:) 
     7011                  cl_factor=cl_tmp(il_len+1:) 
    76837012               ELSE 
    7684                   cl_factor=cl_int(1:il_ind-1) 
     7013                  cl_factor=cl_tmp(1:il_ind-1) 
    76857014               ENDIF 
    76867015               il_mul=SCAN(TRIM(cl_factor),'*') 
    … …  
    77237052            ENDIF 
    77247053         ENDDO 
    7725       ENDIF 
     7054         IF( jj /= ip_ninterp + 1 ) EXIT 
     7055         ji=ji+1 
     7056         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7057      ENDDO 
    77267058 
    77277059   END FUNCTION var__get_interp 
    … …  
    77327064   !>  
    77337065   !> @details  
    7734    !> extrapolation method is assume to follow string "ext =" 
    7735    !>  
     7066   !> split namelist information, using ';' as separator. 
    77367067   !> compare method name with the list of extrapolation method available (see 
    77377068   !> module global).<br/> 
    77387069   !> Example:<br/> 
    7739    !> - int=cubic ; ext=dist_weight 
    7740    !> - ext=min_error 
     7070   !> - cubic ; dist_weight 
     7071   !> - min_error 
    77417072   !> see @ref extrap module for more information. 
    77427073   !> 
    77437074   !> @author J.Paul 
    7744    !> @date November, 2013 - Initial Version 
    7745    !> @date June, 2015  
    7746    !> - change way to get information in namelist,  
    7747    !> value follows string "ext =" 
     7075   !> - November, 2013- Initial Version 
    77487076   ! 
    77497077   !> @param[in] cd_name      variable name 
    … …  
    77627090      ! local variable 
    77637091      CHARACTER(LEN=lc) :: cl_tmp 
    7764       CHARACTER(LEN=lc) :: cl_ext 
    7765  
    7766       INTEGER(i4)       :: il_ind 
    77677092 
    77687093      ! loop indices 
    … …  
    77767101      cl_tmp=fct_split(cd_varinfo,ji,';') 
    77777102      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 
     7103         DO jj=1,ip_nextrap 
     7104            IF( TRIM(fct_lower(cl_tmp)) == TRIM(cp_extrap_list(jj)) )THEN 
     7105               var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 
     7106 
     7107               CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//& 
     7108               &  " will use extrapolation method "//TRIM(var__get_extrap(1)) ) 
     7109 
     7110               EXIT 
     7111            ENDIF 
     7112         ENDDO 
     7113         IF( jj /= ip_nextrap + 1 ) EXIT 
    77837114         ji=ji+1 
    77847115         cl_tmp=fct_split(cd_varinfo,ji,';')          
    77857116      ENDDO 
    7786  
    7787       IF( TRIM(cl_ext) /= '' )THEN 
    7788          DO jj=1,ip_nextrap 
    7789             IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN 
    7790                var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 
    7791  
    7792                CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//& 
    7793                &  " will use extrapolation method "//TRIM(var__get_extrap(1)) ) 
    7794  
    7795                EXIT 
    7796             ENDIF 
    7797          ENDDO 
    7798       ENDIF 
    77997117 
    78007118 
    … …  
    78067124   !>  
    78077125   !> @details  
    7808    !> filter method is assume to follow string "flt =" 
    7809    !> 
     7126   !> split namelist information, using ';' as separator. 
    78107127   !> compare method name with the list of filter method available (see 
    78117128   !> module global). 
    7812    !> look for the number of run, using '*' separator, and method parameters inside 
     7129   !> look for the number of turn, using '*' separator, and method parameters inside 
    78137130   !> bracket.<br/> 
    78147131   !> Example:<br/> 
    7815    !> - int=cubic ; flt=2*hamming(2,3) 
    7816    !> - flt=hann 
     7132   !> - cubic ; 2*hamming(2,3) 
     7133   !> - hann 
    78177134   !> see @ref filter module for more information. 
    78187135   !> 
    78197136   !> @author J.Paul 
    7820    !> @date November, 2013 - Initial Version 
    7821    !> @date June, 2015  
    7822    !> - change way to get information in namelist,  
    7823    !> value follows string "flt =" 
    7824    !> 
     7137   !> - November, 2013- Initial Version 
     7138   ! 
    78257139   !> @param[in] cd_name      variable name 
    78267140   !> @param[in] cd_varinfo   variable information read in namelist  
    … …  
    78377151      ! local variable 
    78387152      CHARACTER(LEN=lc) :: cl_tmp 
    7839       CHARACTER(LEN=lc) :: cl_flt 
    78407153      INTEGER(i4)       :: il_ind 
    78417154 
    … …  
    78507163      cl_tmp=fct_split(cd_varinfo,ji,';') 
    78517164      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 
    78627165         DO jj=1,ip_nfilter 
    7863             il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj))) 
     7166            il_ind=INDEX(fct_lower(cl_tmp),TRIM(cp_filter_list(jj))) 
    78647167            IF( il_ind /= 0 )THEN 
    78657168               var__get_filter(1)=TRIM(cp_filter_list(jj)) 
    78667169 
    7867                ! look for number of run 
    7868                il_ind=SCAN(fct_lower(cl_flt),'*') 
     7170               ! look for number of turn 
     7171               il_ind=SCAN(fct_lower(cl_tmp),'*') 
    78697172               IF( il_ind /=0 )THEN 
    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:)) 
     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:)) 
    78747177                  ELSE 
    78757178                     var__get_filter(2)='1' 
    … …  
    78807183 
    78817184               ! look for filter parameter 
    7882                il_ind=SCAN(fct_lower(cl_flt),'(') 
     7185               il_ind=SCAN(fct_lower(cl_tmp),'(') 
    78837186               IF( il_ind /=0 )THEN 
    7884                   cl_flt=TRIM(cl_flt(il_ind+1:)) 
    7885                   il_ind=SCAN(fct_lower(cl_flt),')') 
     7187                  cl_tmp=TRIM(cl_tmp(il_ind+1:)) 
     7188                  il_ind=SCAN(fct_lower(cl_tmp),')') 
    78867189                  IF( il_ind /=0 )THEN 
    7887                      cl_flt=TRIM(cl_flt(1:il_ind-1)) 
     7190                     cl_tmp=TRIM(cl_tmp(1:il_ind-1)) 
    78887191                     ! look for cut-off frequency 
    7889                      var__get_filter(3)=fct_split(cl_flt,1,',') 
     7192                     var__get_filter(3)=fct_split(cl_tmp,1,',') 
    78907193                     ! look for halo size 
    7891                      var__get_filter(4)=fct_split(cl_flt,2,',') 
     7194                     var__get_filter(4)=fct_split(cl_tmp,2,',') 
    78927195                     ! look for alpha parameter 
    7893                      var__get_filter(5)=fct_split(cl_flt,3,',') 
     7196                     var__get_filter(5)=fct_split(cl_tmp,3,',') 
    78947197                  ELSE 
    78957198                     CALL logger_error("VAR GET FILTER: variable "//& 
    … …  
    79127215            ENDIF 
    79137216         ENDDO 
    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 
     7217         IF( jj /= ip_nfilter + 1 ) EXIT 
    79607218         ji=ji+1 
    79617219         cl_tmp=fct_split(cd_varinfo,ji,';')          
    79627220      ENDDO 
    79637221 
    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 
     7222   END FUNCTION var__get_filter 
    79717223   !------------------------------------------------------------------- 
    79727224   !> @brief  
    … …  
    79757227   !> 
    79767228   !> @author J.Paul 
    7977    !> @date November, 2013 - Initial Version 
     7229   !> - November, 2013- Initial Version 
    79787230   ! 
    79797231   !> @param[in] td_var array of variable structure 
    … …  
    80337285   !>  
    80347286   !> @author J.Paul 
    8035    !> @date November, 2013 - Initial Version 
     7287   !> - November, 2013- Initial Version 
    80367288   ! 
    80377289   !> @param[inout] td_var variable structure 
    … …  
    80697321   !------------------------------------------------------------------- 
    80707322   !> @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 
    81227323   !> This subroutine check variable dimension expected, as defined in 
    81237324   !> file 'variable.cfg'. 
    … …  
    81287329   !> 
    81297330   !> @author J.Paul 
    8130    !> @date November, 2013 - Initial Version 
     7331   !> - November, 2013- Initial Version 
    81317332   ! 
    81327333   !> @param[inout] td_var    variable structure 
    … …  
    82137414   !>  
    82147415   !> @author J.Paul 
    8215    !> @date August, 2014 - Initial Version 
    8216    !> @date July 2015  
    8217    !> - do not use dim_disorder anymore 
     7416   !> - August, 2014- Initial Version 
    82187417   ! 
    82197418   !> @param[inout] td_var       variable structure 
    … …  
    82397438      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 
    82407439 
    8241       CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//& 
    8242          &  " new dimension order "//TRIM(cl_dimorder)) 
    8243  
    82447440      tl_dim(:)=dim_copy(td_var%t_dim(:)) 
    82457441 
     7442      CALL dim_unorder(tl_dim(:)) 
    82467443      CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
    82477444 
    … …  
    82707467   !>  
    82717468   !> @author J.Paul 
    8272    !> @date September, 2014 - Initial Version 
     7469   !> - September, 2014- Initial Version 
    82737470   ! 
    82747471   !> @param[in] td_var array of variable structure  
    … …  
    82957492   !>  
    82967493   !> @author J.Paul 
    8297    !> @date November, 2014 - Initial Version 
     7494   !> - November, 2014- Initial Version 
    82987495   ! 
    82997496   !> @param[in] td_var time variable structure  

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/vgrid.f90

    r10248 r10251  
    7070!> @date Spetember, 2014 
    7171!> - add header 
    72 !> @date June, 2015 - update subroutine with NEMO 3.6 
    7372!> 
    7473!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    119118   !> 
    120119   !> @author G. Madec 
    121    !> @date Marsh,2008 - F90: Free form and module 
     120   !> - 03,08-  G. Madec: F90: Free form and module 
    122121   ! 
    123122   !> @note Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 
    … …  
    140139   !------------------------------------------------------------------- 
    141140   SUBROUTINE vgrid_zgr_z( dd_gdepw, dd_gdept, dd_e3w, dd_e3t,          & 
    142    &                       dd_e3w_1d, dd_e3t_1d, & 
    143141   &                       dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,    & 
    144142   &                       dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed, & 
    … …  
    150148      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w 
    151149      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t 
    152       REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w_1d 
    153       REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t_1d 
    154150 
    155151      REAL(dp)              , INTENT(IN   ) :: dd_ppkth 
    … …  
    230226         DO jk = 1, il_jpk 
    231227            dl_zw = REAL(jk,dp) 
    232             dl_zt = REAL(jk,dp) + 0.5_dp 
     228            dl_zt = REAL(jk,dp) + 0.5 
    233229            dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1 
    234230            dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1 
    … …  
    241237         DO jk = 1, il_jpk 
    242238            dl_zw = REAL( jk,dp) 
    243             dl_zt = REAL( jk,dp) + 0.5_dp 
     239            dl_zt = REAL( jk,dp) + 0.5 
    244240            dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + & 
    245241            &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + & 
    … …  
    259255      ENDIF 
    260256 
    261    ! need to be like this to compute the pressure gradient with ISF. 
    262    ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth) 
    263    ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively 
    264       DO jk = 1, il_jpk-1 
    265          dd_e3t_1d(jk) = dd_gdepw(jk+1)-dd_gdepw(jk)  
    266       END DO 
    267       dd_e3t_1d(il_jpk) = dd_e3t_1d(il_jpk-1) ! we don't care because this level is masked in NEMO 
    268  
    269       DO jk = 2, il_jpk 
    270          dd_e3w_1d(jk) = dd_gdept(jk) - dd_gdept(jk-1)  
    271       END DO 
    272       dd_e3w_1d(1  ) = 2._dp * (dd_gdept(1) - dd_gdepw(1)) 
    273  
    274257      ! Control and  print 
    275258      ! ================== 
    … …  
    277260      DO jk = 1, il_jpk 
    278261         IF( dd_e3w(jk)  <= 0. .OR. dd_e3t(jk)  <= 0. )then 
    279             CALL logger_debug("VGRID ZGR Z: e3w or e3t <= 0 ") 
     262            CALL logger_debug("VGRID ZGR Z: e3w or e3t =< 0 ") 
    280263         ENDIF    
    281  
    282          IF( dd_e3w_1d(jk)  <= 0. .OR. dd_e3t_1d(jk)  <= 0. )then 
    283             CALL logger_debug("VGRID ZGR Z: e3w_1d or e3t_1d <= 0 ") 
    284          ENDIF 
    285264 
    286265         IF( dd_gdepw(jk) < 0. .OR. dd_gdept(jk) < 0. )then 
    … …  
    290269 
    291270   END SUBROUTINE vgrid_zgr_z 
    292    !------------------------------------------------------------------- 
    293    !------------------------------------------------------------------- 
    294    SUBROUTINE vgrid_zgr_bat( dd_bathy, dd_gdepw, dd_hmin, dd_fill ) 
    295       IMPLICIT NONE 
    296       ! Argument 
    297       REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_bathy  
    298       REAL(dp), DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw  
    299       REAL(dp)                , INTENT(IN   ) :: dd_hmin 
    300       REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill 
    301  
    302       ! local 
    303       INTEGER(i4) :: il_jpk 
    304        
    305       REAL(dp)    :: dl_hmin 
    306       REAL(dp)    :: dl_fill 
    307  
    308       ! loop indices 
    309       INTEGER(i4) :: jk 
    310       !---------------------------------------------------------------- 
    311       il_jpk = SIZE(dd_gdepw(:)) 
    312  
    313       dl_fill=0._dp 
    314       IF( PRESENT(dd_fill) ) dl_fill=dd_fill 
    315  
    316       IF( dd_hmin < 0._dp ) THEN 
    317          jk = - INT( dd_hmin )     ! from a nb of level 
    318       ELSE 
    319          jk = MINLOC( dd_gdepw, mask = dd_gdepw > dd_hmin, dim = 1 )  ! from a depth 
    320       ENDIF 
    321        
    322       dl_hmin = dd_gdepw(jk+1) ! minimum depth = ik+1 w-levels  
    323       WHERE( dd_bathy(:,:) <= 0._wp .OR. dd_bathy(:,:) == dl_fill ) 
    324          dd_bathy(:,:) = dl_fill                         ! min=0     over the lands 
    325       ELSE WHERE 
    326          dd_bathy(:,:) = MAX(  dl_hmin , dd_bathy(:,:)  )   ! min=dl_hmin over the oceans 
    327       END WHERE 
    328       WRITE(*,*) 'Minimum ocean depth: ', dl_hmin, ' minimum number of ocean levels : ', jk       
    329  
    330    END SUBROUTINE vgrid_zgr_bat 
    331271   !------------------------------------------------------------------- 
    332272   !> @brief This subroutine set the depth and vertical scale factor in partial step 
    … …  
    373313   ! 
    374314   !> @author A. Bozec, G. Madec 
    375    !> @date February, 2009 - F90: Free form and module 
    376    !> @date February, 2009  
    377    !> - A. de Miranda : rigid-lid + islands 
     315   !> - 02-09 (A. Bozec, G. Madec) F90: Free form and module 
     316   !> - 02-09 (A. de Miranda)  rigid-lid + islands 
    378317   !> 
    379318   !> @note Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 
    … …  
    388327   !------------------------------------------------------------------- 
    389328   SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, & 
    390    &                          dd_gdepw, dd_e3t,               & 
    391    &                          dd_e3zps_min, dd_e3zps_rat,     & 
    392    &                          dd_fill ) 
     329   &                         dd_gdepw, dd_e3t,               & 
     330   &                         dd_e3zps_min, dd_e3zps_rat ) 
    393331      IMPLICIT NONE 
    394332      ! Argument       
    … …  
    398336      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw 
    399337      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t 
    400       REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min 
    401       REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat 
    402       REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill 
     338      REAL(dp)                                   :: dd_e3zps_min 
     339      REAL(dp)                                   :: dd_e3zps_rat 
    403340 
    404341      ! local variable 
    405342      REAL(dp) :: dl_zmax     ! Maximum depth 
    406       !REAL(dp) :: dl_zmin     ! Minimum depth 
     343      REAL(dp) :: dl_zmin     ! Minimum depth 
    407344      REAL(dp) :: dl_zdepth   ! Ajusted ocean depth to avoid too small e3t  
    408       REAL(dp) :: dl_fill      
    409345 
    410346      INTEGER(i4) :: il_jpk 
    … …  
    423359      il_jpjglo=SIZE(id_mbathy(:,:),DIM=2) 
    424360 
    425       dl_fill=0._dp 
    426       IF( PRESENT(dd_fill) ) dl_fill=dd_fill 
    427  
    428361      ! Initialization of constant 
    429       dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) ) 
    430  
    431       ! bounded value of bathy (min already set at the end of zgr_bat) 
    432       WHERE( dd_bathy(:,:) /= dl_fill ) 
    433          dd_bathy(:,:) = MIN( dl_zmax ,  dd_bathy(:,:) ) 
    434       END WHERE 
     362      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) 
     363      dl_zmin = dd_gdepw(4) 
    435364 
    436365      ! bathymetry in level (from bathy_meter) 
    … …  
    443372      DO jj = 1, il_jpjglo 
    444373         DO ji= 1, il_jpiglo 
    445             IF( dd_bathy(ji,jj) <= 0._dp )THEN 
    446                id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4) 
    447             ELSEIF( dd_bathy(ji,jj) == dl_fill )THEN 
    448                id_mbathy(ji,jj) = 0_i4 
     374            IF( dd_bathy(ji,jj) <= 0. )   id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4) 
     375         END DO 
     376      END DO 
     377 
     378      ! bounded value of bathy 
     379      ! minimum depth == 3 levels 
     380      ! maximum depth == gdepw(jpk)+e3t(jpk)  
     381      ! i.e. the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk) 
     382      DO jj = 1, il_jpjglo 
     383         DO ji= 1, il_jpiglo 
     384            IF( dd_bathy(ji,jj) <= 0. ) THEN 
     385               dd_bathy(ji,jj) = 0.e0 
     386            ELSE 
     387               dd_bathy(ji,jj) = MAX( dd_bathy(ji,jj), dl_zmin ) 
     388               dd_bathy(ji,jj) = MIN( dd_bathy(ji,jj), dl_zmax ) 
    449389            ENDIF 
    450390         END DO 
    … …  
    461401         DO jj = 1, il_jpjglo 
    462402            DO ji = 1, il_jpiglo 
    463                IF( dd_bathy(ji,jj) /= dl_fill )THEN 
    464                   IF( 0. < dd_bathy(ji,jj) .AND. & 
    465                   &       dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1 
    466                ENDIF 
     403               IF( 0. < dd_bathy(ji,jj) .AND. dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1 
    467404            END DO 
    468405         END DO 
    … …  
    497434 
    498435   !> @author G.Madec 
    499    !> @date Marsh, 2008 - Original code 
     436   !> - 03-08 Original code 
    500437   ! 
    501438   !> @param[in] id_mbathy  
    … …  
    606543   !> 
    607544   !> @author J.Paul 
    608    !> @date November, 2013 - Initial Version 
     545   !> - November, 2013- Initial Version 
    609546   ! 
    610547   !> @param[in] td_bathy     Bathymetry file structure  
    … …  
    630567      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w  
    631568      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t 
    632       REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w_1d  
    633       REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t_1d 
    634569 
    635570      INTEGER(i4)                                  :: il_status 
    … …  
    775710      ALLOCATE( dl_gdepw(in_nlevel), dl_gdept(in_nlevel) )  
    776711      ALLOCATE(   dl_e3w(in_nlevel),   dl_e3t(in_nlevel) )  
    777       ALLOCATE(   dl_e3w_1d(in_nlevel),   dl_e3t_1d(in_nlevel) )  
    778712      CALL vgrid_zgr_z( dl_gdepw(:), dl_gdept(:), dl_e3w(:), dl_e3t(:), & 
    779       &                 dl_e3w_1d, dl_e3t_1d, & 
    780713      &                 dn_ppkth, dn_ppkth2, dn_ppacr, dn_ppacr2,       & 
    781714      &                 dn_ppdzmin, dn_pphmax, dn_pp_to_be_computed,    & 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam

    r10248 r10251  
    1919 
    2020&namvar 
     21   cn_varinfo= 
    2122   cn_varfile= 
    22    cn_varinfo= 
    2323/ 
    2424 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam

    r10248 r10251  
    6060   cn_west  =  
    6161   ln_oneseg=  
     62   in_extrap=  
    6263/ 
    6364 
    6465&namout 
    6566   cn_fileout="boundary_out.nc"       
    66    dn_dayofs= 
    67    ln_extrap= 
    6867/ 

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam

    r10248 r10251  
    1212   cn_coord0= 
    1313   in_perio0= 
    14 / 
    15  
    16 &namfin 
    17    cn_coord1= 
    18    cn_bathy1= 
    19    in_perio1= 
    2014/ 
    2115 
    … …  
    4034/ 
    4135 
     36&namfin 
     37   cn_coord1= 
     38   cn_bathy1= 
     39   in_perio1= 
     40   in_extrap= 
     41/ 
     42 
    4243&namvar 
    4344   cn_varinfo= 
    … …  
    5253&namout 
    5354   cn_fileout="restart_out.nc"       
    54    ln_extrap= 
    55    in_nipro= 
    56    in_njproc= 
    57    in_nproc= 
    58    cn_type= 
    5955/ 
Note: See TracChangeset for help on using the changeset viewer.