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 5608 for branches/2015 – NEMO

Changeset 5608 for branches/2015


Ignore:
Timestamp:
2015-07-17T17:40:52+02:00 (9 years ago)
Author:
jpaul
Message:

commit changes/bugfix/... for SIREN; see ticket #1580

Location:
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS
Files:
2 added
34 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/tools.txt

    r2281 r5608  
    1 REBUILD  
     1SIREN  
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/attribute.f90

    r5037 r5608  
    8181! REVISION HISTORY: 
    8282!> @date November, 2013 - Initial Version 
    83 !> @date November, 2014 - Fix memory leaks bug 
     83!> @date November, 2014  
     84!> - Fix memory leaks bug 
    8485! 
    8586!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    130131      INTEGER(i4)       :: i_type = 0        !< attribute type 
    131132      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute 
    132       CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR 
     133      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR 
    133134      REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE 
    134135   END TYPE TATT 
    135136 
    136137   INTERFACE att_init 
    137       MODULE PROCEDURE att__init_c 
     138      MODULE PROCEDURE att__init_c     
    138139      MODULE PROCEDURE att__init_dp 
    139140      MODULE PROCEDURE att__init_dp_0d 
     
    181182   !> @date November, 2013 - Initial Version 
    182183   !> @date November, 2014 
    183    !>    - use function instead of overload assignment operator  
     184   !> - use function instead of overload assignment operator  
    184185   !> (to avoid memory leak)  
    185186   ! 
     
    234235 
    235236      ! local variable 
    236       REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value 
     237      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value 
    237238      !---------------------------------------------------------------- 
    238239 
     
    300301   !> @author J.Paul 
    301302   !> @date November, 2013 - Initial Version 
    302    !> @date September, 2014 - bug fix with use of id read from attribute structure 
    303    ! 
     303   !> @date September, 2014  
     304   !> - bug fix with use of id read from attribute structure 
     305   !> 
    304306   !> @param[in] td_att    array of attribute structure 
    305307   !> @param[in] cd_name   attribute name 
     
    355357 
    356358      att__init_c%c_name=TRIM(ADJUSTL(cd_name)) 
    357  
    358359      att__init_c%i_type=NF90_CHAR 
     360 
    359361      att__init_c%c_value=TRIM(ADJUSTL(cd_value)) 
    360362      att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) ) 
     
    10681070   !> @author J.Paul 
    10691071   !> @date November, 2013 - Initial Version 
    1070    !> @date September, 2014 - take into account type of attribute. 
     1072   !> @date September, 2014  
     1073   !> - take into account type of attribute. 
    10711074   ! 
    10721075   !> @param[in] td_att attribute structure 
     
    11141117 
    11151118            CASE(NF90_CHAR) 
     1119 
    11161120               cl_value=td_att%c_value 
    11171121 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/boundary.f90

    r5037 r5608  
    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 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] 
     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] 
    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 
    3841!> 
    3942!>    to get the number of segment in boundary:<br/> 
     
    105108! REVISION HISTORY: 
    106109!> @date November, 2013 - Initial Version 
    107 !> @date September, 2014 - add boundary description 
    108 !> @date November, 2014 - Fix memory leaks bug 
     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 
    109118!>  
    110119!> @todo add schematic to boundary structure description 
     
    157166   PRIVATE :: seg__init       ! initialise segment structure 
    158167   PRIVATE :: seg__clean      ! clean segment structure 
    159    PRIVATE :: seg__clean_unit ! clean segment structure 
     168   PRIVATE :: seg__clean_unit ! clean one segment structure 
    160169   PRIVATE :: seg__clean_arr  ! clean array of segment structure 
    161170   PRIVATE :: seg__copy       ! copy segment structure in another 
     
    173182      CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal 
    174183      LOGICAL           :: l_use  = .FALSE.     !< boundary use or not  
     184      LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist 
    175185      INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary 
    176186      TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure 
    177187   END TYPE TBDY 
    178188 
     189   ! module variable 
    179190   INTEGER(i4), PARAMETER :: im_width=10 
    180191 
     
    223234   !> @date November, 2013 - Initial Version 
    224235   !> @date November, 2014 
    225    !>    - use function instead of overload assignment operator  
     236   !> - use function instead of overload assignment operator  
    226237   !> (to avoid memory leak) 
    227238   ! 
     
    260271   !> @date November, 2013 - Initial Version 
    261272   !> @date November, 2014 
    262    !>    - use function instead of overload assignment operator  
     273   !> - use function instead of overload assignment operator  
    263274   !> (to avoid memory leak) 
    264275   ! 
     
    353364   END SUBROUTINE boundary__clean_arr 
    354365   !-------------------------------------------------------------------  
    355    !> @brief This function put cardinal name inside file name. 
     366   !> @brief This function put cardinal name and date inside file name. 
    356367   !  
    357368   !> @details  
    358    !  
     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   !>  
    359382   !> @author J.Paul  
    360383   !> @date November, 2013 - Initial Version  
     
    385408      CHARACTER(LEN=lc) :: cl_date 
    386409      CHARACTER(LEN=lc) :: cl_name 
     410 
     411      INTEGER(i4)       :: il_ind 
     412      INTEGER(i4)       :: il_indend 
     413 
    387414      ! loop indices  
    388415      !----------------------------------------------------------------  
     
    400427         cl_suffix=fct_split(TRIM(cl_basename),2,'.') 
    401428          
     429         ! add segment number 
    402430         IF( PRESENT(id_seg) )THEN 
    403             cl_segnum="_"//TRIM(fct_str(id_seg))//"_" 
     431            cl_segnum="_"//TRIM(fct_str(id_seg)) 
    404432         ELSE 
    405433            cl_segnum="" 
    406434         ENDIF 
    407435 
     436         ! add date 
    408437         IF( PRESENT(cd_date) )THEN 
    409             cl_date=TRIM(ADJUSTL(cd_date)) 
     438            cl_date="_"//TRIM(ADJUSTL(cd_date)) 
    410439         ELSE 
    411440            cl_date="" 
    412441         ENDIF 
    413442 
    414          cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 
    415          &        TRIM(cl_date)//"."//TRIM(cl_suffix) 
     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 
    416456 
    417457         boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) 
     
    442482   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 
    443483   !> 
    444    !> @note boundaries are compute on T point. change will be done to get data 
    445    !> on other point when need be.  
     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.  
    446486   !> 
    447487   !> @author J.Paul  
     
    581621 
    582622               ! get namelist information 
    583                tl_tmp=boundary__get_info(cl_card(jk)) 
     623               tl_tmp=boundary__get_info(cl_card(jk),jk) 
     624 
     625               ! get segments indices 
    584626               DO ji=1,tl_tmp%i_nseg 
    585627                  CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji)) 
    586628               ENDDO 
     629               ! indices from namelist or not 
     630               tl_bdy(jk)%l_nam=tl_tmp%l_nam 
     631 
    587632               CALL boundary_clean(tl_tmp) 
    588633 
     
    642687   !> @return boundary structure 
    643688   !-------------------------------------------------------------------  
    644    FUNCTION boundary__init( cd_card, ld_use, td_seg )  
     689   FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg )  
    645690      IMPLICIT NONE  
    646691      ! Argument 
    647692      CHARACTER(LEN=*), INTENT(IN) :: cd_card 
    648693      LOGICAL         , INTENT(IN), OPTIONAL :: ld_use  
     694      LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam  
    649695      TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg 
    650696 
     
    664710            boundary__init%l_use=.TRUE. 
    665711            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 
    666715 
    667716            IF( PRESENT(td_seg) )THEN 
     
    778827   !> orthogonal index, first and last indices, of each segment.  
    779828   !> And also the width of all segments of this boundary. 
    780    !>   cn_north='index1,first1,last1(width)|index2,first2,last2' 
     829   !>   cn_north='index1,first1:last1(width)|index2,first2:last2' 
    781830   !>  
    782831   !> @author J.Paul  
    783832   !> @date November, 2013 - Initial Version  
     833   !> @date february, 2015  
     834   !> - do not change indices read from namelist 
     835   !> - change format cn_north 
    784836   !  
    785837   !> @param[in] cd_card   boundary description 
     838   !> @param[in] id_jcard  boundary index 
    786839   !> @return boundary structure 
    787840   !-------------------------------------------------------------------  
    788    FUNCTION boundary__get_info(cd_card)  
     841   FUNCTION boundary__get_info(cd_card, id_jcard)  
    789842      IMPLICIT NONE  
    790843      ! Argument  
    791844      CHARACTER(LEN=lc), INTENT(IN) :: cd_card 
     845      INTEGER(i4)      , INTENT(IN) :: id_jcard 
    792846 
    793847      ! function  
     
    802856      CHARACTER(LEN=lc) :: cl_index 
    803857      CHARACTER(LEN=lc) :: cl_width 
     858      CHARACTER(LEN=lc) :: cl_tmp 
    804859      CHARACTER(LEN=lc) :: cl_first 
    805860      CHARACTER(LEN=lc) :: cl_last  
     
    818873      ! width should be the same for all segment of one boundary 
    819874      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 
    820880         il_ind1=SCAN(fct_lower(cl_seg),'(') 
    821881         IF( il_ind1 /=0 )THEN 
     
    831891            ENDIF 
    832892         ENDIF 
     893 
    833894      ENDIF  
    834895 
     
    839900         il_ind1=SCAN(fct_lower(cl_index),'(') 
    840901         IF( il_ind1 /=0 )THEN 
    841             il_ind2=SCAN(fct_lower(cl_index),'(') 
     902            il_ind2=SCAN(fct_lower(cl_index),')') 
    842903            IF( il_ind2 /=0 )THEN 
    843904               cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:)) 
     
    848909         ENDIF 
    849910       
    850          cl_first=fct_split(cl_seg,2,',') 
     911          
     912         cl_tmp=fct_split(cl_seg,2,',') 
     913 
     914 
     915         cl_first=fct_split(cl_tmp,1,':') 
    851916         ! remove potential width information 
    852917         il_ind1=SCAN(fct_lower(cl_first),'(') 
    853918         IF( il_ind1 /=0 )THEN 
    854             il_ind2=SCAN(fct_lower(cl_first),'(') 
     919            il_ind2=SCAN(fct_lower(cl_first),')') 
    855920            IF( il_ind2 /=0 )THEN 
    856921               cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:)) 
     
    861926         ENDIF          
    862927          
    863          cl_last =fct_split(cl_seg,3,',') 
     928         cl_last =fct_split(cl_tmp,2,':') 
    864929         ! remove potential width information 
    865930         il_ind1=SCAN(fct_lower(cl_last),'(') 
    866931         IF( il_ind1 /=0 )THEN 
    867             il_ind2=SCAN(fct_lower(cl_last),'(') 
     932            il_ind2=SCAN(fct_lower(cl_last),')') 
    868933            IF( il_ind2 /=0 )THEN 
    869934               cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:)) 
     
    879944         IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first 
    880945         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 
    881952 
    882953         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. & 
     
    9431014 
    9441015      DO jk=1,ip_ncard 
    945          IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%i_nseg > 1 )THEN 
     1016         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN 
    9461017            ! nothing to be done 
    9471018         ELSE 
     
    14801551      il_max(jp_east )=td_var%t_dim(2)%i_len 
    14811552      il_max(jp_west )=td_var%t_dim(2)%i_len 
    1482        
     1553  
    14831554      il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 
    14841555      il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost 
     
    15151586         ENDIF 
    15161587      ENDDO 
    1517        
     1588  
    15181589      CALL boundary_check_corner(td_bdy, td_var) 
    15191590 
     
    16501721   !> @date November, 2013 - Initial Version 
    16511722   !> @date November, 2014 
    1652    !>    - use function instead of overload assignment operator  
     1723   !> - use function instead of overload assignment operator  
    16531724   !> (to avoid memory leak) 
    16541725   ! 
     
    16871758   !> @date November, 2013 - Initial Version 
    16881759   !> @date November, 2014 
    1689    !>    - use function instead of overload assignment operator  
     1760   !> - use function instead of overload assignment operator  
    16901761   !> (to avoid memory leak) 
    16911762   ! 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90

    r5037 r5608  
    2020!>    ./SIREN/bin/create_bathy create_bathy.nam 
    2121!> @endcode 
    22 !>     
     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!> 
    2329!>    create_bathy.nam comprise 7 namelists:<br/> 
    2430!>       - logger namelist (namlog) 
     
    3743!>       - cn_logfile   : log filename 
    3844!>       - cn_verbosity : verbosity ('trace','debug','info', 
    39 !> 'warning','error','fatal') 
     45!> 'warning','error','fatal','none') 
    4046!>       - in_maxerror  : maximum number of error allowed 
    4147!> 
     
    5258!>       - cn_coord1 : coordinate file 
    5359!>       - in_perio1 : periodicity index 
    54 !>       - ln_fillclosed : fill closed sea or not 
     60!>       - ln_fillclosed : fill closed sea or not (default is .TRUE.) 
    5561!> 
    5662!>    * _variable namelist (namvar)_:<br/> 
    5763!>       - cn_varinfo : list of variable and extra information about request(s)  
    5864!>       to be used.<br/> 
    59 !>          each elements of *cn_varinfo* is a string character.<br/> 
     65!>          each elements of *cn_varinfo* is a string character 
     66!>          (separated by ',').<br/> 
    6067!>          it is composed of the variable name follow by ':',  
    6168!>          then request(s) to be used on this variable.<br/>  
    6269!>          request could be: 
    63 !>             - interpolation method 
    64 !>             - extrapolation method 
    65 !>             - filter method 
    66 !>             - > minimum value 
    67 !>             - < maximum value 
     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) 
    6877!> 
    6978!>                requests must be separated by ';'.<br/> 
     
    7281!>          informations about available method could be find in @ref interp, 
    7382!>          @ref extrap and @ref filter modules.<br/> 
    74 !>          Example: 'Bathymetry: 2*hamming(2,3); > 0' 
     83!>          Example: 'Bathymetry: flt=2*hamming(2,3); min=0' 
    7584!>          @note  
    7685!>             If you do not specify a method which is required,  
     
    9099!>                - ',' for line 
    91100!>                - '/' for row 
    92 !>                - '\' for level<br/> 
    93101!>                Example:<br/> 
    94102!>                   3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc} 
     
    99107!>             - 'Bathymetry:gridT.nc' 
    100108!>             - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000' 
    101 !> 
    102 !>          \image html  bathy_40.png  
    103 !>          \image latex bathy_30.png 
    104109!> 
    105110!>    * _nesting namelist (namnst)_:<br/> 
     
    119124!> - add header for user 
    120125!> - Bug fix, compute offset depending of grid point 
     126!> @date June, 2015 
     127!> - extrapolate all land points. 
     128!> - allow to change unit. 
    121129! 
     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!> 
    122135!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    123136!---------------------------------------------------------------------- 
     
    482495   ENDIF 
    483496 
     497   ! use additional request 
    484498   DO jk=1,tl_multi%i_nvar 
     499 
     500         ! change unit and apply factor 
     501         CALL var_chg_unit(tl_var(jk)) 
     502 
    485503         ! forced min and max value 
    486504         CALL var_limit_value(tl_var(jk)) 
     
    557575 
    558576   ! add other variables 
    559    DO jk=1,tl_multi%i_nvar 
     577   DO jk=tl_multi%i_nvar,1,-1 
    560578      CALL file_add_var(tl_fileout, tl_var(jk)) 
    561579      CALL var_clean(tl_var(jk)) 
     
    897915      IMPLICIT NONE 
    898916      ! Argument 
    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 
     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 
    905923      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset 
    906924      INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho 
     
    10731091 
    10741092      ! extrapolate variable 
    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 ) 
     1093      CALL extrap_fill_value( td_var ) 
    10781094 
    10791095      ! interpolate Bathymetry 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90

    r5037 r5608  
    2323!>    ./SIREN/bin/create_boundary create_boundary.nam 
    2424!> @endcode 
    25 !>     
     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!> 
    2632!>    create_boundary.nam comprise 9 namelists:<br/> 
    2733!>       - logger namelist (namlog) 
     
    4248!>       - cn_logfile   : log filename 
    4349!>       - cn_verbosity : verbosity ('trace','debug','info', 
    44 !> 'warning','error','fatal') 
     50!> 'warning','error','fatal','none') 
    4551!>       - in_maxerror  : maximum number of error allowed 
    4652!> 
     
    7985!>    * _variable namelist (namvar)_:<br/> 
    8086!>       - cn_varinfo : list of variable and extra information about request(s) 
    81 !> to be used.<br/> 
     87!>          to be used (separated by ',').<br/> 
    8288!>          each elements of *cn_varinfo* is a string character.<br/> 
    8389!>          it is composed of the variable name follow by ':',  
    8490!>          then request(s) to be used on this variable.<br/>  
    8591!>          request could be: 
    86 !>             - interpolation method 
    87 !>             - extrapolation method 
    88 !>             - filter method 
     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) 
    8997!> 
    9098!>                requests must be separated by ';'.<br/> 
     
    94102!>          @ref extrap and @ref filter.<br/> 
    95103!> 
    96 !>          Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic' 
     104!>          Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 'vosaline:int=cubic' 
    97105!>          @note  
    98106!>             If you do not specify a method which is required,  
     
    136144!>          segments are separated by '|'.<br/> 
    137145!>          each segments of the boundary is composed of: 
    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/> 
     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/> 
    143151!>             - optionally, boundary size could be added between '(' and ')'  
    144152!>             in the first segment defined. 
     
    147155!> 
    148156!>          Examples: 
    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 !> 
     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 
    155161!>       - cn_south  : south boundary indices on fine grid 
    156162!>       - cn_east   : east  boundary indices on fine grid 
    157163!>       - cn_west   : west  boundary indices on fine grid 
    158164!>       - ln_oneseg : use only one segment for each boundary or not 
    159 !>       - in_extrap : number of mask point to be extrapolated 
    160 !> 
    161 !>   * _output namelist (namout)_:<br/> 
     165!> 
     166!>    * _output namelist (namout)_:<br/> 
    162167!>       - cn_fileout : fine grid boundary basename 
    163168!>         (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!>        
    164179!> 
    165180!> @author J.Paul 
     
    169184!> - add header for user 
    170185!> - take into account grid point to compue boundaries 
    171 !> - reorder output dimension for north and south 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.   
    172192!> 
    173193!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    191211   USE dom                             ! domain manager 
    192212   USE grid                            ! grid manager 
    193    USE vgrid                           ! vartical grid manager 
     213   USE vgrid                           ! vertical grid manager 
    194214   USE extrap                          ! extrapolation manager 
    195215   USE interp                          ! interpolation manager 
     
    213233   INTEGER(i4)                                        :: il_status 
    214234   INTEGER(i4)                                        :: il_fileid 
    215    INTEGER(i4)                                        :: il_dim 
    216235   INTEGER(i4)                                        :: il_imin0 
    217236   INTEGER(i4)                                        :: il_imax0 
     
    239258 
    240259   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim 
     260 
     261   TYPE(TDATE)                                        :: tl_date 
    241262    
    242263   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy 
     
    265286   ! namelist variable 
    266287   ! namlog 
    267    CHARACTER(LEN=lc)                       :: cn_logfile = 'create_boundary.log'  
    268    CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning'  
    269    INTEGER(i4)                             :: in_maxerror = 5 
     288   CHARACTER(LEN=lc)  :: cn_logfile = 'create_boundary.log'  
     289   CHARACTER(LEN=lc)  :: cn_verbosity = 'warning'  
     290   INTEGER(i4)        :: in_maxerror = 5 
    270291 
    271292   ! namcfg 
    272    CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg'  
     293   CHARACTER(LEN=lc)  :: cn_varcfg = 'variable.cfg'  
    273294 
    274295   ! namcrs 
    275    CHARACTER(LEN=lc)                       :: cn_coord0 = ''  
    276    INTEGER(i4)                             :: in_perio0 = -1 
     296   CHARACTER(LEN=lc)  :: cn_coord0 = ''  
     297   INTEGER(i4)        :: in_perio0 = -1 
    277298 
    278299   ! namfin 
    279    CHARACTER(LEN=lc)                       :: cn_coord1 = ''  
    280    CHARACTER(LEN=lc)                       :: cn_bathy1 = ''  
    281    INTEGER(i4)                             :: in_perio1 = -1 
     300   CHARACTER(LEN=lc)  :: cn_coord1 = ''  
     301   CHARACTER(LEN=lc)  :: cn_bathy1 = ''  
     302   INTEGER(i4)        :: in_perio1 = -1 
    282303 
    283304   !namzgr 
    284    INTEGER(i4)                             :: in_nlevel = 75 
     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 
    285321 
    286322   ! namvar 
     
    289325 
    290326   ! namnst 
    291    INTEGER(i4)                             :: in_rhoi  = 0 
    292    INTEGER(i4)                             :: in_rhoj  = 0 
     327   INTEGER(i4)       :: in_rhoi  = 0 
     328   INTEGER(i4)       :: in_rhoj  = 0 
    293329 
    294330   ! nambdy 
    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 
     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. 
    305340 
    306341   ! namout 
    307    CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc'  
     342   CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc'  
     343   REAL(dp)          :: dn_dayofs  = 0._dp 
     344   LOGICAL           :: ln_extrap  = .FALSE. 
    308345   !------------------------------------------------------------------- 
    309346 
     
    319356   &  cn_coord0,     &  !< coordinate file 
    320357   &  in_perio0         !< periodicity index 
    321     
     358  
    322359   NAMELIST /namfin/ &  !< fine grid namelist 
    323360   &  cn_coord1,     &  !< coordinate file 
     
    326363  
    327364   NAMELIST /namzgr/ & 
    328    &  in_nlevel 
     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 
    329381 
    330382   NAMELIST /namvar/ &  !< variable namelist 
    331383   &  cn_varinfo,    &  !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) 
    332384   &  cn_varfile        !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' )  
    333     
     385  
    334386   NAMELIST /namnst/ &  !< nesting namelist 
    335387   &  in_rhoi,       &  !< refinement factor in i-direction 
     
    345397   &  cn_east ,      &  !< east  boundary indices on fine grid 
    346398   &  cn_west ,      &  !< west  boundary indices on fine grid 
    347    &  ln_oneseg,     &  !< use only one segment for each boundary or not 
    348    &  in_extrap         !< number of mask point to be extrapolated 
     399   &  ln_oneseg         !< use only one segment for each boundary or not 
    349400 
    350401   NAMELIST /namout/ &  !< output namelist 
    351    &  cn_fileout    !< fine grid boundary file basename    
     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 
    352405   !------------------------------------------------------------------- 
    353406 
     
    448501   ! check 
    449502   ! check output file do not already exist 
     503   ! WARNING: do not work when use time to create output file name 
    450504   DO jk=1,ip_ncard 
    451505      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    452506      &                                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)) ) 
    453515      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist) 
    454516      IF( ll_exist )THEN 
     
    490552 
    491553   CALL iom_mpp_open(tl_bathy1) 
    492     
     554  
    493555   tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry') 
    494     
     556  
    495557   CALL iom_mpp_close(tl_bathy1) 
    496558 
     559   ! get boundaries indices 
    497560   tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, & 
    498561   &                                cn_north, cn_south, cn_east, cn_west, & 
     
    505568   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
    506569 
    507    ! get coordinate on each segment of each boundary 
     570   ! get coordinate for each segment of each boundary 
    508571   ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) ) 
    509572   ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) ) 
    510     
     573  
    511574   DO jl=1,ip_ncard 
    512575      IF( tl_bdy(jl)%l_use )THEN 
     
    516579            tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, & 
    517580            &                                            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 
    518588 
    519589            ! add extra band to fine grid domain (if possible) 
     
    523593               &                  il_rho(jp_I), il_rho(jp_J)) 
    524594            ENDDO 
    525  
    526             ! get fine grid level 
    527             tl_seglvl1(:,jk,jl)=create_boundary_get_level( tl_level(:), & 
    528                                                            tl_segdom1(:,jk,jl)) 
    529595 
    530596         ENDDO 
     
    594660                        &                          in_nlevel ) 
    595661 
    596                         ! use mask 
    597                         CALL create_boundary_use_mask( tl_segvar1(jvar,jk,jl), & 
    598                         &                         tl_seglvl1(jpoint,jk,jl)) 
    599  
    600662                        !del extra 
    601663                        CALL dom_del_extra( tl_segvar1(jvar,jk,jl), & 
     
    654716                  IF( tl_bdy(jl)%l_use )THEN 
    655717                      
    656                      WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 
     718                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 
     719                        &  ' boundary' 
    657720                     DO jk=1,tl_bdy(jl)%i_nseg 
    658721                        ! compute domain on fine grid 
     
    662725                            
    663726                           cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 
    664                            WRITE(*,'(4x,a,a)') "work on variable "//TRIM(cl_name) 
     727                           WRITE(*,'(4x,a,a)') "work on (extract) variable "//& 
     728                              &  TRIM(cl_name) 
    665729 
    666730                           cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point 
     
    678742 
    679743                           tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
    680                            tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 
    681744 
    682745                           ! open mpp files 
     
    687750                           &                     tl_mpp, TRIM(cl_name), tl_dom1) 
    688751 
    689                            ! use mask 
    690                            CALL create_boundary_use_mask( & 
    691                            &                 tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 
    692  
    693752                           ! del extra point 
    694753                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
     
    699758 
    700759                           ! add attribute to variable 
    701                            tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 
     760                           tl_att=att_init('src_file', & 
     761                              &  TRIM(fct_basename(tl_mpp%c_name))) 
    702762                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    703763 
    704                            tl_att=att_init('src_i_indices',(/tl_dom1%i_imin, tl_dom1%i_imax/)) 
     764                           tl_att=att_init('src_i_indices', & 
     765                              &  (/tl_dom1%i_imin, tl_dom1%i_imax/)) 
    705766                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    706767 
    707                            tl_att=att_init('src_j_indices',(/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 
     768                           tl_att=att_init('src_j_indices', & 
     769                              &  (/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 
    708770                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 
    709771 
     
    736798                  IF( tl_bdy(jl)%l_use )THEN 
    737799 
    738                      WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 
     800                     WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 
     801                        &  ' boundary' 
    739802                     DO jk=1,tl_bdy(jl)%i_nseg 
    740803                         
    741804                        ! for each variable of this file 
    742805                        DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    743                             
    744                            WRITE(*,'(4x,a,a)') "work on variable "//& 
     806  
     807                           WRITE(*,'(4x,a,a)') "work on (interp) variable "//& 
    745808                           &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    746809 
     
    759822 
    760823                           tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 
    761                            tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 
    762824 
    763825                           CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 
     
    795857                           &                 il_jmin0, il_jmax0 ) 
    796858 
    797                            ! add extra band (if possible) to compute interpolation 
     859                           ! add extra band (if possible) to compute  
     860                           ! interpolation 
    798861                           CALL dom_add_extra(tl_dom0) 
    799862 
     
    815878                           CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 
    816879                           &                   tl_dom0, il_rho(:) ) 
    817  
    818                            ! use mask 
    819                            CALL create_boundary_use_mask( & 
    820                            &     tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 
    821880 
    822881                           ! del extra point on fine grid 
     
    889948 
    890949   IF( jvar /= tl_multi%i_nvar )THEN 
    891       CALL logger_error("CREATE BOUNDARY: it seems some variable can not be read") 
     950      CALL logger_error("CREATE BOUNDARY: it seems some variable "//& 
     951         &  "can not be read") 
    892952   ENDIF 
    893  
    894    CALL var_clean(tl_seglvl1(:,:,:)) 
    895    DEALLOCATE( tl_seglvl1 ) 
    896953 
    897954   ! write file for each segment of each boundary 
    898955   DO jl=1,ip_ncard 
    899956      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    
    907957 
    908958         DO jk=1,tl_bdy(jl)%i_nseg 
     
    911961            &                               'T', tl_lon1, tl_lat1 ) 
    912962 
     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 
    913967            ! del extra point on fine grid 
    914968            CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) ) 
     
    924978            CALL boundary_swap(tl_lat1, tl_bdy(jl)) 
    925979            DO jvar=1,tl_multi%i_nvar 
    926                CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl)) 
    927980 
    928981               ! use additional request 
     982               ! change unit and apply factor 
     983               CALL var_chg_unit(tl_segvar1(jvar,jk,jl)) 
     984 
    929985               ! forced min and max value 
    930986               CALL var_limit_value(tl_segvar1(jvar,jk,jl)) 
     
    933989               CALL filter_fill_value(tl_segvar1(jvar,jk,jl)) 
    934990 
    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 ) 
     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)) 
    9401010 
    9411011            ENDDO 
     
    9441014            ! create file structure 
    9451015            ! set file namearray of level variable structure 
    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) ) 
     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 
    9521030            ELSE 
    953                cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 
    954                &                                TRIM(tl_bdy(jl)%c_card), jk ) 
     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 
    9551044            ENDIF 
    9561045            !  
     
    9601049            tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl)) 
    9611050 
    962             CALL dim_unorder(tl_dim(:)) 
    9631051            SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 
    9641052               CASE DEFAULT ! 'north','south' 
    9651053                  cl_dimorder='xyzt' 
    966                   CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
    9671054               CASE('east','west') 
    9681055                  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 
    9771056            END SELECT 
    9781057 
     
    9921071            ENDIF 
    9931072             
     1073 
     1074 
    9941075            IF( tl_dim(3)%l_use )THEN 
    995                ! add depth 
    996                CALL file_add_var(tl_fileout, tl_depth) 
     1076               IF( ASSOCIATED(tl_depth%d_value) )THEN 
     1077                  ! add depth 
     1078                  CALL file_add_var(tl_fileout, tl_depth) 
     1079               ENDIF 
    9971080            ENDIF 
    9981081 
    9991082            IF( tl_dim(4)%l_use )THEN 
    1000                ! add time 
    1001                CALL file_add_var(tl_fileout, tl_time) 
     1083               IF( ASSOCIATED(tl_time%d_value) )THEN 
     1084                  ! add time 
     1085                  CALL file_add_var(tl_fileout, tl_time) 
     1086               ENDIF 
    10021087            ENDIF 
    10031088 
    10041089            ! add other variable 
    1005             DO jvar=1,tl_multi%i_nvar 
     1090            DO jvar=tl_multi%i_nvar,1,-1 
    10061091               CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl)) 
    10071092               CALL var_clean(tl_segvar1(jvar,jk,jl)) 
     
    10481133 
    10491134            ! write file 
    1050             CALL iom_write_file(tl_fileout) 
     1135            CALL iom_write_file(tl_fileout, cl_dimorder) 
    10511136 
    10521137            ! close file 
     
    10661151   DEALLOCATE( tl_segdom1 ) 
    10671152   DEALLOCATE( tl_segvar1 ) 
     1153   CALL var_clean(tl_seglvl1(:,:,:)) 
     1154   DEALLOCATE( tl_seglvl1 ) 
     1155 
    10681156 
    10691157   CALL mpp_clean(tl_coord1) 
     
    10821170   !>  
    10831171   !> @author J.Paul 
    1084    !> - November, 2013- Initial Version 
     1172   !> @date November, 2013- Initial Version 
    10851173   !> @date September, 2014 
    10861174   !> - take into account grid point to compute boundary indices 
     
    11861274   !------------------------------------------------------------------- 
    11871275   !> @brief 
    1188    !> This subroutine get coordinates over boudnary domain 
     1276   !> This subroutine get coordinates over boundary domain 
    11891277   !>  
    11901278   !> @author J.Paul 
    1191    !> - November, 2013- Initial Version 
    1192    !> @date September, 2014 - take into account grid point 
     1279   !> @date November, 2013- Initial Version 
     1280   !> @date September, 2014  
     1281   !> - take into account grid point 
    11931282   !> 
    11941283   !> @param[in] td_coord1 coordinates file structure 
     
    12371326   !------------------------------------------------------------------- 
    12381327   !> @brief 
    1239    !> This subroutine interpolate variable over boundary 
     1328   !> This subroutine interpolate variable on boundary 
    12401329   !>  
    12411330   !> @details  
     
    12961385 
    12971386      ! extrapolate variable 
    1298       CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext ) 
     1387      CALL extrap_fill_value( td_var ) 
    12991388 
    13001389      ! interpolate Bathymetry 
     
    13031392 
    13041393      ! remove extraband 
    1305       CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 
     1394      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), & 
     1395         &                               il_jext*id_rho(jp_J)) 
    13061396 
    13071397   END SUBROUTINE create_boundary_interp 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_coord.f90

    r5037 r5608  
    2424!> @endcode 
    2525!>     
     26!> @note  
     27!>    you could find a template of the namelist in templates directory. 
     28!> 
    2629!>    create_coord.nam comprise 6 namelists:<br/> 
    2730!>       - logger namelist (namlog) 
     
    3942!>       - cn_logfile   : log filename 
    4043!>       - cn_verbosity : verbosity ('trace','debug','info', 
    41 !> 'warning','error','fatal') 
     44!> 'warning','error','fatal','none') 
    4245!>       - in_maxerror  : maximum number of error allowed 
    4346!> 
     
    5457!>       - cn_varinfo : list of variable and extra information about request(s) 
    5558!> to be used.<br/> 
    56 !>          each elements of *cn_varinfo* is a string character.<br/> 
     59!>          each elements of *cn_varinfo* is a string character  
     60!>          (separated by ',').<br/> 
    5761!>          it is composed of the variable name follow by ':',  
    5862!>          then request(s) to be used on this variable.<br/>  
    5963!>          request could be: 
    60 !>             - interpolation method 
    61 !>             - extrapolation method 
    62 !>             - filter method 
     64!>             - int = interpolation method 
     65!>             - ext = extrapolation method 
     66!>             - flt = filter method 
    6367!>  
    6468!>                requests must be separated by ';' .<br/> 
     
    6872!>          @ref extrap and @ref filter modules.<br/> 
    6973!> 
    70 !>          Example: 'votemper: linear; hann(2,3); dist_weight',  
    71 !>          'vosaline: cubic'<br/> 
     74!>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight',  
     75!>          'vosaline: int=cubic'<br/> 
    7276!>          @note  
    7377!>             If you do not specify a method which is required,  
     
    9094!> 
    9195!>    * _output namelist (namout)_: 
    92 !>       - cn_fileout : output coordinate file 
     96!>       - cn_fileout : output coordinate file name 
    9397!> 
    9498!> @author J.Paul 
     
    152156   TYPE(TFILE)                                          :: tl_fileout 
    153157 
    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  
    162158   ! loop indices 
    163159   INTEGER(i4) :: ji 
     
    165161 
    166162   ! namelist variable 
     163   ! namlog 
    167164   CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log'  
    168165   CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    169166   INTEGER(i4)       :: in_maxerror = 5 
    170167 
     168   ! namcfg 
     169   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
     170 
     171   ! namcrs 
    171172   CHARACTER(LEN=lc) :: cn_coord0 = ''  
    172173   INTEGER(i4)       :: in_perio0 = -1 
    173174 
    174    CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
    175  
     175   ! namvar 
    176176   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    177177 
     178   !namnst 
    178179   INTEGER(i4)       :: in_imin0 = 0 
    179180   INTEGER(i4)       :: in_imax0 = 0 
     
    183184   INTEGER(i4)       :: in_rhoj  = 1 
    184185 
     186   !namout 
    185187   CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc' 
    186188   !------------------------------------------------------------------- 
     
    305307 
    306308      il_offset(:,:,:)=create_coord_get_offset(il_rho(:)) 
    307  
    308309   ENDIF 
    309310 
     
    348349      CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. ) 
    349350 
    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  
    354351      ! filter 
    355352      CALL filter_fill_value(tl_var(ji))       
     
    375372 
    376373   ! add variables 
    377    DO ji=1,il_nvar 
     374   DO ji=il_nvar,1,-1 
    378375      CALL file_add_var(tl_fileout, tl_var(ji)) 
     376      CALL var_clean(tl_var(ji)) 
    379377   ENDDO 
    380  
    381    ! recompute some attribute 
    382378 
    383379   ! add some attribute 
     
    440436 
    441437   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) 
    475438 
    476439   ! close log file 
     
    539502   !> @param[in] id_iext   number of points to be extrapolated in i-direction 
    540503   !> @param[in] id_jext   number of points to be extrapolated in j-direction 
     504   !> 
     505   !> @todo check if mask is really needed 
    541506   !------------------------------------------------------------------- 
    542507   SUBROUTINE create_coord_interp( td_var,          & 
     
    626591 
    627592         ! extrapolate variable 
    628          CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext ) 
     593         CALL extrap_fill_value( td_var ) 
    629594 
    630595         ! interpolate variable 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/create_restart.f90

    r5037 r5608  
    2525!> @endcode 
    2626!>     
     27!> @note  
     28!>    you could find a template of the namelist in templates directory. 
     29!> 
    2730!>    create_restart.nam comprise 9 namelists:<br/> 
    2831!>       - logger namelist (namlog) 
     
    4346!>       - cn_logfile   : log filename 
    4447!>       - cn_verbosity : verbosity ('trace','debug','info', 
    45 !> 'warning','error','fatal') 
     48!> 'warning','error','fatal','none') 
    4649!>       - in_maxerror  : maximum number of error allowed 
    4750!> 
     
    5962!>       - cn_bathy1 : bathymetry file 
    6063!>       - in_perio1 : NEMO periodicity index 
    61 !>       - in_extrap : number of land point to be extrapolated  
    62 !>       before writing file 
    6364!> 
    6465!>    * _vertical grid namelist (namzgr)_:<br/> 
     
    8384!>       - cn_varinfo : list of variable and extra information about request(s)  
    8485!>       to be used.<br/> 
    85 !>          each elements of *cn_varinfo* is a string character.<br/> 
     86!>          each elements of *cn_varinfo* is a string character 
     87!>          (separated by ',').<br/> 
    8688!>          it is composed of the variable name follow by ':',  
    8789!>          then request(s) to be used on this variable.<br/>  
    8890!>          request could be: 
    89 !>             - interpolation method 
    90 !>             - extrapolation method 
    91 !>             - filter method 
    92 !>             - > minimum value 
    93 !>             - < maximum value 
     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) 
    9498!> 
    9599!>             requests must be separated by ';'.<br/> 
     
    98102!>          informations about available method could be find in @ref interp, 
    99103!>          @ref extrap and @ref filter.<br/> 
    100 !>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic' 
     104!>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic' 
    101105!>          @note  
    102106!>             If you do not specify a method which is required,  
     
    136140!>    * _output namelist (namout)_:<br/> 
    137141!>       - cn_fileout : output file 
    138 !>       - in_nproc  : total number of processor to be used 
     142!>       - ln_extrap : extrapolate land point or not 
    139143!>       - in_niproc : i-direction number of processor 
    140144!>       - in_njproc : j-direction numebr of processor 
     145!>       - in_nproc  : total number of processor to be used 
    141146!>       - cn_type   : output format ('dimg', 'cdf') 
    142147!> 
     
    148153!> - offset computed considering grid point 
    149154!> - 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. 
    150158!> 
    151159!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    165173   USE iom                             ! I/O manager 
    166174   USE grid                            ! grid manager 
    167    USE vgrid                           ! vertical grid manager 
     175   USE vgrid                            ! vertical grid manager 
    168176   USE extrap                          ! extrapolation manager 
    169177   USE interp                          ! interpolation manager 
     
    249257   CHARACTER(LEN=lc) :: cn_bathy1 = '' 
    250258   INTEGER(i4)       :: in_perio1 = -1 
    251    INTEGER(i4)       :: in_extrap = 0 
    252259 
    253260   !namzgr 
     
    279286   ! namout 
    280287   CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'  
     288   LOGICAL           :: ln_extrap  = .FALSE. 
    281289   INTEGER(i4)       :: in_nproc   = 0 
    282290   INTEGER(i4)       :: in_niproc  = 0 
     
    301309   &  cn_coord1,   &    !< coordinate file 
    302310   &  cn_bathy1,   &    !< bathymetry file 
    303    &  in_perio1,   &    !< periodicity index 
    304    &  in_extrap 
     311   &  in_perio1         !< periodicity index 
    305312  
    306313   NAMELIST /namzgr/ & 
     
    332339   NAMELIST /namout/ &  !< output namlist 
    333340   &  cn_fileout, &     !< fine grid bathymetry file 
    334    &  in_nproc,   &     !< number of processor to be used 
     341   &  ln_extrap,  &     !< extrapolate or not 
    335342   &  in_niproc,  &     !< i-direction number of processor 
    336343   &  in_njproc,  &     !< j-direction numebr of processor 
     344   &  in_nproc,   &     !< number of processor to be used 
    337345   &  cn_type           !< output type format (dimg, cdf) 
    338346   !------------------------------------------------------------------- 
     
    347355      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 
    348356   ENDIF 
    349     
     357 
    350358   ! read namelist 
    351359   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
     
    434442   ! check 
    435443   ! check output file do not already exist 
    436    cl_fileout=file_rename(cn_fileout,1) 
     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 
    437449   INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 
    438450   IF( ll_exist )THEN 
     
    468480   &                            il_rho(:) ) 
    469481 
    470    ! compute level 
    471    ALLOCATE(tl_level(ip_npoint)) 
    472    tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
    473  
    474    ! remove ghost cell 
     482   ! fine grid ghost cell 
    475483   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) 
    482484 
    483485   ! work on variables 
     
    514516               tl_var(jvar) = create_restart_matrix( & 
    515517               &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, & 
    516                &  in_nlevel, tl_level(:) ) 
     518               &  in_nlevel, il_xghost(:,:) ) 
     519 
     520               ! add ghost cell 
     521               CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 
    517522 
    518523            ENDDO 
     
    535540            ! open mpp file 
    536541            CALL iom_mpp_open(tl_mpp) 
     542 
    537543 
    538544            ! get or check depth value 
     
    579585               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    580586 
    581                   WRITE(*,'(2x,a,a)') "work on variable "//& 
     587                  WRITE(*,'(2x,a,a)') "work on (extract) variable "//& 
    582588                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    583589 
     
    600606                  CALL att_clean(tl_att) 
    601607 
    602                   ! use mask 
    603                   CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    604  
    605608                  ! add ghost cell 
    606                   CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:) ) 
     609                  CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:)) 
    607610 
    608611               ENDDO 
     
    631634               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    632635 
    633                   WRITE(*,'(2x,a,a)') "work on variable "//& 
     636                  WRITE(*,'(2x,a,a)') "work on (interp) variable "//& 
    634637                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    635638 
     
    646649                  &                                   id_rho=il_rho(:), & 
    647650                  &                                   cd_point=TRIM(tl_var(jvar)%c_point)) 
    648                    
    649651 
    650652                  ! interpolate variable 
    651                   CALL create_restart_interp(tl_var(jvar), tl_level(:), & 
     653                  CALL create_restart_interp(tl_var(jvar), &  
    652654                  &                          il_rho(:), & 
    653655                  &                          id_offset=il_offset(:,:)) 
     
    675677                  CALL att_clean(tl_att) 
    676678 
    677                   ! use mask 
    678                   CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    679  
    680679                  ! add ghost cell 
    681                   CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) ) 
    682  
    683  
     680                  CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 
    684681               ENDDO 
    685682 
     
    705702   CALL mpp_clean(tl_coord0) 
    706703 
     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 
    707713   ! use additional request 
    708714   DO jvar=1,il_nvar 
    709715 
     716      ! change unit and apply factor 
     717      CALL var_chg_unit(tl_var(jvar)) 
     718 
    710719      ! forced min and max value 
    711720      CALL var_limit_value(tl_var(jvar)) 
     
    714723      CALL filter_fill_value(tl_var(jvar)) 
    715724 
    716       ! extrapolate 
    717       CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, & 
    718       &                                    id_jext=in_extrap, & 
    719       &                                    id_kext=in_extrap) 
     725      IF( .NOT. ln_extrap )THEN 
     726         ! use mask 
     727         CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
     728      ENDIF 
    720729 
    721730   ENDDO 
     
    724733   IF( in_niproc == 0 .AND. & 
    725734   &   in_njproc == 0 .AND. & 
    726    &   in_nproc  == 0 )THEN 
     735   &   in_nproc == 0 )THEN 
    727736      in_niproc = 1 
    728737      in_njproc = 1 
     
    782791         CALL mpp_add_var(tl_mppout, tl_depth) 
    783792      ELSE 
    784          CALL logger_error("CREATE RESTART: no value for depth variable.") 
     793         CALL logger_warn("CREATE RESTART: no value for depth variable.") 
    785794      ENDIF 
    786795   ENDIF 
     
    792801         CALL mpp_add_var(tl_mppout, tl_time) 
    793802      ELSE 
    794          CALL logger_error("CREATE RESTART: no value for time variable.") 
     803         CALL logger_warn("CREATE RESTART: no value for time variable.") 
    795804      ENDIF 
    796805   ENDIF 
     
    798807 
    799808   ! add other variable 
    800    DO jvar=1,il_nvar 
     809   DO jvar=il_nvar,1,-1 
    801810      ! check if variable already add 
    802811      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) 
     
    807816   ENDDO 
    808817 
    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  
    814818   ! add some attribute 
    815819   tl_att=att_init("Created_by","SIREN create_restart") 
     
    839843   ENDIF 
    840844 
     845   ! print 
     846   CALL mpp_print(tl_mppout) 
     847 
    841848   ! create file 
    842849   CALL iom_mpp_create(tl_mppout) 
     
    847854   CALL iom_mpp_close(tl_mppout) 
    848855 
    849    ! print 
    850    CALL mpp_print(tl_mppout) 
    851  
    852856   ! clean 
    853857   CALL att_clean(tl_att) 
    854858   CALL var_clean(tl_var(:)) 
    855859   DEALLOCATE(tl_var) 
    856    CALL var_clean(tl_level(:)) 
    857    DEALLOCATE(tl_level) 
     860   IF( .NOT. ln_extrap )THEN 
     861      CALL var_clean(tl_level(:)) 
     862      DEALLOCATE(tl_level) 
     863   ENDIF 
    858864 
    859865   CALL mpp_clean(tl_mppout) 
     
    876882   !> 
    877883   !> @author J.Paul 
    878    !> - November, 2013- Initial Version 
     884   !> @date November, 2013- Initial Version 
     885   !> @date June, 2015 
     886   !> - do not use level anymore  
    879887   !> 
    880888   !> @param[in] td_var    variable structure  
    881889   !> @param[in] td_coord  coordinate file structure  
    882890   !> @param[in] id_nlevel number of vertical level   
    883    !> @param[in] td_level  array of level on T,U,V,F point (variable structure)  
     891   !> @param[in] id_xghost ghost cell array 
    884892   !> @return variable structure  
    885893   !------------------------------------------------------------------- 
    886    FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level) 
     894   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost) 
    887895      IMPLICIT NONE 
    888896      ! Argument 
    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 
     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 
    893901 
    894902      ! function 
     
    899907      INTEGER(i4)      , DIMENSION(3)                    :: il_size 
    900908      INTEGER(i4)      , DIMENSION(3)                    :: il_rest 
    901       INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost 
    902909 
    903910      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape 
     
    915922      !---------------------------------------------------------------- 
    916923 
    917       ! look for ghost cell 
    918       il_xghost(:,:)=grid_get_ghost( td_coord ) 
    919  
    920924      ! write value on grid 
    921925      ! get matrix dimension 
     
    929933 
    930934      ! remove ghost cell 
    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 
     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 
    933937 
    934938      ! split output domain in N subdomain depending of matrix dimension  
     
    991995 
    992996      DEALLOCATE(dl_value) 
    993  
    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(:,:) ) 
    999997 
    1000998      ! clean  
     
    10711069   !>  
    10721070   !> @author J.Paul 
    1073    !> - Nov, 2013- Initial Version 
     1071   !> @date November, 2013- Initial Version 
     1072   !> @date June, 2015 
     1073   !> - do not use level anymore (for extrapolation) 
    10741074   !> 
    10751075   !> @param[inout] td_var    variable structure  
    1076    !> @param[inout] td_level  fine grid level, array of variable structure 
    10771076   !> @param[in] id_rho       array of refinment factor 
    10781077   !> @param[in] id_offset    array of offset between fine and coarse grid 
     
    10801079   !> @param[in] id_jext      j-direction size of extra bands (default=im_minext) 
    10811080   !------------------------------------------------------------------- 
    1082    SUBROUTINE create_restart_interp( td_var, td_level,& 
     1081   SUBROUTINE create_restart_interp( td_var, &  
    10831082   &                                 id_rho,          & 
    10841083   &                                 id_offset,       & 
     
    10891088      ! Argument 
    10901089      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
    1091       TYPE(TVAR) , DIMENSION(:)  , INTENT(INOUT) :: td_level 
    10921090      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho 
    10931091      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset 
     
    11191117         il_jext=2 
    11201118      ENDIF 
    1121  
    11221119      ! work on variable 
    11231120      ! add extraband 
     
    11251122 
    11261123      ! extrapolate variable 
    1127       CALL extrap_fill_value( td_var, td_level(:),    & 
    1128       &                               id_offset(:,:), & 
    1129       &                               id_rho(:),      & 
    1130       &                               id_iext=il_iext, id_jext=il_jext ) 
     1124      CALL extrap_fill_value( td_var ) 
    11311125 
    11321126      ! interpolate variable 
     
    12201214 
    12211215      ! get or check depth value 
     1216 
    12221217      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
    12231218 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r5037 r5608  
    7878!> 
    7979!>    This subroutine filled dimension structure with unused dimension,  
    80 !>    then switch from "unordered" dimension to "ordered" dimension.<br/> 
     80!>    then switch from "disordered" 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 unordered 
     96!>    to switch dimension array from ordered dimension to disordered 
    9797!> dimension:<br/> 
    9898!> @code 
    99 !>    CALL dim_unorder(tl_dim(:)) 
     99!>    CALL dim_disorder(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 "unordered" 
    114 !> 
    115 !>    to reshape array of value in "unordered" dimension:<br/> 
     113!>       - value must be a 4D array of real(8) value "disordered" 
     114!> 
     115!>    to reshape array of value in "disordered" 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 "unordered". 
     125!>       - tab must be a 1D array with 4 elements "disordered". 
    126126!>       It could be composed of character, integer(4), or logical 
    127127!>  
    128 !>    to reorder a 1D array of 4 elements in "unordered" dimension:<br/> 
    129 !> @code 
    130 !>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 
     128!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/> 
     129!> @code 
     130!>    CALL dim_reorder_xyzt2(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 unordered to ordered dimension 
    176    PUBLIC :: dim_unorder       !< switch dimension array from ordered to unordered dimension 
     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 
    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 - do not check if dimension used 
     323   !> @date September, 2014  
     324   !> - do not check if dimension used 
    324325   !> 
    325326   !> @param[in] td_dim    array of dimension structure 
     
    502503   !> Optionally length could be inform, as well as short name and if dimension 
    503504   !> is unlimited or not.<br/> 
    504    !> define dimension is supposed to be used. 
    505    !> 
    506    !> @author J.Paul 
    507    !> @date November, 2013 - Initial Version 
     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 
    508515   ! 
    509516   !> @param[in] cd_name   dimension name 
     
    511518   !> @param[in] ld_uld    dimension unlimited 
    512519   !> @param[in] cd_sname  dimension short name 
     520   !> @param[in] ld_uld    dimension use or not 
    513521   !> @return dimension structure 
    514522   !------------------------------------------------------------------- 
    515    TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname) 
     523   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use) 
    516524      IMPLICIT NONE 
    517525 
     
    521529      LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld 
    522530      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname 
     531      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use 
    523532 
    524533      ! local variable 
     
    543552 
    544553      ! define dimension is supposed to be used 
    545       dim_init%l_use=.TRUE. 
     554      IF( PRESENT(ld_use) )THEN 
     555         dim_init%l_use=ld_use 
     556      ELSE 
     557         dim_init%l_use=.TRUE. 
     558      ENDIF 
    546559 
    547560      IF( PRESENT(cd_sname) )THEN 
     
    590603      ENDIF 
    591604       
    592       ! get dimension orderer index 
    593       dim_init%i_2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
     605      ! get dimension order indices 
     606      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
    594607 
    595608   END FUNCTION dim_init 
     
    655668   !> @author J.Paul 
    656669   !> @date November, 2013 - Initial Version 
     670   !> @date July, 2015  
     671   !> - Bug fix: use order to disorder table (see dim_init) 
    657672   !> 
    658673   !> @param[in] td_dim array of dimension structure 
     
    686701         ! search missing dimension 
    687702         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN 
    688             ! search first empty dimension 
    689             il_ind(:)=MINLOC( tl_dim(:)%i_2xyzt, tl_dim(:)%i_2xyzt == 0 ) 
     703            ! search first empty dimension (see dim_init) 
     704            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 ) 
    690705 
    691706            ! put missing dimension instead of empty one 
     
    693708            ! update output structure 
    694709            tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 
    695             tl_dim(il_ind(1))%i_2xyzt=ji 
     710            tl_dim(il_ind(1))%i_xyzt2=ji 
    696711            tl_dim(il_ind(1))%i_len=1 
    697712            tl_dim(il_ind(1))%l_use=.FALSE. 
     
    711726   !> This subroutine switch element of an array (4 elts) of dimension  
    712727   !> structure  
    713    !> from unordered dimension to ordered dimension <br/> 
     728   !> from disordered dimension to ordered dimension <br/> 
    714729   !> 
    715730   !> @details 
     
    722737   !> @author J.Paul 
    723738   !> @date November, 2013 - Initial Version 
    724    !> @date September, 2014 - allow to choose ordered dimension to be output 
     739   !> @date September, 2014  
     740   !> - allow to choose ordered dimension to be output 
    725741   !> 
    726742   !> @param[inout] td_dim    array of dimension structure 
     
    811827   !------------------------------------------------------------------- 
    812828   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t') 
    813    !> to unordered dimension. <br/> 
     829   !> to disordered dimension. <br/> 
    814830   !> @details 
    815831   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/> 
     
    822838   !> @param[inout] td_dim array of dimension structure 
    823839   !------------------------------------------------------------------- 
    824    SUBROUTINE dim_unorder(td_dim) 
     840   SUBROUTINE dim_disorder(td_dim) 
    825841      IMPLICIT NONE 
    826842      ! Argument       
     
    835851 
    836852      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    837          CALL logger_error("DIM UNORDER: invalid dimension of array dimension.") 
     853         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.") 
    838854      ELSE       
    839855         ! add dummy xyzt2 id to unused dimension 
     
    868884      ENDIF 
    869885 
    870    END SUBROUTINE dim_unorder 
     886   END SUBROUTINE dim_disorder 
    871887   !------------------------------------------------------------------- 
    872888   !> @brief This function reshape real(8) 4D array    
     
    908924 
    909925      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    910          CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of array dimension.") 
     926         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//& 
     927            &  "array dimension.") 
    911928      ELSE       
    912929 
     
    914931 
    915932            CALL logger_fatal( & 
    916             &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder & 
    917             &     before running RESHAPE" ) 
     933            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// & 
     934            &  "   before running RESHAPE" ) 
    918935 
    919936         ENDIF 
     
    972989   !------------------------------------------------------------------- 
    973990   !> @brief This function reshape ordered real(8) 4D array with dimension  
    974    !> (/'x','y','z','t'/) to an "unordered" array.<br/> 
     991   !> (/'x','y','z','t'/) to an "disordered" array.<br/> 
    975992   !> @details 
    976993   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/) 
     
    10091026 
    10101027      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    1011          CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of array dimension.") 
     1028         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//& 
     1029            &  "array dimension.") 
    10121030      ELSE 
    10131031 
     
    10151033 
    10161034            CALL logger_fatal( & 
    1017             &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder & 
    1018             &     before running RESHAPE" ) 
     1035            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// & 
     1036            &  "   before running RESHAPE" ) 
    10191037 
    10201038         ENDIF         
     
    11041122 
    11051123            CALL logger_error( & 
    1106             &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
    1107             &     before running REORDER" ) 
     1124            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//& 
     1125            &  "   before running REORDER" ) 
    11081126 
    11091127         ENDIF         
     
    11161134   END FUNCTION dim__reorder_2xyzt_i4 
    11171135   !------------------------------------------------------------------- 
    1118    !> @brief This function unordered integer(4) 1D array to be suitable with 
     1136   !> @brief This function disordered integer(4) 1D array to be suitable with 
    11191137   !> initial dimension order (ex: dimension read in file). 
    11201138   !> @note you must have run dim_reorder before use this subroutine 
     
    11431161      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    11441162      &   SIZE(id_arr(:)) /= ip_maxdim )THEN 
    1145          CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//& 
    1146          &              " or of array of value.") 
     1163         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//& 
     1164            &  "array dimension or of array of value.") 
    11471165      ELSE       
    11481166         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    11491167 
    11501168            CALL logger_error( & 
    1151             &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    1152             &     before running REORDER" ) 
     1169            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// & 
     1170            &  "   before running REORDER" ) 
    11531171 
    11541172         ENDIF         
     
    11931211 
    11941212            CALL logger_error( & 
    1195             &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
    1196             &     before running REORDER" ) 
     1213            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// & 
     1214            &  "   before running REORDER" ) 
    11971215 
    11981216         ENDIF         
     
    12051223   END FUNCTION dim__reorder_2xyzt_l 
    12061224   !------------------------------------------------------------------- 
    1207    !> @brief This function unordered logical 1D array to be suitable with 
     1225   !> @brief This function disordered logical 1D array to be suitable with 
    12081226   !> initial dimension order (ex: dimension read in file). 
    12091227   !> @note you must have run dim_reorder before use this subroutine 
     
    12381256 
    12391257            CALL logger_error( & 
    1240             &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    1241             &     before running REORDER" ) 
     1258            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//& 
     1259            &  "  before running REORDER" ) 
    12421260 
    12431261         ENDIF         
     
    12941312   END FUNCTION dim__reorder_2xyzt_c 
    12951313   !------------------------------------------------------------------- 
    1296    !> @brief This function unordered string 1D array to be suitable with 
     1314   !> @brief This function disordered string 1D array to be suitable with 
    12971315   !> initial dimension order (ex: dimension read in file). 
    12981316   !> @note you must have run dim_reorder before use this subroutine 
     
    13261344         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    13271345            CALL logger_error( & 
    1328             &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    1329             &     before running REORDER" ) 
     1346            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// & 
     1347            &  "   before running REORDER" ) 
    13301348 
    13311349         ENDIF         
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md

    r5037 r5608  
    1414   SIREN codes were succesfully tested with : 
    1515   - ifort (version 12.0.4) 
    16    - gfortran (version 4.7.2 20121109) 
     16<!--   - gfortran (version 4.7.2 20121109) --> 
    1717<!--   - pgf95 (version 13.9-0) --> 
    1818 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md

    r5037 r5608  
    8080 
    8181# Implicit none {#implicit} 
    82 All subroutines and functions will include an IMPLICTI NONE statement. 
     82All subroutines and functions will include an IMPLICIT NONE statement. 
    8383 
    8484# Header {#header} 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/domain.f90

    r5037 r5608  
    294294   ! 
    295295   !> @author J.Paul 
    296    !> - June, 2013- Initial Version 
     296   !> @date 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             &  "you should use grid_get_perio to compute it") 
     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") 
    366367         ELSE 
    367368            dom__init_mpp%i_perio0=td_mpp%i_perio 
     
    424425   ! 
    425426   !> @author J.Paul 
    426    !> - June, 2013- Initial Version 
     427   !> @date June, 2013- Initial Version 
    427428   !> @date September, 2014 
    428429   !> - add boundary index 
     
    489490 
    490491         IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN 
    491             CALL logger_error("DOM INIT: invalid grid periodicity. "//& 
    492             &  "you should use grid_get_perio to compute it") 
     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") 
    493495         ELSE 
    494496            dom__init_file%i_perio0=td_file%i_perio 
     
    653655   !> 
    654656   !> @author J.Paul 
    655    !> - November, 2013- Subroutine written 
     657   !> @date November, 2013 - Initial version 
    656658   !> @date September, 2014 
    657659   !> - use zero indice to defined cyclic or global domain 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/extrap.f90

    r5037 r5608  
    1919!>    defining string character _cn\_varinfo_. By default _dist_weight_.<br/> 
    2020!>    Example: 
    21 !>       - cn_varinfo='varname1:dist_weight', 'varname2:min_error' 
     21!>       - cn_varinfo='varname1:ext=dist_weight', 'varname2:ext=min_error' 
    2222!> 
    2323!>    to detect point to be extrapolated:<br/> 
    2424!> @code 
    25 !>    il_detect(:,:,:)=extrap_detect(td_var, [td_level], [id_offset,] [id_rho,] [id_ext])  
     25!>    il_detect(:,:,:)=extrap_detect(td_var) 
    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] 
    3329!> 
    3430!>    to extrapolate variable:<br/> 
    3531!> @code 
    36 !>    CALL extrap_fill_value( td_var, [td_level], [id_offset], [id_rho], [id_iext], [id_jext], [id_kext], [id_radius], [id_maxiter]) 
     32!>    CALL extrap_fill_value( td_var, [id_radius]) 
    3733!> @endcode 
    3834!>       - 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] 
    4535!>       - id_radius is radius of the halo used to compute extrapolation [optional] 
    46 !>       - id_maxiter is maximum number of iteration [optional] 
    4736!> 
    4837!>    to add extraband to the variable (to be extrapolated):<br/> 
     
    6251!>       - id_jsize : j-direction size of extra bands [optional] 
    6352!> 
    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 !> 
    9053!> @warning _FillValue must not be zero (use var_chg_FillValue()) 
    9154!> 
     
    9356!> J.Paul 
    9457! REVISION HISTORY: 
    95 !> @date Nov, 2013 - Initial Version 
     58!> @date November, 2013 - Initial Version 
    9659!> @date September, 2014 
    9760!> - 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 
    9867!> 
    9968!> @todo 
    10069!> - create module for each extrapolation method 
     70!> - smooth extrapolated points 
    10171!> 
    10272!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    11080   USE date                            ! date manager 
    11181   USE logger                          ! log file manager 
     82   USE math                            ! mathematical function 
    11283   USE att                             ! attribute manager 
    11384   USE dim                             ! dimension manager 
     
    11889 
    11990   ! type and variable 
    120    PRIVATE :: im_maxiter   !< default maximum number of iteration  
    12191   PRIVATE :: im_minext    !< default minumum number of point to extrapolate 
    12292   PRIVATE :: im_mincubic  !< default minumum number of point to extrapolate for cubic interpolation 
     
    12797   PUBLIC :: extrap_add_extrabands !< add extraband to the variable (to be extrapolated)  
    12898   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 
    13299 
    133100   PRIVATE :: extrap__detect_wrapper      ! detected point to be extrapolated wrapper 
     
    141108   PRIVATE :: extrap__3D_dist_weight_fill !  
    142109 
    143    INTEGER(i4), PARAMETER :: im_maxiter = 10 !< default maximum number of iteration 
    144110   INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of point to extrapolate 
    145111   INTEGER(i4), PARAMETER :: im_mincubic= 4  !< default minumum number of point to extrapolate for cubic interpolation 
     
    171137   !>  
    172138   !> @author J.Paul 
    173    !> - November, 2013- Initial Version 
     139   !> @date November, 2013 - Initial Version 
     140   !> @date June, 2015 
     141   !> - do not use level to select points to be extrapolated 
    174142   ! 
    175143   !> @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 
    180144   !> @return array of point to be extrapolated 
    181145   !------------------------------------------------------------------- 
    182    FUNCTION extrap__detect( td_var0, td_level1, & 
    183    &                        id_offset, id_rho, id_ext ) 
     146   FUNCTION extrap__detect( td_var0 )  
    184147      IMPLICIT NONE 
    185148      ! Argument 
    186149      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 
    191150 
    192151      ! function 
     
    196155 
    197156      ! 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  
    213157      ! loop indices 
    214158      INTEGER(i4) :: ji0 
    215159      INTEGER(i4) :: jj0 
    216160      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 
    223161      !---------------------------------------------------------------- 
    224162 
    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 ) 
     163      ! force to extrapolated all points 
     164      extrap__detect(:,:,:)=1 
    374165 
    375166      ! do not compute grid point already inform 
     
    377168         DO jj0=1,td_var0%t_dim(2)%i_len 
    378169            DO ji0=1,td_var0%t_dim(1)%i_len 
    379                IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill ) il_detect(ji0,jj0,jk0)=0 
     170               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill )THEN 
     171                  extrap__detect(ji0,jj0,jk0)=0 
     172               ENDIF 
    380173            ENDDO 
    381174         ENDDO 
    382175      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 ) 
    392176 
    393177   END FUNCTION extrap__detect 
     
    398182   !>  
    399183   !> @author J.Paul 
    400    !> - November, 2013- Initial Version 
     184   !> @date November, 2013 - Initial Version 
     185   !> @date June, 2015 
     186   !> - select all land points for extrapolation 
    401187   !> 
    402188   !> @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 
    407189   !> @return 3D array of point to be extrapolated 
    408190   !------------------------------------------------------------------- 
    409    FUNCTION extrap__detect_wrapper( td_var, td_level, & 
    410    &                                id_offset, id_rho, id_ext ) 
     191   FUNCTION extrap__detect_wrapper( td_var ) 
    411192 
    412193      IMPLICIT NONE 
    413194      ! Argument 
    414195      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 
    419196 
    420197      ! function 
     
    439216         &              " for variable "//TRIM(td_var%c_name) ) 
    440217          
    441          extrap__detect_wrapper(:,:,:)=extrap__detect( td_var, td_level, & 
    442          &                                             id_offset, & 
    443          &                                             id_rho,    & 
    444          &                                             id_ext     ) 
     218         extrap__detect_wrapper(:,:,:)=extrap__detect( td_var ) 
    445219 
    446220      ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
     
    450224         &              " for variable "//TRIM(td_var%c_name) ) 
    451225          
    452          extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var , td_level,& 
    453          &                                               id_offset, & 
    454          &                                               id_rho,    & 
    455          &                                               id_ext     ) 
     226         extrap__detect_wrapper(:,:,1:1)=extrap__detect( td_var ) 
    456227 
    457228      ELSE IF( td_var%t_dim(3)%l_use )THEN 
     
    461232         &              " for variable "//TRIM(td_var%c_name) ) 
    462233          
    463          extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var , td_level, & 
    464          &                                                 id_offset, & 
    465          &                                                 id_rho,    & 
    466          &                                                 id_ext     ) 
     234         extrap__detect_wrapper(1:1,1:1,:)=extrap__detect( td_var ) 
    467235 
    468236      ENDIF               
     
    489257   !> 
    490258   !> @author J.Paul 
    491    !> - Nov, 2013- Initial Version 
     259   !> @date November, 2013 - Initial Version 
     260   !> @date June, 2015 
     261   !> - select all land points for extrapolation 
    492262   ! 
    493263   !> @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 
    500264   !> @param[in] id_radius    radius of the halo used to compute extrapolation  
    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 ) 
     265   !------------------------------------------------------------------- 
     266   SUBROUTINE extrap__fill_value_wrapper( td_var, &  
     267   &                                      id_radius ) 
    508268      IMPLICIT NONE 
    509269      ! Argument 
    510270      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 
    517271      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_radius 
    518       INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_maxiter 
    519272 
    520273      ! local variable 
    521       INTEGER(i4) :: il_iext 
    522       INTEGER(i4) :: il_jext 
    523       INTEGER(i4) :: il_kext 
    524274      INTEGER(i4) :: il_radius 
    525       INTEGER(i4) :: il_maxiter 
    526275 
    527276      CHARACTER(LEN=lc) :: cl_method 
     
    544293         END SELECT 
    545294 
    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 
     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 
     299            CALL logger_error("EXTRAP FILL VALUE: invalid "//& 
     300            &  " radius of the box used to compute extrapolation "//& 
     301            &  "("//TRIM(fct_str(il_radius))//")") 
    556302         ENDIF 
    557303 
    558          IF( il_iext < 0 )THEN 
    559             CALL logger_error("EXTRAP FILL VALUE: invalid "//& 
    560             &  " number of points to be extrapolated in i-direction "//& 
    561             &  "("//TRIM(fct_str(il_iext))//")") 
    562          ENDIF 
    563  
    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 
     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 ) 
    608309  
    609310      ENDIF 
     
    621322   !> 
    622323   !> @author J.Paul 
    623    !> - November, 2013- Initial Version 
     324   !> @date November, 2013 - Initial Version 
     325   !> @date June, 2015 
     326   !> - select all land points for extrapolation 
    624327   ! 
    625328   !> @param[inout] td_var    variable structure 
    626329   !> @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 
    630330   !> @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 
    635331   !------------------------------------------------------------------- 
    636332   SUBROUTINE extrap__fill_value( td_var, cd_method, & 
    637    &                              id_iext, id_jext, id_kext, & 
    638    &                              id_radius, id_maxiter, & 
    639    &                              td_level,          & 
    640    &                              id_offset,         & 
    641    &                              id_rho ) 
     333   &                              id_radius ) 
    642334      IMPLICIT NONE 
    643335      ! Argument 
    644336      TYPE(TVAR)      ,                 INTENT(INOUT) :: td_var 
    645337      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 
    649338      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 
    654339 
    655340      ! local variable 
     
    668353      &                    td_var%t_dim(3)%i_len) ) 
    669354 
    670       il_detect(:,:,:) = extrap_detect( td_var, td_level, & 
    671       &                                 id_offset,        & 
    672       &                                 id_rho,           & 
    673       &                                 id_ext=(/id_iext, id_jext, id_kext/) ) 
     355      il_detect(:,:,:) = extrap_detect( td_var ) 
     356 
    674357      !2- add attribute to variable 
    675358      cl_extrap=fct_concat(td_var%c_extrap(:)) 
     
    679362      CALL att_clean(tl_att) 
    680363 
    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  ) 
     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 
    689381 
    690382      DEALLOCATE(il_detect) 
     
    705397   !> 
    706398   !> @author J.Paul 
    707    !> - Nov, 2013- Initial Version 
     399   !> @date November, 2013 - Initial Version 
     400   !> @date July, 2015  
     401   !> - compute coef indices to be used 
    708402   ! 
    709403   !> @param[inout] dd_value  3D array of variable to be extrapolated 
     
    714408   !------------------------------------------------------------------- 
    715409   SUBROUTINE extrap__3D( dd_value, dd_fill, id_detect,& 
    716    &                      cd_method, id_radius, id_maxiter ) 
     410   &                      cd_method, id_radius ) 
    717411      IMPLICIT NONE 
    718412      ! Argument 
    719413      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
    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 
     414      REAL(dp)   ,                     INTENT(IN   ) :: dd_fill 
     415      INTEGER(i4), DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect 
     416      CHARACTER(LEN=*),                INTENT(IN   ) :: cd_method 
     417      INTEGER(i4),                     INTENT(IN   ) :: id_radius 
    725418 
    726419      ! local variable 
    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 
     420      INTEGER(i4)                                :: il_imin 
     421      INTEGER(i4)                                :: il_imax 
     422      INTEGER(i4)                                :: il_jmin 
     423      INTEGER(i4)                                :: il_jmax 
     424      INTEGER(i4)                                :: il_kmin 
     425      INTEGER(i4)                                :: il_kmax 
     426      INTEGER(i4)                                :: il_iter 
     427      INTEGER(i4)                                :: il_radius 
     428      INTEGER(i4)                                :: il_i1 
     429      INTEGER(i4)                                :: il_i2 
     430      INTEGER(i4)                                :: il_j1 
     431      INTEGER(i4)                                :: il_j2 
     432      INTEGER(i4)                                :: il_k1 
     433      INTEGER(i4)                                :: il_k2 
     434 
     435      INTEGER(i4), DIMENSION(4)                  :: il_shape 
     436      INTEGER(i4), DIMENSION(3)                  :: il_dim 
    738437 
    739438      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
     
    743442      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdz 
    744443      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef 
     444 
     445      LOGICAL                                    :: ll_iter 
    745446 
    746447      ! loop indices 
     
    765466            DO WHILE( ANY(il_detect(:,:,:)==1) ) 
    766467               ! change extend value to minimize number of iteration 
    767                il_radius=id_radius+(il_iter/id_maxiter) 
     468               il_radius=id_radius+(il_iter-1) 
     469               ll_iter=.TRUE. 
    768470 
    769471               ALLOCATE( dl_dfdx(il_shape(1), il_shape(2), il_shape(3)) )  
     
    774476               dl_dfdx(:,:,:)=dd_fill 
    775477               IF( il_shape(1) > 1 )THEN 
    776                   dl_dfdx(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'I' ) 
     478                  dl_dfdx(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), & 
     479                     &                          dd_fill, 'I' ) 
    777480               ENDIF 
    778481 
     
    780483               dl_dfdy(:,:,:)=dd_fill 
    781484               IF( il_shape(2) > 1 )THEN 
    782                   dl_dfdy(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'J' ) 
     485                  dl_dfdy(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), & 
     486                     &                          dd_fill, 'J' ) 
    783487               ENDIF 
    784488  
     
    786490               dl_dfdz(:,:,:)=dd_fill 
    787491               IF( il_shape(3) > 1 )THEN 
    788                   dl_dfdz(:,:,:)=extrap_deriv_3D( dd_value(:,:,:,jl), dd_fill, 'K' ) 
     492                  dl_dfdz(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), & 
     493                     &                          dd_fill, 'K' ) 
    789494               ENDIF 
    790495  
     
    804509 
    805510               DO jk=1,il_shape(3) 
     511                  ! from North West(1,1) to South East(il_shape(1),il_shape(2)) 
    806512                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
    807513                  DO jj=1,il_shape(2) 
     
    813519                           il_imin=MAX(ji-il_radius,1) 
    814520                           il_imax=MIN(ji+il_radius,il_shape(1)) 
     521                           ! coef indices to be used 
     522                           il_i1 = il_radius-(ji-il_imin)+1 
     523                           il_i2 = il_radius+(il_imax-ji)+1 
    815524                           IF( il_dim(1) == 1 )THEN 
    816525                              il_imin=ji 
    817526                              il_imax=ji 
    818                            ENDIF 
     527                              ! coef indices to be used 
     528                              il_i1 = 1 
     529                              il_i2 = 2 
     530                           ENDIF 
     531 
    819532 
    820533                           il_jmin=MAX(jj-il_radius,1) 
    821534                           il_jmax=MIN(jj+il_radius,il_shape(2)) 
     535                           ! coef indices to be used 
     536                           il_j1 = il_radius-(jj-il_jmin)+1 
     537                           il_j2 = il_radius+(il_jmax-jj)+1 
    822538                           IF( il_dim(2) == 1 )THEN 
    823539                              il_jmin=jj 
    824540                              il_jmax=jj 
     541                              ! coef indices to be used 
     542                              il_j1 = 1 
     543                              il_j2 = 2 
    825544                           ENDIF 
    826545 
    827546                           il_kmin=MAX(jk-il_radius,1) 
    828547                           il_kmax=MIN(jk+il_radius,il_shape(3)) 
     548                           ! coef indices to be used 
     549                           il_k1 = il_radius-(jk-il_kmin)+1 
     550                           il_k2 = il_radius+(il_kmax-jk)+1 
    829551                           IF( il_dim(3) == 1 )THEN 
    830552                              il_kmin=jk 
    831553                              il_kmax=jk 
     554                              ! coef indices to be used 
     555                              il_k1 = 1 
     556                              il_k2 = 2 
    832557                           ENDIF 
    833558 
     
    845570                           &            il_jmin:il_jmax, & 
    846571                           &            il_kmin:il_kmax ), & 
    847                            &  dl_coef(:,:,:) ) 
     572                           &  dl_coef(il_i1:il_i2, & 
     573                           &          il_j1:il_j2, & 
     574                           &          il_k1:il_k2) ) 
    848575 
    849576                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
    850577                              il_detect(ji,jj,jk)= 0 
     578                              ll_iter=.FALSE. 
     579                           ENDIF 
     580 
     581                        ENDIF 
     582 
     583                     ENDDO 
     584                  ENDDO 
     585                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1) 
     586                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
     587                  DO jj=il_shape(2),1,-1 
     588                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE 
     589                     DO ji=il_shape(1),1,-1 
     590 
     591                        IF( il_detect(ji,jj,jk) == 1 )THEN 
     592                           
     593                           il_imin=MAX(ji-il_radius,1) 
     594                           il_imax=MIN(ji+il_radius,il_shape(1)) 
     595                           ! coef indices to be used 
     596                           il_i1 = il_radius-(ji-il_imin)+1 
     597                           il_i2 = il_radius+(il_imax-ji)+1 
     598                           IF( il_dim(1) == 1 )THEN 
     599                              il_imin=ji 
     600                              il_imax=ji 
     601                              ! coef indices to be used 
     602                              il_i1 = 1 
     603                              il_i2 = 2 
     604                           ENDIF 
     605 
     606 
     607                           il_jmin=MAX(jj-il_radius,1) 
     608                           il_jmax=MIN(jj+il_radius,il_shape(2)) 
     609                           ! coef indices to be used 
     610                           il_j1 = il_radius-(jj-il_jmin)+1 
     611                           il_j2 = il_radius+(il_jmax-jj)+1 
     612                           IF( il_dim(2) == 1 )THEN 
     613                              il_jmin=jj 
     614                              il_jmax=jj 
     615                              ! coef indices to be used 
     616                              il_j1 = 1 
     617                              il_j2 = 2 
     618                           ENDIF 
     619 
     620                           il_kmin=MAX(jk-il_radius,1) 
     621                           il_kmax=MIN(jk+il_radius,il_shape(3)) 
     622                           ! coef indices to be used 
     623                           il_k1 = il_radius-(jk-il_kmin)+1 
     624                           il_k2 = il_radius+(il_kmax-jk)+1 
     625                           IF( il_dim(3) == 1 )THEN 
     626                              il_kmin=jk 
     627                              il_kmax=jk 
     628                              ! coef indices to be used 
     629                              il_k1 = 1 
     630                              il_k2 = 2 
     631                           ENDIF 
     632 
     633                           dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( & 
     634                           &  dd_value( il_imin:il_imax, & 
     635                           &            il_jmin:il_jmax, & 
     636                           &            il_kmin:il_kmax,jl ), dd_fill, il_radius, & 
     637                           &  dl_dfdx(  il_imin:il_imax, & 
     638                           &            il_jmin:il_jmax, & 
     639                           &            il_kmin:il_kmax ), & 
     640                           &  dl_dfdy(  il_imin:il_imax, & 
     641                           &            il_jmin:il_jmax, & 
     642                           &            il_kmin:il_kmax ), & 
     643                           &  dl_dfdz(  il_imin:il_imax, & 
     644                           &            il_jmin:il_jmax, & 
     645                           &            il_kmin:il_kmax ), & 
     646                           &  dl_coef(il_i1:il_i2, & 
     647                           &          il_j1:il_j2, & 
     648                           &          il_k1:il_k2) ) 
     649 
     650                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
     651                              il_detect(ji,jj,jk)= 0 
     652                              ll_iter=.FALSE. 
    851653                           ENDIF 
    852654 
     
    862664               DEALLOCATE( dl_coef ) 
    863665 
    864                il_iter=il_iter+1 
     666               IF( ll_iter ) il_iter=il_iter+1 
    865667            ENDDO 
    866668         ENDDO 
     
    875677            DO WHILE( ANY(il_detect(:,:,:)==1) ) 
    876678               ! change extend value to minimize number of iteration 
    877                il_radius=id_radius+(il_iter/id_maxiter) 
     679               il_radius=id_radius+(il_iter-1) 
     680               ll_iter=.TRUE. 
    878681 
    879682               il_dim(1)=2*il_radius+1 
     
    886689               ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) ) 
    887690 
    888                dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1), & 
    889                &                                                   1:il_dim(2), & 
    890                &                                                   1:il_dim(3), & 
     691               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1),& 
     692               &                                                   1:il_dim(2),& 
     693               &                                                   1:il_dim(3),& 
    891694               &                                                   jl ) ) 
    892  
     695                
    893696               DO jk=1,il_shape(3) 
     697                  ! from North West(1,1) to South East(il_shape(1),il_shape(2)) 
    894698                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
    895699                  DO jj=1,il_shape(2) 
     
    901705                           il_imin=MAX(ji-il_radius,1) 
    902706                           il_imax=MIN(ji+il_radius,il_shape(1)) 
     707                           ! coef indices to be used 
     708                           il_i1 = il_radius-(ji-il_imin)+1 
     709                           il_i2 = il_radius+(il_imax-ji)+1 
    903710                           IF( il_dim(1) == 1 )THEN 
    904711                              il_imin=ji 
    905712                              il_imax=ji 
     713                              ! coef indices to be used 
     714                              il_i1 = 1 
     715                              il_i2 = 2 
    906716                           ENDIF 
    907717 
    908718                           il_jmin=MAX(jj-il_radius,1) 
    909719                           il_jmax=MIN(jj+il_radius,il_shape(2)) 
     720                           ! coef indices to be used 
     721                           il_j1 = il_radius-(jj-il_jmin)+1 
     722                           il_j2 = il_radius+(il_jmax-jj)+1 
    910723                           IF( il_dim(2) == 1 )THEN 
    911724                              il_jmin=jj 
    912725                              il_jmax=jj 
     726                              ! coef indices to be used 
     727                              il_j1 = 1 
     728                              il_j2 = 2 
    913729                           ENDIF 
    914730 
    915731                           il_kmin=MAX(jk-il_radius,1) 
    916732                           il_kmax=MIN(jk+il_radius,il_shape(3)) 
     733                           ! coef indices to be used 
     734                           il_k1 = il_radius-(jk-il_kmin)+1 
     735                           il_k2 = il_radius+(il_kmax-jk)+1 
    917736                           IF( il_dim(3) == 1 )THEN 
    918737                              il_kmin=jk 
    919738                              il_kmax=jk 
     739                              ! coef indices to be used 
     740                              il_k1 = 1 
     741                              il_k2 = 2 
    920742                           ENDIF 
    921743 
     
    925747                           &            il_kmin:il_kmax, & 
    926748                           &            jl), dd_fill, il_radius, & 
    927                            &  dl_coef(:,:,:) ) 
     749                           &  dl_coef(il_i1:il_i2, & 
     750                           &          il_j1:il_j2, & 
     751                           &          il_k1:il_k2) ) 
    928752 
    929753                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
    930754                              il_detect(ji,jj,jk)= 0 
     755                              ll_iter=.FALSE. 
     756                           ENDIF 
     757 
     758                        ENDIF 
     759 
     760                     ENDDO 
     761                  ENDDO 
     762                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1) 
     763                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE 
     764                  DO jj=il_shape(2),1,-1 
     765                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE 
     766                     DO ji=il_shape(1),1,-1 
     767 
     768                        IF( il_detect(ji,jj,jk) == 1 )THEN 
     769                            
     770                           il_imin=MAX(ji-il_radius,1) 
     771                           il_imax=MIN(ji+il_radius,il_shape(1)) 
     772                           ! coef indices to be used 
     773                           il_i1 = il_radius-(ji-il_imin)+1 
     774                           il_i2 = il_radius+(il_imax-ji)+1 
     775                           IF( il_dim(1) == 1 )THEN 
     776                              il_imin=ji 
     777                              il_imax=ji 
     778                              ! coef indices to be used 
     779                              il_i1 = 1 
     780                              il_i2 = 2 
     781                           ENDIF 
     782 
     783                           il_jmin=MAX(jj-il_radius,1) 
     784                           il_jmax=MIN(jj+il_radius,il_shape(2)) 
     785                           ! coef indices to be used 
     786                           il_j1 = il_radius-(jj-il_jmin)+1 
     787                           il_j2 = il_radius+(il_jmax-jj)+1 
     788                           IF( il_dim(2) == 1 )THEN 
     789                              il_jmin=jj 
     790                              il_jmax=jj 
     791                              ! coef indices to be used 
     792                              il_j1 = 1 
     793                              il_j2 = 2 
     794                           ENDIF 
     795 
     796                           il_kmin=MAX(jk-il_radius,1) 
     797                           il_kmax=MIN(jk+il_radius,il_shape(3)) 
     798                           ! coef indices to be used 
     799                           il_k1 = il_radius-(jk-il_kmin)+1 
     800                           il_k2 = il_radius+(il_kmax-jk)+1 
     801                           IF( il_dim(3) == 1 )THEN 
     802                              il_kmin=jk 
     803                              il_kmax=jk 
     804                              ! coef indices to be used 
     805                              il_k1 = 1 
     806                              il_k2 = 2 
     807                           ENDIF 
     808 
     809                           dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( & 
     810                           &  dd_value( il_imin:il_imax, & 
     811                           &            il_jmin:il_jmax, & 
     812                           &            il_kmin:il_kmax, & 
     813                           &            jl), dd_fill, il_radius, & 
     814                           &  dl_coef(il_i1:il_i2, & 
     815                           &          il_j1:il_j2, & 
     816                           &          il_k1:il_k2) ) 
     817 
     818                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN 
     819                              il_detect(ji,jj,jk)= 0 
     820                              ll_iter=.FALSE. 
    931821                           ENDIF 
    932822 
     
    936826                  ENDDO 
    937827               ENDDO 
    938  
     828               CALL logger_info(" EXTRAP 3D: "//& 
     829               &              TRIM(fct_str(SUM(il_detect(:,:,:))))//& 
     830               &              " point(s) to extrapolate " ) 
     831             
    939832               DEALLOCATE( dl_coef ) 
    940                il_iter=il_iter+1 
     833               IF( ll_iter ) il_iter=il_iter+1 
    941834            ENDDO 
    942835         ENDDO             
     
    946839 
    947840   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 
    1490841   !------------------------------------------------------------------- 
    1491842   !> @brief 
     
    1493844   !>  
    1494845   !> @details  
    1495    !> coefficients are  "grid distance" to the center of the box choosed to compute 
    1496    !> extrapolation. 
     846   !> coefficients are  "grid distance" to the center of the box  
     847   !> choosed to compute extrapolation. 
    1497848   !> 
    1498849   !> @author J.Paul 
    1499    !> - November, 2013- Initial Version 
     850   !> @date November, 2013 - Initial Version 
     851   !> @date July, 2015  
     852   !> - decrease weight of third dimension 
    1500853   ! 
    1501854   !> @param[in] dd_value  3D array of variable to be extrapolated 
     
    1544897 
    1545898               ! compute distance 
     899               ! "vertical weight" is lower than horizontal  
    1546900               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + & 
    1547901               &                   (jj-il_jmid)**2 + & 
    1548                &                   (jk-il_kmid)**2 
     902               &                 3*(jk-il_kmid)**2 
    1549903 
    1550904               IF( dl_dist(ji,jj,jk) /= 0 )THEN 
     
    16581012   !> 
    16591013   !> @author J.Paul 
    1660    !> - November, 2013- Initial Version 
     1014   !> @date November, 2013 - Initial Version 
     1015   !> @date July, 2015  
     1016   !> - decrease weight of third dimension 
    16611017   ! 
    16621018   !> @param[in] dd_value  3D array of variable to be extrapolated 
     
    17051061 
    17061062               ! compute distance 
     1063               ! "vertical weight" is lower than horizontal  
    17071064               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + & 
    17081065               &                   (jj-il_jmid)**2 + & 
    1709                &                   (jk-il_kmid)**2 
     1066               &                 3*(jk-il_kmid)**2 
    17101067 
    17111068               IF( dl_dist(ji,jj,jk) /= 0 )THEN 
     
    17321089   !> 
    17331090   !> @author J.Paul 
    1734    !> - November, 2013- Initial Version 
     1091   !> - November, 2013 - Initial Version 
    17351092   ! 
    17361093   !> @param[in] dd_value  3D array of variable to be extrapolated 
     
    17631120      INTEGER(i4) :: jj 
    17641121      INTEGER(i4) :: jk 
    1765  
    17661122      !---------------------------------------------------------------- 
    17671123 
     
    17931149            ENDDO 
    17941150         ENDDO 
     1151 
    17951152 
    17961153         ! return value 
     
    19171274   !> 
    19181275   !> @author J.Paul 
    1919    !> - November, 2013-Initial version 
     1276   !> - November, 2013 - Initial version 
    19201277   !> 
    19211278   !> @param[inout] td_var variable  
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/file.f90

    r5037 r5608  
    137137!> J.Paul 
    138138! REVISION HISTORY: 
    139 !> @date November, 2013- Initial Version 
    140 !> @date November, 2014 - Fix memory leaks bug 
     139!> @date November, 2013 - Initial Version 
     140!> @date November, 2014  
     141!> - Fix memory leaks bug 
    141142!> 
    142143!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    288289   !>    
    289290   !> @author J.Paul 
    290    !> - November, 2013- Initial Version 
     291   !> @date November, 2013 - Initial Version 
    291292   !> @date November, 2014 
    292    !>    - use function instead of overload assignment operator  
     293   !> - use function instead of overload assignment operator  
    293294   !> (to avoid memory leak) 
    294295   ! 
     
    409410   !>    
    410411   !> @author J.Paul 
    411    !> - November, 2013- Initial Version 
     412   !> @date November, 2013 - Initial Version 
    412413   !> @date November, 2014 
    413    !>    - use function instead of overload assignment operator  
     414   !> - use function instead of overload assignment operator  
    414415   !> (to avoid memory leak) 
    415416   ! 
     
    604605      CHARACTER(LEN=lc) :: cl_dim 
    605606      LOGICAL           :: ll_error 
    606  
    607       INTEGER(i4) :: il_ind 
     607      LOGICAL           :: ll_warn  
     608 
     609      INTEGER(i4)       :: il_ind 
    608610 
    609611      ! loop indices 
     
    614616      ! check used dimension  
    615617      ll_error=.FALSE. 
     618      ll_warn=.FALSE. 
    616619      DO ji=1,ip_maxdim 
    617620         il_ind=dim_get_index( td_file%t_dim(:), & 
     
    619622         &                     TRIM(td_var%t_dim(ji)%c_sname)) 
    620623         IF( il_ind /= 0 )THEN 
    621          IF( td_var%t_dim(ji)%l_use  .AND. & 
    622          &   td_file%t_dim(il_ind)%l_use .AND. & 
    623          &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN 
    624             ll_error=.TRUE. 
    625          ENDIF 
     624            IF( td_var%t_dim(ji)%l_use  .AND. & 
     625            &   td_file%t_dim(il_ind)%l_use .AND. & 
     626            &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN 
     627               IF( INDEX( TRIM(td_var%c_axis), & 
     628               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN 
     629                  ll_warn=.TRUE. 
     630               ELSE 
     631                  ll_error=.TRUE. 
     632               ENDIF 
     633            ENDIF 
    626634         ENDIF 
    627635      ENDDO 
    628636 
    629637      IF( ll_error )THEN 
    630  
    631          file_check_var_dim=.FALSE. 
    632  
    633          CALL logger_error( & 
    634          &  " FILE CHECK VAR DIM: variable and file dimension differ"//& 
    635          &  " for variable "//TRIM(td_var%c_name)//& 
    636          &  " and file "//TRIM(td_file%c_name)) 
    637  
    638638 
    639639         cl_dim='(/' 
     
    659659         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 
    660660 
     661         file_check_var_dim=.FALSE. 
     662 
     663         CALL logger_error( & 
     664         &  " FILE CHECK VAR DIM: variable and file dimension differ"//& 
     665         &  " for variable "//TRIM(td_var%c_name)//& 
     666         &  " and file "//TRIM(td_file%c_name)) 
     667 
     668      ELSEIF( ll_warn )THEN 
     669         CALL logger_warn( & 
     670         &  " FILE CHECK VAR DIM: variable and file dimension differ"//& 
     671         &  " for variable "//TRIM(td_var%c_name)//& 
     672         &  " and file "//TRIM(td_file%c_name)//". you should use"//& 
     673         &  " var_check_dim to remove useless dimension.") 
    661674      ELSE 
    662675 
     
    679692   ! 
    680693   !> @author J.Paul 
    681    !> - November, 2013- Initial Version 
     694   !> @date November, 2013 - Initial Version 
    682695   !> @date September, 2014 
    683696   !> - add dimension to file if need be 
     
    707720      IF( TRIM(td_file%c_name) == '' )THEN 
    708721 
    709          CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    710722         CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//& 
    711723         & "running file_add_var" ) 
     724         CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
    712725 
    713726      ELSE 
     
    723736               &                                       td_var%c_stdname ) 
    724737            ENDIF 
    725  
     738            CALL logger_debug( & 
     739            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) ) 
    726740            IF( il_ind /= 0 )THEN 
    727741 
     
    739753            ELSE 
    740754 
    741                CALL logger_trace( & 
     755               CALL logger_debug( & 
    742756               &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//& 
    743757               &  ", standard name "//TRIM(td_var%c_stdname)//& 
     
    770784                        !il_rec=td_file%t_dim(3)%i_len 
    771785                  END SELECT 
    772                   CALL logger_info( & 
    773                      &  " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind))) 
    774786 
    775787                  IF( td_file%i_nvar > 0 )THEN 
     
    806818                        ENDIF 
    807819 
    808                         IF( il_ind < td_file%i_nvar )THEN 
     820                        IF( il_ind < td_file%i_nvar+1 )THEN 
    809821                           ! variable with more dimension than new variable 
    810822                           td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = & 
     
    893905   ! 
    894906   !> @author J.Paul 
    895    !> - November, 2013- Initial Version 
     907   !> @date November, 2013 - Initial Version 
     908   !> @date February, 2015  
     909   !> - define local variable structure to avoid mistake with pointer 
    896910   ! 
    897911   !> @param[inout] td_file   file structure 
     
    907921      ! local variable 
    908922      INTEGER(i4)       :: il_ind 
     923      TYPE(TVAR)        :: tl_var 
    909924      !---------------------------------------------------------------- 
    910925 
     
    928943            IF( il_ind /= 0 )THEN 
    929944    
    930                CALL file_del_var(td_file, td_file%t_var(il_ind)) 
     945               tl_var=var_copy(td_file%t_var(il_ind)) 
     946               CALL file_del_var(td_file, tl_var) 
    931947 
    932948            ELSE 
    933949 
    934                CALL logger_warn( & 
     950               CALL logger_debug( & 
    935951               &  " FILE DEL VAR NAME: there is no variable with name or "//& 
    936952               &  "standard name "//TRIM(cd_name)//" in file "//& 
     
    12471263   ! 
    12481264   !> @author J.Paul 
    1249    !> - November, 2013- Initial Version 
     1265   !> @date November, 2013 - Initial Version 
     1266   !> @date February, 2015  
     1267   !> - define local attribute structure to avoid mistake 
     1268   !> with pointer 
    12501269   ! 
    12511270   !> @param[inout] td_file   file structure 
     
    12611280      ! local variable 
    12621281      INTEGER(i4)       :: il_ind 
     1282      TYPE(TATT)        :: tl_att 
    12631283      !---------------------------------------------------------------- 
    12641284 
     
    12821302            IF( il_ind /= 0 )THEN 
    12831303    
    1284                CALL file_del_att(td_file, td_file%t_att(il_ind)) 
     1304               tl_att=att_copy(td_file%t_att(il_ind)) 
     1305               CALL file_del_att(td_file, tl_att) 
    12851306 
    12861307            ELSE 
    12871308 
    1288                CALL logger_warn( & 
     1309               CALL logger_debug( & 
    12891310               &  " FILE DEL ATT NAME: there is no attribute with name "//& 
    12901311               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name)) 
     
    14441465   ! 
    14451466   !> @author J.Paul 
    1446    !> - November, 2013- Initial Version 
     1467   !> @date November, 2013 - Initial Version 
    14471468   !> @date September, 2014 
    14481469   !> - do not reorder dimension, before put in file 
     
    17171738         WRITE(*,'(/a)') " File variable" 
    17181739         DO ji=1,td_file%i_nvar 
    1719             CALL var_print(td_file%t_var(ji))!,.FALSE.) 
     1740            CALL var_print(td_file%t_var(ji),.FALSE.) 
    17201741         ENDDO 
    17211742      ENDIF 
     
    17691790   ! 
    17701791   !> @author J.Paul 
    1771    !> - November, 2013- Initial Version 
     1792   !> @date November, 2013 - Initial Version 
     1793   !> @date February, 2015  
     1794   !> - add case to not return date (yyyymmdd) at the end of filename 
     1795   !> @date February, 2015  
     1796   !> - add case to not return release number 
     1797   !> we assume release number only on one digit (ex : file_v3.5.nc) 
    17721798   ! 
    17731799   !> @param[in] cd_file   file name (without suffix) 
     
    18021828 
    18031829         IF( .NOT. fct_is_num(file__get_number(2:)) )THEN 
     1830            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  
    18041836            file__get_number='' 
    18051837         ENDIF 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/filter.f90

    r5037 r5608  
    1818!>          - rad > cutoff : @f$ filter=0 @f$                
    1919!>       - 'blackman' 
    20 !>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 0.08*COS(2\pi*\frac{rad}{cutoff}) @f$ 
     20!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) +  
     21!>                                      0.08*COS(2\pi*\frac{rad}{cutoff}) @f$ 
    2122!>          - rad > cutoff : @f$ filter=0 @f$ 
    2223!>       - 'gauss' 
     
    2930!> 
    3031!>    td_var\%c_filter(2) string character is the number of turn to be done<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/> 
     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/> 
    3438!>     
    3539!>    @note Filter method could be specify for each variable in namelist _namvar_, 
     
    4044!>    The number of turn is specify using '*' separator.<br/> 
    4145!>    Example: 
    42 !>       - cn_varinfo='varname1:2*hamming(@f$cutoff@f$,@f$radius@f$)', 'varname2:gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)' 
     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$)' 
    4348!> 
    4449!>    to filter variable value:<br/> 
     
    106111   !> 
    107112   !> @author J.Paul 
    108    !> - November, 2013- Initial Version 
     113   !> @date November, 2013 - Initial Version 
    109114   ! 
    110115   !> @param[inout] td_var variable structure  
     
    250255   !> 
    251256   !> @author J.Paul 
    252    !> - November, 2013- Initial Version 
     257   !> @date November, 2013 - Initial Version 
    253258   ! 
    254259   !> @param[inout] td_var variable  
     
    296301 
    297302      !3-extrapolate 
    298       CALL extrap_fill_value( td_var, id_iext=id_radius, id_jext=id_radius ) 
     303      CALL extrap_fill_value( td_var ) !, id_iext=id_radius, id_jext=id_radius ) 
    299304 
    300305      !4-filtering 
     
    341346   ! 
    342347   !> @author J.Paul 
    343    !> - November, 2013- Initial Version 
     348   !> @date November, 2013 - Initial Version 
    344349   ! 
    345350   !> @param[inout] dd_value  array of value to be filtered  
     
    393398   !> 
    394399   !> @author J.Paul 
    395    !> - November, 2013- Initial Version 
     400   !> @date November, 2013 - Initial Version 
    396401   ! 
    397402   !> @param[inout] dd_value  array of value to be filtered  
     
    439444   !> 
    440445   !> @author J.Paul 
    441    !> - November, 2013- Initial Version 
     446   !> @date November, 2013 - Initial Version 
    442447   ! 
    443448   !> @param[inout] dd_value  array of value to be filtered  
     
    482487   !> 
    483488   !> @author J.Paul 
    484    !> - November, 2013- Initial Version 
     489   !> @date November, 2013 - Initial Version 
    485490   ! 
    486491   !> @param[inout] dd_value  array of value to be filtered  
     
    537542   !> 
    538543   !> @author J.Paul 
    539    !> - Nov, 2013- Initial Version 
     544   !> @date November, 2013 - Initial Version 
    540545   ! 
    541546   !> @param[inout] dd_value  array of value to be filtered  
     
    590595   ! 
    591596   !> @author J.Paul 
    592    !> - November, 2013- Initial Version 
     597   !> @date November, 2013 - Initial Version 
    593598   ! 
    594599   !> @param[in] cd_name   filter name 
     
    649654   ! 
    650655   !> @author J.Paul 
    651    !> - November, 2013- Initial Version 
     656   !> @date November, 2013 - Initial Version 
    652657   ! 
    653658   !> @param[in] cd_name   filter name 
     
    695700   ! 
    696701   !> @author J.Paul 
    697    !> - November, 2013- Initial Version 
     702   !> @date November, 2013 - Initial Version 
    698703   ! 
    699704   !> @param[in] dd_cutoff cut-off frequency 
     
    749754   ! 
    750755   !> @author J.Paul 
    751    !> - November, 2013- Initial Version 
     756   !> @date November, 2013 - Initial Version 
    752757   ! 
    753758   !> @param[in] dd_cutoff cut-off frequency 
     
    808813   ! 
    809814   !> @author J.Paul 
    810    !> - November, 2013- Initial Version 
     815   !> @date November, 2013 - Initial Version 
    811816   ! 
    812817   !> @param[in] dd_cutoff cut-off frequency 
     
    863868   ! 
    864869   !> @author J.Paul 
    865    !> - November, 2013- Initial Version 
     870   !> @date November, 2013 - Initial Version 
    866871   ! 
    867872   !> @param[in] dd_cutoff cut-off frequency 
     
    922927   ! 
    923928   !> @author J.Paul 
    924    !> - November, 2013- Initial Version 
     929   !> @date November, 2013 - Initial Version 
    925930   ! 
    926931   !> @param[in] dd_cutoff cut-off frequency 
     
    978983   !> 
    979984   !> @author J.Paul 
    980    !> - November, 2013- Initial Version 
     985   !> @date November, 2013 - Initial Version 
    981986   !> 
    982987   !> @param[in] dd_cutoff cut-off frequency 
     
    10381043   !> 
    10391044   !> @author J.Paul 
    1040    !> - November, 2013- Initial Version 
     1045   !> @date November, 2013 - Initial Version 
    10411046   !> 
    10421047   !> @param[in] dd_cutoff cut-off frequency 
     
    10901095   !> 
    10911096   !> @author J.Paul 
    1092    !> - November, 2013- Initial Version 
     1097   !> @date November, 2013 - Initial Version 
    10931098   !> 
    10941099   !> @param[in] dd_cutoff cut-off frequency 
     
    11461151   !> 
    11471152   !> @author J.Paul 
    1148    !> - November, 2013- Initial Version 
     1153   !> @date November, 2013 - Initial Version 
    11491154   !> 
    11501155   !> @param[in] dd_cutoff cut-off frequency 
     
    11981203   !> 
    11991204   !> @author J.Paul 
    1200    !> - November, 2013- Initial Version 
     1205   !> @date November, 2013 - Initial Version 
    12011206   !> 
    12021207   !> @param[in] dd_cutoff cut-off frequency 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/function.f90

    r5037 r5608  
    5151!> @endcode 
    5252!> 
     53!>  to check if character is real 
     54!> @code 
     55!>  ll_is_real=fct_is_real(cd_var) 
     56!> @endcode 
     57!> 
    5358!>  to split string into substring and return one of the element:<br/>   
    5459!> @code 
     
    8994! REVISION HISTORY: 
    9095!> @date November, 2013 - Initial Version 
    91 !> @date September, 2014 - add header 
     96!> @date September, 2014  
     97!> - add header 
    9298! 
    9399!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    106112   PUBLIC :: fct_lower    !< convert character from upper to lower case 
    107113   PUBLIC :: fct_is_num   !< check if character is numeric 
     114   PUBLIC :: fct_is_real  !< check if character is real 
    108115   PUBLIC :: fct_split    !< split string into substring 
    109116   PUBLIC :: fct_basename !< return basename (name without path) 
     
    153160   !  
    154161   !> @author J.Paul  
    155    !> - September, 2014- Initial Version  
     162   !> @date September, 2014 - Initial Version  
    156163   !  
    157164   !> @param[in] cd_char   string character 
     
    177184   !  
    178185   !> @author J.Paul  
    179    !> - September, 2014- Initial Version  
     186   !> @date September, 2014 - Initial Version  
    180187   !  
    181188   !> @param[in] cd_char   string character 
     
    201208   !  
    202209   !> @author J.Paul  
    203    !> - Nov, 2013- Initial Version  
     210   !> @date November, 2013 - Initial Version  
    204211   !  
    205212   !> @param[in] cd_char   string character 
     
    225232   !  
    226233   !> @author J.Paul  
    227    !> - November, 2013- Initial Version  
     234   !> @date November, 2013 - Initial Version  
    228235   !  
    229236   !> @param[in] cd_char   string character 
     
    249256   !  
    250257   !> @author J.Paul  
    251    !> - November, 2013- Initial Version  
     258   !> @date November, 2013 - Initial Version  
    252259   !  
    253260   !> @param[in] cd_char   string character 
     
    273280   !> 
    274281   !> @author J.Paul  
    275    !> - November, 2013- Initial Version  
     282   !> @date November, 2013 - Initial Version  
    276283   !> 
    277284   !> @param[in] cd_char   string character 
     
    297304   !> 
    298305   !> @author J.Paul  
    299    !> - November, 2013- Initial Version  
     306   !> @date November, 2013 - Initial Version  
    300307   !> 
    301308   !> @param[in] cd_char   string character 
     
    321328   !> 
    322329   !> @author J.Paul  
    323    !> - November, 2013- Initial Version  
     330   !> @date November, 2013 - Initial Version  
    324331   !> 
    325332   !> @return file id  
     
    344351   ! 
    345352   !> @author J.Paul 
    346    !> - November, 2013- Initial Version 
     353   !> @date November, 2013 - Initial Version 
    347354   !> 
    348355   !> @param[in] id_status 
     
    365372   ! 
    366373   !> @author J.Paul 
    367    !> - November, 2014- Initial Version 
     374   !> @date November, 2014 - Initial Version 
    368375   !> 
    369376   !> @param[in] cd_msg optional message to be added 
     
    387394   !> 
    388395   !> @author J.Paul 
    389    !> - November, 2013- Initial Version 
     396   !> @date November, 2013 - Initial Version 
    390397   ! 
    391398   !> @param[in] ld_var logical variable 
     
    409416   !> 
    410417   !> @author J.Paul 
    411    !> - November, 2013- Initial Version 
     418   !> @date November, 2013 - Initial Version 
    412419   ! 
    413420   !> @param[in] bd_var integer(1) variable 
     
    431438   !> 
    432439   !> @author J.Paul 
    433    !> - November, 2013- Initial Version 
     440   !> @date November, 2013 - Initial Version 
    434441   ! 
    435442   !> @param[in] sd_var integer(2) variable 
     
    453460   !> 
    454461   !> @author J.Paul 
    455    !> - November, 2013- Initial Version 
     462   !> @date November, 2013 - Initial Version 
    456463   ! 
    457464   !> @param[in] id_var integer(4) variable 
     
    475482   !> 
    476483   !> @author J.Paul 
    477    !> - November, 2013- Initial Version 
     484   !> @date November, 2013 - Initial Version 
    478485   ! 
    479486   !> @param[in] kd_var integer(8) variable 
     
    497504   !> 
    498505   !> @author J.Paul 
    499    !> - November, 2013- Initial Version 
     506   !> @date November, 2013 - Initial Version 
    500507   ! 
    501508   !> @param[in] rd_var real(4) variable 
     
    519526   !> 
    520527   !> @author J.Paul 
    521    !> - November, 2013- Initial Version 
     528   !> @date November, 2013 - Initial Version 
    522529   ! 
    523530   !> @param[in] dd_var real(8) variable 
     
    544551   !> 
    545552   !> @author J.Paul 
    546    !> - November, 2013- Initial Version 
     553   !> @date November, 2013 - Initial Version 
    547554   ! 
    548555   !> @param[in] cd_arr array of character 
     
    590597   ! 
    591598   !> @author J.Paul 
    592    !> - November, 2013- Initial Version 
     599   !> @date November, 2013 - Initial Version 
    593600   ! 
    594601   !> @param[in] cd_var character 
     
    647654   ! 
    648655   !> @author J.Paul 
    649    !> - November, 2013- Initial Version 
     656   !> @date November, 2013 - Initial Version 
    650657   ! 
    651658   !> @param[in] cd_var character 
     
    697704   ! 
    698705   !> @author J.Paul 
    699    !> - November, 2013- Initial Version 
     706   !> @date November, 2013 - Initial Version 
    700707   ! 
    701708   !> @param[in] cd_var character 
     
    723730   END FUNCTION fct_is_num 
    724731   !------------------------------------------------------------------- 
     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   !------------------------------------------------------------------- 
    725795   !> @brief This function split string of character  
    726796   !> using separator character, by default '|', 
     
    728798   ! 
    729799   !> @author J.Paul 
    730    !> - November, 2013- Initial Version 
     800   !> @date November, 2013 - Initial Version 
    731801   ! 
    732802   !> @param[in] cd_string string of character 
     
    808878   ! 
    809879   !> @author J.Paul 
    810    !> - November, 2013- Initial Version 
     880   !> @date November, 2013 - Initial Version 
    811881   ! 
    812882   !> @param[in] cd_string string of character 
     
    873943   !> Optionally you could specify another separator. 
    874944   !> @author J.Paul 
    875    !> - November, 2013- Initial Version 
     945   !> @date November, 2013 - Initial Version 
    876946   ! 
    877947   !> @param[in] cd_string filename 
     
    914984   !> Optionally you could specify another separator. 
    915985   !> @author J.Paul 
    916    !> - November, 2013- Initial Version 
     986   !> @date November, 2013 - Initial Version 
    917987   ! 
    918988   !> @param[in] cd_string filename 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/grid.f90

    r5037 r5608  
    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 (default 1) 
     163!>       - id_rho    is array of refinement factor  
    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 
    215217! 
    216218!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    255257   PUBLIC :: grid_split_domain         !< compute closed sea domain  
    256258   PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value  
     259   PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one  
    257260 
    258261                                     ! get closest coarse grid indices of fine grid domain 
     
    466469   !> - compute East West overlap 
    467470   !> 
    468    !> @note need all processor files to be there 
     471   !> @note need all processor files 
    469472   !> @author J.Paul 
    470473   !> - October, 2014- Initial Version 
     
    496499      il_ew   =-1 
    497500 
     501      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name)) 
    498502      ! copy structure 
    499503      tl_mpp=mpp_copy(td_mpp) 
     
    523527      ENDIF 
    524528 
     529      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio))) 
     530 
    525531      SELECT CASE(il_perio) 
    526532      CASE(3,4) 
     533         il_pivot=1 
     534      CASE(5,6) 
    527535         il_pivot=0 
    528       CASE(5,6) 
    529          il_pivot=1 
    530536      CASE(0,1,2) 
    531537         il_pivot=1 
     
    534540      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 
    535541         ! get pivot 
     542         CALL logger_info("GRID GET INFO: look for pivot ") 
    536543         il_pivot=grid_get_pivot(tl_mpp) 
    537544      ENDIF 
     
    539546      IF( il_perio < 0 .OR. il_perio > 6 )THEN 
    540547         ! get periodicity 
     548         CALL logger_info("GRID GET INFO: look for perio ") 
    541549         il_perio=grid_get_perio(tl_mpp, il_pivot) 
    542550      ENDIF 
     
    544552      IF( il_ew < 0 )THEN 
    545553         ! get periodicity 
     554         CALL logger_info("GRID GET INFO: look for overlap ") 
    546555         il_ew=grid_get_ew_overlap(tl_mpp) 
    547556      ENDIF 
     
    595604   !> 
    596605   !> @author J.Paul 
    597    !> - November, 2013- Subroutine written 
     606   !> @date November, 2013 - Initial version 
    598607   !> @date September, 2014 
    599608   !> - add dummy loop in case variable not over right point. 
     
    783792 
    784793         IF( ll_check )THEN 
    785             CALL logger_info("GRID GET PIVOT: T-pivot") 
     794            CALL logger_info("GRID GET PIVOT: F-pivot") 
    786795            grid__get_pivot_varT=0 
    787796         ENDIF 
     
    876885 
    877886         IF( ll_check )THEN 
    878             CALL logger_info("GRID GET PIVOT: T-pivot") 
     887            CALL logger_info("GRID GET PIVOT: F-pivot") 
    879888            grid__get_pivot_varU=0 
    880889         ENDIF 
     
    969978 
    970979         IF( ll_check )THEN 
    971             CALL logger_info("GRID GET PIVOT: T-pivot") 
     980            CALL logger_info("GRID GET PIVOT: F-pivot") 
    972981            grid__get_pivot_varV=0 
    973982         ENDIF 
     
    10621071 
    10631072         IF( ll_check )THEN 
    1064             CALL logger_info("GRID GET PIVOT: T-pivot") 
     1073            CALL logger_info("GRID GET PIVOT: F-pivot") 
    10651074            grid__get_pivot_varF=0 
    10661075         ENDIF 
     
    12771286   !> 1: cyclic east-west boundary 
    12781287   !> 2: symmetric boundary condition across the equator 
    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 
     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 
    12831292   !> 
    12841293   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
    12851294   !> 
    12861295   !> @author J.Paul 
    1287    !> - November, 2013- Subroutine written 
     1296   !> @date November, 2013 - Initial version 
    12881297   !> @date October, 2014 
    12891298   !> - work on variable structure instead of file structure 
     
    15371546   !> 1: cyclic east-west boundary 
    15381547   !> 2: symmetric boundary condition across the equator 
    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 
     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 
    15431552   !> 
    15441553   !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 
     
    16341643   ! 
    16351644   !> @author J.Paul 
    1636    !> - November, 2013- Initial Version 
     1645   !> @date November, 2013 - Initial Version 
    16371646   !> @date October, 2014 
    16381647   !> - work on mpp file structure instead of file structure 
     
    17971806   ! 
    17981807   !> @author J.Paul 
    1799    !> - November, 2013- Initial Version 
     1808   !> @date November, 2013 - Initial Version 
    18001809   !> @date October, 2014 
    18011810   !> - work on mpp file structure instead of file structure 
     
    18901899   ! 
    18911900   !> @author J.Paul 
    1892    !> - November, 2013- Initial Version 
     1901   !> @date November, 2013 - Initial Version 
    18931902   !> @date October, 2014 
    18941903   !> - work on mpp file structure instead of file structure 
     
    19781987   !> 
    19791988   !> @author J.Paul 
    1980    !> - November, 2013- Initial Version 
     1989   !> @date November, 2013 - Initial Version 
    19811990   !> @date September, 2014 
    19821991   !> - use grid point to read coordinates variable.  
    19831992   !> @date October, 2014 
    19841993   !> - 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... 
    19851997   !> 
    19861998   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
     
    20042016 
    20052017      ! local variable 
    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 
     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 
    20262039 
    20272040      ! loop indices 
     
    20572070         ! read coarse longitue and latitude 
    20582071         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 
    20592079         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     2080 
    20602081         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 
    20612089         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    20622090          
     
    20772105         ! read fine longitue and latitude 
    20782106         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 
    20792114         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))  
     2115 
    20802116         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 
    20812124         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    20822125  
     
    21272170   !> 
    21282171   !> @author J.Paul 
    2129    !> - November, 2013- Initial Version 
     2172   !> @date November, 2013 - Initial Version 
    21302173   !> @date September, 2014 
    21312174   !> - use grid point to read coordinates variable. 
    21322175   !> @date October, 2014 
    21332176   !> - 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... 
    21342180   !> 
    21352181   !> @param[in] td_longitude0   coarse grid longitude 
     
    21542200 
    21552201      ! local variable 
    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 
     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 
    21672215 
    21682216      ! loop indices 
     
    22092257         ! read fine longitue and latitude 
    22102258         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 
    22112266         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     2267 
    22122268         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 
    22132276         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    22142277          
     
    22442307   !> 
    22452308   !> @author J.Paul 
    2246    !> - November, 2013- Initial Version 
     2309   !> @date November, 2013 - Initial Version 
    22472310   !> @date September, 2014 
    22482311   !> - use grid point to read coordinates variable. 
    22492312   !> @date October, 2014 
    22502313   !> - 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... 
    22512317   !>  
    22522318   !> @param[in] td_coord0 coarse grid coordinate mpp structure 
     
    22712337 
    22722338      ! local variable 
    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       
     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 
    22892356 
    22902357      ! loop indices 
     
    23302397         ! read coarse longitue and latitude 
    23312398         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 
    23322406         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     2407          
    23332408         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 
    23342416         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    23352417 
     
    23772459   !> 
    23782460   !> @author J.Paul 
    2379    !> - November, 2013- Initial Version 
     2461   !> @date November, 2013 - Initial Version 
    23802462   !> @date September, 2014 
    23812463   !> - check grid point 
     
    25202602            CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 
    25212603            CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 
    2522              
     2604  
    25232605            ! "global" coarse grid indice 
    25242606            il_imin0=1 
     
    25682650            IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 
    25692651            &   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)) ) 
    25702658               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 
    25712659               &                 "point is FillValue. remove ghost cell "//& 
     
    26322720            ji = il_iul(1) 
    26332721            jj = il_iul(2) 
    2634  
    26352722            IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 
    26362723               IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 
     
    26472734               ENDIF 
    26482735            ENDIF 
    2649  
    26502736            IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 
    26512737               IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 
     
    28662952   !> 
    28672953   !> @author J.Paul 
    2868    !> - November, 2013- Initial Version 
     2954   !> @date November, 2013 - Initial Version 
     2955   !> @date February, 2015 - change dichotomy method to manage ORCA grid 
    28692956   ! 
    28702957   !> @param[in] dd_lon0   coarse grid array of longitude 
     
    28722959   !> @param[in] dd_lon1   fine   grid longitude 
    28732960   !> @param[in] dd_lat1   fine   grid latitude 
     2961   !> @param[in] dd_fill   fill value 
    28742962   !> @return coarse grid indices of closest point of fine grid point 
    2875    !> 
    2876    !------------------------------------------------------------------- 
    2877    FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1  ) 
     2963   !------------------------------------------------------------------- 
     2964   FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1, dd_fill ) 
    28782965      IMPLICIT NONE 
    28792966      ! Argument 
     
    28822969      REAL(dp),                 INTENT(IN) :: dd_lon1 
    28832970      REAL(dp),                 INTENT(IN) :: dd_lat1 
     2971      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill 
    28842972 
    28852973      ! function 
     
    29293017 
    29303018      ll_north=.FALSE. 
    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 
     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 
    29613035 
    29623036         il_shape(1)= il_isup - il_iinf + 1 
    29633037         il_shape(2)= il_jsup - il_jinf + 1 
    29643038 
    2965          il_imid = il_iinf + INT(il_shape(1)/2)  
     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° 
    29663048         il_jmid = il_jinf + INT(il_shape(2)/2) 
    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. 
     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) 
     3053 
     3054         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
     3055         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN 
     3056 
     3057            il_iinf = il_imid ;  il_isup = il_imid 
     3058            il_jinf = il_jmid ;  il_jsup = il_jmid 
     3059 
     3060         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) 
     3064               ! 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 
     3071               ! point west 
     3072               il_isup = il_imid 
     3073               ll_continue=.TRUE. 
     3074 
     3075            ENDIF 
     3076 
     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 
    29733086      ENDIF 
    29743087 
     
    29763089      DO WHILE( ll_continue .AND. .NOT. ll_north ) 
    29773090 
     3091         ll_continue=.FALSE. 
    29783092         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. & 
    29793093         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN 
     
    29823096            il_jinf = il_jmid ;  il_jsup = il_jmid 
    29833097 
    2984             ll_continue=.FALSE. 
    2985  
    29863098         ELSE 
    2987             IF( dl_lon1 > dl_lon0(il_imid,il_jmid) )THEN 
     3099            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN     
    29883100 
    29893101               ! point east 
    29903102               il_iinf = il_imid 
     3103               ll_continue=.TRUE. 
    29913104         
    2992             ELSE IF(dl_lon1 < dl_lon0(il_imid,il_jmid) )THEN 
     3105            ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN     
    29933106 
    29943107               ! point west 
    29953108               il_isup = il_imid 
     3109               ll_continue=.TRUE. 
    29963110 
    29973111            ENDIF 
    29983112 
    2999             IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN 
     3113            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN     
    30003114                
    30013115               ! point north 
    30023116               il_jinf = il_jmid 
    3003  
    3004             ELSE IF(dd_lat1 < dd_lat0(il_imid,il_jmid) )THEN 
     3117               ll_continue=.TRUE. 
     3118 
     3119            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN     
    30053120 
    30063121               ! point south 
    30073122               il_jsup = il_jmid 
     3123               ll_continue=.TRUE. 
    30083124             
    30093125            ENDIF 
     
    30143130            il_imid = il_iinf + INT(il_shape(1)/2)  
    30153131            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. 
    30193132 
    30203133            ! exit when close enough of point 
     
    30553168   !> @param[in] dd_lonA   longitude of point A 
    30563169   !> @param[in] dd_latA   latitude  of point A 
     3170   !> @param[in] dd_fill 
    30573171   !> @return array of distance between point A and grid points. 
    30583172   !------------------------------------------------------------------- 
    3059    FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) 
     3173   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA ) 
    30603174      IMPLICIT NONE 
    30613175      ! Argument       
     
    31103224         DO ji=1,il_shape(1) 
    31113225            IF( dl_lon(ji,jj) == dl_lonA .AND. & 
    3112             &   dl_lat(ji,jj) == dl_laTA )THEN 
     3226            &   dl_lat(ji,jj) == dl_latA )THEN 
    31133227               grid_distance(ji,jj)=0.0 
    31143228            ELSE 
    31153229               dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + & 
    3116                &       COS(dl_latA)*COS(dl_lat(ji,jj))*COS(dl_lon(ji,jj)-dl_lonA) 
     3230               &       COS(dl_latA)*COS(dl_lat(ji,jj)) * & 
     3231               &       COS(dl_lon(ji,jj)-dl_lonA) 
    31173232               ! check to avoid mistake with ACOS 
    31183233               IF( dl_tmp < -1.0 ) dl_tmp = -1.0 
     
    31363251   ! 
    31373252   !> @author J.Paul 
    3138    !> - September, 2014- Initial Version 
     3253   !> @date September, 2014 - Initial Version 
    31393254   !> @date October, 2014 
    31403255   !> - work on mpp file structure instead of file structure 
     
    31703285 
    31713286      ! local variable 
    3172       INTEGER(i4) :: il_imin0 
    3173       INTEGER(i4) :: il_jmin0 
    3174       INTEGER(i4) :: il_imax0 
    3175       INTEGER(i4) :: il_jmax0 
     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 
    31763292       
    3177       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3293      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
    31783294       
    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 
     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 
    31843300 
    31853301      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
     
    31883304      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
    31893305 
    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 
     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 
    31973313       
    31983314      ! loop indices 
     
    32273343         ! read coarse longitue and latitude 
    32283344         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 
    32293352         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3353 
    32303354         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 
    32313362         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    32323363          
     
    32673398         ! read fine longitue and latitude 
    32683399         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 
    32693407         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3408 
    32703409         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 
    32713417         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    32723418  
     
    33183464   ! 
    33193465   !> @author J.Paul 
    3320    !> - September, 2014- Initial Version 
     3466   !> @date September, 2014 - Initial Version 
    33213467   !> @date October, 2014 
    33223468   !> - work on mpp file structure instead of file structure 
     
    33543500 
    33553501      ! local variable 
    3356       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3502      INTEGER(i4)                              :: il_ind 
     3503      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1 
     3504      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
    33573505       
    3358       INTEGER(i4), DIMENSION(2,2)         :: il_xghost1 
    3359  
    3360       CHARACTER(LEN= 1) :: cl_point 
    3361       CHARACTER(LEN=lc) :: cl_name 
     3506      CHARACTER(LEN= 1)                        :: cl_point 
     3507      CHARACTER(LEN=lc)                        :: cl_name 
    33623508 
    33633509      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
    33643510      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 
    33653511 
    3366       TYPE(TVAR) :: tl_lon1 
    3367       TYPE(TVAR) :: tl_lat1 
    3368  
    3369       TYPE(TMPP) :: tl_coord1 
     3512      TYPE(TVAR)                               :: tl_lon1 
     3513      TYPE(TVAR)                               :: tl_lat1 
     3514 
     3515      TYPE(TMPP)                               :: tl_coord1 
    33703516      ! loop indices 
    33713517      !---------------------------------------------------------------- 
     
    33973543         ! read fine longitue and latitude 
    33983544         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 
    33993552         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
     3553 
    34003554         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 
    34013562         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
    34023563  
     
    34463607   ! 
    34473608   !> @author J.Paul 
    3448    !> - September, 2014- Initial Version 
     3609   !> @date September, 2014 - Initial Version 
    34493610   !> @date October, 2014 
    34503611   !> - work on mpp file structure instead of file structure 
     
    34833644 
    34843645      ! local variable 
    3485       INTEGER(i4) :: il_imin0 
    3486       INTEGER(i4) :: il_jmin0 
    3487       INTEGER(i4) :: il_imax0 
    3488       INTEGER(i4) :: il_jmax0 
     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 
    34893651       
    3490       INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 
     3652      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho 
    34913653       
    3492       INTEGER(i4), DIMENSION(2,2)         :: il_xghost0 
    3493  
    3494       CHARACTER(LEN= 1) :: cl_point 
    3495       CHARACTER(LEN=lc) :: cl_name 
     3654      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0 
     3655 
     3656      CHARACTER(LEN= 1)                        :: cl_point 
     3657      CHARACTER(LEN=lc)                        :: cl_name 
    34963658 
    34973659      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    34983660      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 
    34993661 
    3500       TYPE(TVAR) :: tl_lon0 
    3501       TYPE(TVAR) :: tl_lat0 
    3502  
    3503       TYPE(TMPP) :: tl_coord0 
     3662      TYPE(TVAR)                               :: tl_lon0 
     3663      TYPE(TVAR)                               :: tl_lat0 
     3664 
     3665      TYPE(TMPP)                               :: tl_coord0 
    35043666      ! loop indices 
    35053667      !---------------------------------------------------------------- 
     
    35303692         ! read coarse longitue and latitude 
    35313693         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 
    35323701         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
     3702 
    35333703         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 
    35343711         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 
    35353712          
     
    35853762   ! 
    35863763   !> @author J.Paul 
    3587    !> - November, 2013 - Initial Version 
    3588    !> @date September, 2014 - rename from grid_get_fine_offset 
    3589    ! 
     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   !> 
    35903770   !> @param[in] dd_lon0   coarse grid longitude array  
    35913771   !> @param[in] dd_lat0   coarse grid latitude  array 
     
    36203800 
    36213801      ! local variable 
    3622       INTEGER(i4), DIMENSION(2) :: il_shape0 
    3623       INTEGER(i4), DIMENSION(2) :: il_shape1 
     3802      INTEGER(i4), DIMENSION(2)                :: il_shape0 
     3803      INTEGER(i4), DIMENSION(2)                :: il_shape1 
     3804 
    36243805      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 
    36253806      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 
     3807 
     3808      LOGICAL                                  :: ll_ii 
     3809      LOGICAL                                  :: ll_ij 
    36263810       
    36273811      ! loop indices 
     
    36573841      grid__get_fine_offset_cc(:,:)=-1 
    36583842 
    3659       IF( il_shape1(1) > 1 )THEN 
    3660  
    3661          ! look for i-direction left offset  
     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 
    36623849         IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 
    36633850            DO ji=1,id_rho(jp_I)+2 
    36643851               IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 
    3665                   grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji 
     3852                  grid__get_fine_offset_cc(jp_I,1)=(id_rho(jp_I)+1)-ji 
    36663853                  EXIT 
    36673854               ENDIF 
     
    36713858            &                 " not match fine grid lower left corner.") 
    36723859         ENDIF 
    3673  
    36743860         ! look for i-direction right offset 
    3675          IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
     3861         IF( dl_lon1(il_shape1(jp_I),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 
    36763862            DO ji=1,id_rho(jp_I)+2 
    3677                ii=il_shape1(1)-ji+1 
     3863               ii=il_shape1(jp_I)-ji+1 
    36783864               IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 
    3679                   grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji 
     3865                  grid__get_fine_offset_cc(jp_I,2)=(id_rho(jp_I)+1)-ji 
    36803866                  EXIT 
    36813867               ENDIF 
     
    36863872         ENDIF 
    36873873 
    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 
     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 
    36933879 
    36943880         ! look for j-direction lower offset  
     
    36963882            DO jj=1,id_rho(jp_J)+2 
    36973883               IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 
    3698                   grid__get_fine_offset_cc(2,1)=(id_rho(jp_J)+1)-jj 
     3884                  grid__get_fine_offset_cc(jp_J,1)=(id_rho(jp_J)+1)-jj 
    36993885                  EXIT 
    37003886               ENDIF 
     
    37063892 
    37073893         ! look for j-direction upper offset  
    3708          IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
     3894         IF( dd_lat1(1,il_shape1(jp_J)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 
    37093895            DO jj=1,id_rho(jp_J)+2 
    3710                ij=il_shape1(2)-jj+1 
     3896               ij=il_shape1(jp_J)-jj+1 
    37113897               IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 
    3712                   grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj 
     3898                  grid__get_fine_offset_cc(jp_J,2)=(id_rho(jp_J)+1)-jj 
    37133899                  EXIT 
    37143900               ENDIF 
     
    37173903            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 
    37183904            &                 " not match fine grid upper right corner.") 
    3719          ENDIF 
    3720       ELSE 
    3721          grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2) 
     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.") 
     3943         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 
    37223982      ENDIF 
    37233983 
     
    37323992   ! 
    37333993   !> @author J.Paul 
    3734    !> - November, 2013- Initial Version 
     3994   !> @date November, 2013- Initial Version 
    37353995   !> @date October, 2014 
    37363996   !> - work on mpp file structure instead of file structure 
     
    37424002   !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain  
    37434003   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain   
    3744    !> @param[in] id_rho    array of refinement factor (default 1)  
     4004   !> @param[in] id_rho    array of refinement factor  
    37454005   !------------------------------------------------------------------- 
    37464006   SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, & 
     
    41034363      dl_lon1 = dd_lon1(il_imin1, il_jmin1) 
    41044364      dl_lat1 = dd_lat1(il_imin1, il_jmin1) 
    4105  
    41064365 
    41074366      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. &  
     
    43744633      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
    43754634 
    4376          CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//& 
    4377          &              TRIM(td_var%c_name) ) 
     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 
    43784639 
    43794640         ! copy variable 
     
    45554816   !>  
    45564817   !> @author J.Paul 
    4557    !> - September, 2014 - Initial Version 
     4818   !> @date September, 2014 - Initial Version 
    45584819   !> @date October, 2014 
    45594820   !> - work on mpp file structure instead of file structure 
     
    45924853          tl_mpp=mpp_copy(td_mpp) 
    45934854 
     4855          CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio))) 
    45944856          IF( tl_mpp%i_perio < 0 )THEN 
    45954857             ! compute NEMO periodicity index 
     
    46944956                        il_tmp(jim:jip,jjm:jjp)=1 
    46954957                     END WHERE 
     4958 
    46964959                  ENDIF 
    46974960               ENDDO 
     
    47204983   !> 
    47214984   !> @details 
    4722    !> the minimum size (nbumber of point) of closed sea to be kept could be 
     4985   !> the minimum size (number of point) of closed sea to be kept could be 
    47234986   !> sepcify with id_minsize. 
    47244987   !> By default only the biggest sea is preserve. 
     
    47825045 
    47835046   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   !> - 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 
    47845144END MODULE grid 
    47855145 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/interp.f90

    r5037 r5608  
    2727!>    defining string character _cn\_varinfo_.<br/> 
    2828!>    Example: 
    29 !>       - cn_varinfo='varname1:cubic/rhoi', 'varname2:linear'  
     29!>       - cn_varinfo='varname1:int=cubic/rhoi', 'varname2:int=linear'  
    3030!> 
    3131!>    to create mixed grid (with coarse grid point needed to compute 
     
    947947 
    948948      DEALLOCATE(il_detect) 
     949 
    949950      !4- save useful domain (remove offset) 
    950951      CALL interp_clean_mixed_grid( tl_mix, td_var, & 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/interp_cubic.f90

    r5037 r5608  
    2626! REVISION HISTORY: 
    2727!> @date September, 2014 -Initial version 
     28!> @date June, 2015 
     29!> - use math module 
    2830!> 
    2931!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    3638   USE logger                          ! log file manager 
    3739   USE fct                             ! basic useful function 
    38    USE extrap                          ! extrapolation manager 
     40   USE math                            ! mathematical function 
    3941 
    4042   IMPLICIT NONE 
     
    6163   !>  
    6264   !> @author J.Paul 
    63    !> - September, 2014- Initial Version 
     65   !> @date September, 2014 - Initial Version 
     66   !> @date July, 2015  
     67   !> - reinitialise detect array for each level 
    6468   !> 
    6569   !> @param[inout] dd_value  2D array of variable value  
     
    8286 
    8387      ! local variable 
    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 
     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 
    9197       
    9298      ! loop indices 
     
    113119      &                               id_rho(jp_J), ld_even(jp_J)) 
    114120 
     121      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
     122 
    115123      DO jl=1,il_shape(4) 
     124         il_detect(:,:,:)=id_detect(:,:,:) 
    116125         ! loop on vertical level 
    117126         DO jk=1,il_shape(3) 
     
    119128            ! I-J plan 
    120129            CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, & 
    121             &                     id_detect(:,:,jk),            & 
     130            &                     il_detect(:,:,jk),            & 
    122131            &                     dl_weight_IJ(:,:),            & 
    123132            &                     id_rho(jp_I), id_rho(jp_J),   & 
    124133            &                     ll_discont)             
    125             IF( ANY(id_detect(:,:,jk)==1) )THEN 
     134            IF( ANY(il_detect(:,:,jk)==1) )THEN 
    126135               ! I direction 
    127136               DO jj=1,il_shape(2) 
    128137                  CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, & 
    129                   &                      id_detect(:,jj,jk),            & 
     138                  &                      il_detect(:,jj,jk),            & 
    130139                  &                      dl_weight_I(:,:),              & 
    131140                  &                      id_rho(jp_I), ll_discont ) 
    132141               ENDDO 
    133                IF( ALL(id_detect(:,:,jk)==0) )THEN 
     142               IF( ALL(il_detect(:,:,jk)==0) )THEN 
    134143                  CYCLE 
    135144               ELSE 
     
    137146                  DO ji=1,il_shape(1) 
    138147                     CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, & 
    139                      &                      id_detect(ji,:,jk),            & 
     148                     &                      il_detect(ji,:,jk),            & 
    140149                     &                      dl_weight_J(:,:),              & 
    141150                     &                      id_rho(jp_J), ll_discont ) 
     
    147156      ENDDO 
    148157 
     158      id_detect(:,:,:)=il_detect(:,:,:) 
     159      DEALLOCATE(il_detect) 
     160 
    149161      DEALLOCATE(dl_weight_IJ) 
    150162      DEALLOCATE(dl_weight_I) 
     
    159171   !> 
    160172   !> @author J.Paul 
    161    !> - September, 2014- Initial Version 
     173   !> @date September, 2014 - Initial Version 
    162174   !> 
    163175   !> @param[inout] dd_value  2D array of variable value  
     
    181193      REAL(dp)                        , INTENT(IN   ) :: dd_fill  
    182194      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect 
    183       REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight  
     195      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
    184196      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi 
    185197      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj 
     
    230242 
    231243         ! compute derivative on coarse grid 
    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) 
     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) 
    234246 
    235247         ! compute cross derivative on coarse grid 
    236          dl_d2fdxy(:,:)=extrap_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont) 
     248         dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont) 
    237249 
    238250         ALLOCATE( dl_tmp(2,2) ) 
     
    319331   !> 
    320332   !> @author J.Paul 
    321    !> - September, 2014- Initial Version 
     333   !> @date September, 2014 - Initial Version 
    322334   !> 
    323335   !> @param[inout] dd_value  1D array of variable value  
     
    339351      REAL(dp)                        , INTENT(IN   ) :: dd_fill  
    340352      INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect 
    341       REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight  
     353      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
    342354      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi 
    343355      LOGICAL                         , INTENT(IN   ) :: ld_discont 
     
    376388 
    377389         ! compute derivative on coarse grid 
    378          dl_dfdx(:)=extrap_deriv_1D(dl_coarse(:), dd_fill, ld_discont) 
     390         dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont) 
    379391 
    380392         ALLOCATE( dl_tmp(2) ) 
     
    440452   !>  
    441453   !> @author J.Paul 
    442    !> - September, 2014- Initial Version 
     454   !> @date September, 2014 - Initial Version 
    443455   !> 
    444456   !> @param[in] dd_value  2D array of value 
     
    503515   !>  
    504516   !> @author J.Paul 
    505    !> - September, 2014- Initial Version 
     517   !> @date September, 2014 - Initial Version 
    506518   !> 
    507519   !> @param[inout] dd_value  2D array of mixed grid value 
     
    565577   !> 
    566578   !> @author J.Paul 
    567    !> - September, 2014- Initial Version 
     579   !> @date September, 2014 - Initial Version 
    568580   !> 
    569581   !> @param[in] dd_value  1D array of value 
     
    608620   !>  
    609621   !> @author J.Paul 
    610    !> - September, 2014- Initial Version 
     622   !> @date September, 2014 - Initial Version 
    611623   !> 
    612624   !> @param[inout] dd_value  1D array of mixed grid value 
     
    659671   !>  
    660672   !> @author J.Paul 
    661    !> - September, 2014- Initial Version 
     673   !> @date September, 2014 - Initial Version 
    662674   !> 
    663675   !> @param[in] dd_weight interpolation weight of 2D array 
     
    740752   !>  
    741753   !> @author J.Paul 
    742    !> - September, 2014- Initial Version 
     754   !> @date September, 2014 - Initial Version 
    743755   !> 
    744756   !> @param[in] dd_weight interpolation weight of 1D array 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/interp_linear.f90

    r5037 r5608  
    6464   !> @author J.Paul 
    6565   !> - September, 2014- Initial Version 
     66   !> @date July, 2015 - reinitialise detect array for each level 
    6667   !> 
    6768   !> @param[inout] dd_value  2D array of variable value  
     
    8485 
    8586      ! local variable 
    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 
     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 
    9396       
    9497      ! loop indices 
     
    104107 
    105108      ! compute vect2D 
    106       ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) ) 
     109      ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) ) 
    107110      CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), & 
    108111      &                               id_rho(:), ld_even(:)) 
    109112 
    110       ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1)                 )) ) 
    111       ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) ) 
     113      ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) ) 
     114      ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) ) 
    112115      CALL interp_linear__get_weight1D(dl_weight_I(:,:), & 
    113116      &                               id_rho(jp_I), ld_even(jp_I)) 
     
    115118      &                               id_rho(jp_J), ld_even(jp_J)) 
    116119 
     120      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
     121 
    117122      DO jl=1,il_shape(4) 
     123         il_detect(:,:,:)=id_detect(:,:,:) 
    118124         ! loop on vertical level 
    119125         DO jk=1,il_shape(3) 
     
    121127            ! I-J plan 
    122128            CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,& 
    123             &                     id_detect(:,:,jk),            & 
     129            &                     il_detect(:,:,jk),            & 
    124130            &                     dl_weight_IJ(:,:),            & 
    125131            &                     id_rho(jp_I), id_rho(jp_J),   & 
    126132            &                     ll_discont)             
    127             IF( ANY(id_detect(:,:,jk)==1) )THEN 
     133            IF( ANY(il_detect(:,:,jk)==1) )THEN 
    128134               ! I direction 
    129135               DO jj=1,il_shape(2) 
    130136                  CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,& 
    131                   &                       id_detect(:,jj,jk),           & 
     137                  &                       il_detect(:,jj,jk),           & 
    132138                  &                       dl_weight_I(:,:),             & 
    133139                  &                       id_rho(jp_I), ll_discont ) 
    134140               ENDDO 
    135                IF( ALL(id_detect(:,:,jk)==0) )THEN 
     141               IF( ALL(il_detect(:,:,jk)==0) )THEN 
    136142                  CYCLE 
    137143               ELSE 
     
    139145                  DO ji=1,il_shape(1) 
    140146                     CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,& 
    141                      &                       id_detect(ji,:,jk),           & 
     147                     &                       il_detect(ji,:,jk),           & 
    142148                     &                       dl_weight_J(:,:),             & 
    143149                     &                       id_rho(jp_J), ll_discont ) 
     
    149155      ENDDO 
    150156 
     157      id_detect(:,:,:)=il_detect(:,:,:) 
     158      DEALLOCATE(il_detect) 
     159 
    151160      DEALLOCATE(dl_weight_IJ) 
    152161      DEALLOCATE(dl_weight_I) 
    153162      DEALLOCATE(dl_weight_J) 
    154        
     163  
    155164   END SUBROUTINE interp_linear_fill 
    156165   !------------------------------------------------------------------- 
     
    235244               IF( ALL(id_detect(ji:ji+id_rhoi,   & 
    236245               &                 jj:jj+id_rhoj)==0) ) CYCLE 
    237                ! check data to needed to interpolate 
     246               ! check data needed to interpolate 
    238247               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE 
    239248               ! check longitude discontinuity 
     
    446455   !> @author J.Paul 
    447456   !> - September, 2014- Initial Version 
    448    !>  
     457   !> 
    449458   !> @param[inout] dd_value  2D array of mixed grid value 
    450459   !> @param[inout] id_detect 2D array of point to be interpolated 
     
    477486      !---------------------------------------------------------------- 
    478487 
    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 
     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 
    497505            ENDDO 
    498  
    499          ENDIF 
     506         ENDDO 
     507 
     508      ENDIF 
    500509 
    501510   END SUBROUTINE interp_linear__2D_fill 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90

    r5037 r5608  
    6969 
    7070      ! local variable 
    71       INTEGER(i4), DIMENSION(4)                :: il_shape 
     71      INTEGER(i4), DIMENSION(4)                  :: il_shape 
     72 
     73      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
    7274 
    7375      ! loop indices 
     
    8082      il_shape(:)=SHAPE(dd_value) 
    8183 
     84      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
    8285      DO jl=1,il_shape(4) 
     86         il_detect(:,:,:)=id_detect(:,:,:) 
    8387         ! loop on vertical level 
    8488         DO jk=1,il_shape(3) 
     
    8690            ! I-J plan 
    8791            CALL interp_nearest__2D(dd_value(:,:,jk,jl),& 
    88             &                       id_detect(:,:,jk),  & 
     92            &                       il_detect(:,:,jk),  & 
    8993            &                       id_rho(jp_I), id_rho(jp_J) )             
    90             IF( ANY(id_detect(:,:,jk)==1) )THEN 
     94            IF( ANY(il_detect(:,:,jk)==1) )THEN 
    9195               ! I direction 
    9296               DO jj=1,il_shape(2) 
    9397                  CALL interp_nearest__1D( dd_value(:,jj,jk,jl),& 
    94                   &                        id_detect(:,jj,jk),  & 
     98                  &                        il_detect(:,jj,jk),  & 
    9599                  &                        id_rho(jp_I) ) 
    96100               ENDDO 
    97                IF( ALL(id_detect(:,:,jk)==0) )THEN 
     101               IF( ALL(il_detect(:,:,jk)==0) )THEN 
    98102                  CYCLE 
    99103               ELSE 
     
    101105                  DO ji=1,il_shape(1) 
    102106                     CALL interp_nearest__1D( dd_value(ji,:,jk,jl),& 
    103                      &                        id_detect(ji,:,jk),  & 
     107                     &                        il_detect(ji,:,jk),  & 
    104108                     &                        id_rho(jp_J) ) 
    105109                  ENDDO 
     
    109113         ENDDO 
    110114      ENDDO 
     115 
     116      id_detect(:,:,:)=il_detect(:,:,:) 
     117      DEALLOCATE(il_detect) 
    111118 
    112119   END SUBROUTINE interp_nearest_fill 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom.f90

    r5037 r5608  
    564564   !------------------------------------------------------------------- 
    565565   !> @brief This subroutine write file structure in an opened file. 
    566    ! 
    567    !> @author J.Paul 
    568    !> - November, 2013- Initial Version 
     566   !> 
     567   !> @details 
     568   !> optionally, you could specify dimension order (default 'xyzt') 
     569   !> 
     570   !> @author J.Paul 
     571   !> - November, 2013- Initial Version 
     572   !> @date July, 2015 - add dimension order option 
    569573   ! 
    570574   !> @param[in] td_file   file structure 
    571575   !------------------------------------------------------------------- 
    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') 
     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 
    583589            CALL iom_rstdimg_write_file(td_file) 
    584590         CASE DEFAULT 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90

    r5037 r5608  
    145145   !> @author J.Paul 
    146146   !> - November, 2013- Initial Version 
    147    ! 
     147   !> @date May, 2015 - add optional message to netcdf error message 
     148   !> 
    148149   !> @param[in] id_status error status 
    149    !------------------------------------------------------------------- 
    150    SUBROUTINE iom_cdf__check(id_status) 
    151       IMPLICIT NONE 
    152       ! Argument       
    153       INTEGER(i4), INTENT(IN) :: id_status 
    154       !---------------------------------------------------------------- 
     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 
    155163 
    156164      IF( id_status /= NF90_NOERR )THEN 
    157          CALL logger_error(TRIM(NF90_STRERROR(id_status))) 
     165         CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status))) 
    158166      ENDIF 
    159167 
     
    203211            CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) ) 
    204212 
    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) 
     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: ") 
    209218 
    210219            td_file%l_def=.TRUE. 
     
    228237               &                      NF90_NOWRITE,         & 
    229238               &                      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))) 
     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))) 
    233243            ELSE 
    234244 
     
    239249               &                      NF90_WRITE,           & 
    240250               &                      td_file%i_id) 
    241                CALL iom_cdf__check(il_status) 
     251               CALL iom_cdf__check(il_status,"IOM CDF OPEN: ") 
    242252 
    243253            ENDIF 
     
    291301 
    292302         il_status = NF90_CLOSE(td_file%i_id) 
    293          CALL iom_cdf__check(il_status) 
     303         CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ") 
    294304 
    295305         td_file%i_id = 0 
     
    326336      il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, & 
    327337      &     td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt) 
    328       CALL iom_cdf__check(il_status) 
     338      CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ") 
    329339 
    330340      SELECT CASE(il_fmt) 
     
    480490 
    481491            ! look for depth id 
    482             IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'depth') /= 0 )THEN 
     492            IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'depth')/=0 )THEN 
    483493               IF( td_file%i_depthid == 0 )THEN 
    484494                  td_file%i_depthid=ji 
    485495               ELSE 
    486496                  IF( td_file%i_depthid /= ji )THEN 
    487                      CALL logger_error("IOM CDF GET FILE VAR: find more than one "//& 
    488                      &                 "depth variable in file "//& 
    489                      &                 TRIM(td_file%c_name) ) 
     497                     CALL logger_error("IOM CDF GET FILE VAR: find more"//& 
     498                        &  " than one depth variable in file "//& 
     499                        &  TRIM(td_file%c_name) ) 
    490500                  ENDIF 
    491501               ENDIF 
     
    493503 
    494504            ! look for time id 
    495             IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'time') /= 0 )THEN 
     505            IF( INDEX(TRIM(fct_lower(td_file%t_var(ji)%c_name)),'time')/=0 )THEN 
    496506               IF( td_file%i_timeid == 0 )THEN 
    497507                  td_file%i_timeid=ji 
     
    504514                     td_file%i_timeid=ji 
    505515                  !ELSE 
    506                   !   print *,'error' 
    507                   !   CALL logger_error("IOM OPEN: find more than one "//& 
    508                   !   &                 "time variable in file "//& 
     516                  !   CALL logger_error("IOM CDF GET FILE VAR: find more "//& 
     517                  !   &                 "than one time variable in file "//& 
    509518                  !   &                 TRIM(td_file%c_name) ) 
    510519                  ENDIF 
     
    568577   !> @author J.Paul 
    569578   !> - November, 2013- Initial Version 
     579   !> @date February, 2015 - create unused dimension, when reading dimension 
     580   !> of length less or equal to zero 
    570581   ! 
    571582   !> @param[in] td_file   file structure 
     
    583594      INTEGER(i4)       :: il_len 
    584595      CHARACTER(LEN=lc) :: cl_name 
     596      LOGICAL           :: ll_use 
    585597      !---------------------------------------------------------------- 
    586598 
     
    601613         il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, & 
    602614         &                                cl_name, il_len ) 
    603          CALL iom_cdf__check(il_status) 
    604  
    605          iom_cdf__read_dim_id=dim_init(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) 
    606626 
    607627      ENDIF 
     
    613633   ! 
    614634   !> @author J.Paul 
    615    !> - November, 2013- Initial Version 
     635   !> - November, 2013 - Initial Version 
    616636   ! 
    617637   !> @param[in] td_file   file structure 
     
    634654 
    635655         CALL logger_error( & 
    636          &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name)) 
     656         &  " IOM CDF READ DIM: no id associated to file "//& 
     657         &  TRIM(td_file%c_name)) 
    637658 
    638659      ELSE       
     
    640661         il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), & 
    641662         &                         il_dimid) 
    642          CALL iom_cdf__check(il_status) 
     663         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ") 
    643664 
    644665         iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid) 
     
    714735         &                                il_len, & 
    715736         &                                il_attid ) 
    716          CALL iom_cdf__check(il_status) 
     737         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ") 
    717738 
    718739         !! get attribute value 
    719          CALL logger_debug( " IOM CDF READ ATT: get attribute "//TRIM(cl_name)//& 
    720          &               " in file "//TRIM(td_file%c_name)) 
     740         CALL logger_debug( " IOM CDF READ ATT: get attribute "//& 
     741            &            TRIM(cl_name)//" in file "//TRIM(td_file%c_name)) 
    721742 
    722743         SELECT CASE( il_type ) 
     
    728749 
    729750                  CALL logger_error( & 
    730                   &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    731                   &  TRIM(cl_name) ) 
     751                  &  " IOM CDF READ ATT: not enough space to put "//& 
     752                  &  "attribute "//TRIM(cl_name) ) 
    732753 
    733754               ELSE 
     
    737758                  &                      cl_name, & 
    738759                  &                      cl_value ) 
    739                   CALL iom_cdf__check(il_status) 
     760                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ") 
    740761 
    741762                  iom_cdf__read_att_name=att_init(cl_name, cl_value) 
     
    758779                  &                      cl_name, & 
    759780                  &                      bl_value(:)) 
    760                   CALL iom_cdf__check(il_status)    
     781                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
    761782 
    762783                  iom_cdf__read_att_name=att_init(cl_name, bl_value(:)) 
     
    773794 
    774795                  CALL logger_error( & 
    775                   &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    776                   &  TRIM(cl_name) ) 
     796                  &  " IOM CDF READ ATT: not enough space to put "//& 
     797                  &  "attribute "//TRIM(cl_name) ) 
    777798 
    778799               ELSE 
     
    782803                  &                      cl_name, & 
    783804                  &                      sl_value(:)) 
    784                   CALL iom_cdf__check(il_status)    
     805                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
    785806 
    786807                  iom_cdf__read_att_name=att_init(cl_name, sl_value(:)) 
     
    797818 
    798819                  CALL logger_error( & 
    799                   &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    800                   &  TRIM(cl_name) ) 
     820                  &  " IOM CDF READ ATT: not enough space to put "//& 
     821                  &  "attribute "//TRIM(cl_name) ) 
    801822 
    802823               ELSE 
     
    806827                  &                      cl_name, & 
    807828                  &                      il_value(:)) 
    808                   CALL iom_cdf__check(il_status)    
     829                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
    809830 
    810831                  iom_cdf__read_att_name=att_init(cl_name, il_value(:)) 
     
    820841 
    821842                  CALL logger_error( & 
    822                   &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    823                   &  TRIM(cl_name) ) 
     843                  &  " IOM CDF READ ATT: not enough space to put "//& 
     844                  &  "attribute "//TRIM(cl_name) ) 
    824845 
    825846               ELSE 
     
    829850                  &                      cl_name, & 
    830851                  &                      fl_value(:)) 
    831                   CALL iom_cdf__check(il_status)    
     852                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
    832853 
    833854                  iom_cdf__read_att_name=att_init(cl_name, fl_value(:)) 
     
    844865 
    845866                  CALL logger_error( & 
    846                   &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    847                   &  TRIM(cl_name) ) 
     867                  &  " IOM CDF READ ATT: not enough space to put "//& 
     868                  &  "attribute "//TRIM(cl_name) ) 
    848869 
    849870               ELSE 
     
    853874                  &                      cl_name, & 
    854875                  &                      dl_value(:)) 
    855                   CALL iom_cdf__check(il_status)    
     876                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")    
    856877 
    857878                  iom_cdf__read_att_name=att_init(cl_name, dl_value(:)) 
     
    902923         ! get attribute name 
    903924         il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name) 
    904          CALL iom_cdf__check(il_status) 
     925         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ") 
    905926 
    906927         ! read attribute 
     
    12401261 
    12411262         ! inquire variable 
    1242          CALL logger_trace( & 
     1263         CALL logger_debug( & 
    12431264         &  " IOM CDF READ VAR META: inquire variable "//& 
    12441265         &  TRIM(fct_str(id_varid))//& 
     
    12531274         &                                il_dimid(:),& 
    12541275         &                                il_natt ) 
    1255          CALL iom_cdf__check(il_status) 
     1276         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ") 
    12561277         !!! fill variable dimension structure 
    12571278         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) ) 
     1279 
    12581280         IF( il_natt /= 0 )THEN 
    12591281            ALLOCATE( tl_att(il_natt) ) 
     
    12761298               ELSE 
    12771299                  ! create attribute _FillValue 
    1278                   SELECT CASE(TRIM(cl_name)) 
     1300                  SELECT CASE(TRIM(fct_lower(cl_name))) 
    12791301                     CASE DEFAULT 
    12801302                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
    12811303                        &                "zero for variable "//TRIM(cl_name) ) 
    12821304                        tl_fill=att_init('_FillValue',0.) 
    1283                      CASE('nav_lon','nav_lat', & 
     1305                     CASE('nav_lon','nav_lat', 'nav_lev', & 
    12841306                        &  'glamt','glamu','glamv','glamf', & 
    12851307                        &  'gphit','gphiu','gphiv','gphif') 
     
    13111333            ALLOCATE(tl_att(il_natt+1) ) 
    13121334            ! create attribute _FillValue 
    1313             SELECT CASE(TRIM(cl_name)) 
     1335            SELECT CASE(TRIM(fct_lower(cl_name))) 
    13141336               CASE DEFAULT 
    13151337                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
     
    13531375   ! 
    13541376   !> @author J.Paul 
    1355    !> - November, 2013- Initial Version 
    1356    ! 
     1377   !> - November, 2013 - Initial Version 
     1378   !> @date July, 2015  
     1379   !> - Bug fix: use order to disorder table (see dim_init) 
     1380   !> 
    13571381   !> @param[in] td_file   file structure 
    13581382   !> @param[in] id_ndim   number of dimension 
     
    13711395 
    13721396      ! local variable 
    1373       INTEGER(i4), DIMENSION(ip_maxdim) :: il_2xyzt 
     1397      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2 
    13741398 
    13751399      TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 
     
    13951419 
    13961420         DO ji = 1, id_ndim 
    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 
     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 
    14011425 
    14021426            ! read dimension information 
    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 ) 
     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 ) 
    14051429         ENDDO 
    14061430 
    14071431         ! reorder dimension to ('x','y','z','t') 
    14081432         CALL dim_reorder(tl_dim(:)) 
    1409        
     1433  
    14101434         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:)) 
    14111435 
     
    14751499   ! 
    14761500   !> @author J.Paul 
    1477    !> - November, 2013- Initial Version 
     1501   !> - November, 2013 - Initial Version 
     1502   !> @date June, 2015  
     1503   !> - use scale factor and offset, as soon as read variable value 
    14781504   ! 
    14791505   !> @param[in] td_file   file structure 
     
    14821508   !> @param[in] id_count  number of indices selected along each dimension 
    14831509   !> @return variable structure completed  
    1484    ! 
    1485    !> @todo 
    1486    !> - warning do not change fill value when use scale factor.. 
    14871510   !------------------------------------------------------------------- 
    14881511   SUBROUTINE iom_cdf__read_var_value(td_file, td_var, & 
     
    14961519 
    14971520      ! local variable 
    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 
     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 
    15061530      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value 
    15071531      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp 
     
    15181542         IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. & 
    15191543             ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN 
    1520             CALL logger_warn( & 
    1521             &  "IOM CDF READ VAR VALUE: id_start and id_count should be both specify") 
     1544            CALL logger_warn( "IOM CDF READ VAR VALUE: id_start and id_count"//& 
     1545               & " should be both specify") 
    15221546         ENDIF 
    15231547         IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN 
     
    15251549            IF( SIZE(id_start(:)) /= ip_maxdim .OR. & 
    15261550            &   SIZE(id_count(:)) /= ip_maxdim )THEN 
    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) ) 
     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) ) 
    15301554            ENDIF 
    15311555 
     
    15641588            &    td_var%t_dim( 4 )%i_len & 
    15651589            &                                            /)) )THEN 
    1566  
    1567             CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//& 
    1568             &  "variable dimension for "//TRIM(td_var%c_name) ) 
    15691590 
    15701591            DO ji = 1, ip_maxdim 
     
    15751596               &  TRIM(fct_str(il_tmp2))) 
    15761597            ENDDO 
     1598            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//& 
     1599            &  "variable dimension for "//TRIM(td_var%c_name) ) 
    15771600 
    15781601         ELSE 
    15791602 
    1580             ! Allocate space to hold variable value (unorder) 
     1603            ! Allocate space to hold variable value (disorder) 
    15811604            ALLOCATE(dl_value( il_count(1), & 
    15821605               &               il_count(2), & 
     
    16011624            &                                       start = il_start(:),& 
    16021625            &                                       count = il_count(:) ) 
    1603             CALL iom_cdf__check(il_status) 
     1626            CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ") 
    16041627 
    16051628            ! Allocate space to hold variable value in structure 
     
    16631686               CALL var_chg_FillValue(td_var) 
    16641687            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 
    16651695         ENDIF 
    16661696      ELSE 
     
    16731703   !------------------------------------------------------------------- 
    16741704   !> @brief This subroutine write file structure in an opened netcdf file. 
    1675    ! 
    1676    !> @author J.Paul 
    1677    !> - November, 2013- Initial Version 
     1705   !> 
     1706   !> @details 
     1707   !> optionally, you could specify dimension order (default 'xyzt') 
     1708   !> 
     1709   !> @author J.Paul 
     1710   !> - November, 2013 - Initial Version 
     1711   !> @date July, 2015  
     1712   !> - add dimension order option  
    16781713   ! 
    16791714   !> @param[inout] td_file   file structure 
    16801715   !------------------------------------------------------------------- 
    1681    SUBROUTINE iom_cdf_write_file(td_file) 
    1682       IMPLICIT NONE 
    1683       ! Argument       
    1684       TYPE(TFILE), INTENT(INOUT) :: td_file 
     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 
    16851721 
    16861722      ! local variable 
    16871723      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value 
     1724 
     1725      CHARACTER(LEN=lc)                      :: cl_dimorder 
    16881726 
    16891727      TYPE(TVAR)                             :: tl_var 
     
    16941732      INTEGER(i4) :: ji 
    16951733      INTEGER(i4) :: jj 
    1696       !---------------------------------------------------------------- 
     1734      INTEGER(i4) :: jvar 
     1735      !---------------------------------------------------------------- 
     1736 
     1737      cl_dimorder='xyzt' 
     1738      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder) 
    16971739 
    16981740      ! check if file opened 
     
    17261768            ENDIF 
    17271769 
     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 
    17281779            ! write dimension in file 
    17291780            DO ji = 1, ip_maxdim 
     
    17981849         ! Enter define mode 
    17991850         il_status=NF90_REDEF(td_file%i_id) 
    1800          CALL iom_cdf__check(il_status) 
     1851         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ") 
    18011852 
    18021853         td_file%l_def=.TRUE. 
     
    18131864            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), & 
    18141865            &                      NF90_UNLIMITED, td_dim%i_id) 
    1815             CALL iom_cdf__check(il_status) 
     1866            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ") 
    18161867 
    18171868         ELSE 
    18181869            ! write not unlimited dimension 
    1819             CALL logger_trace( & 
     1870            CALL logger_debug( & 
    18201871            &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//& 
    18211872            &  " in file "//TRIM(td_file%c_name)) 
     
    18231874            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), & 
    18241875            &                      td_dim%i_len, td_dim%i_id) 
    1825             CALL iom_cdf__check(il_status) 
     1876            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ") 
    18261877 
    18271878         ENDIF 
     
    18591910         ! Enter define mode 
    18601911         il_status=NF90_REDEF(td_file%i_id) 
    1861          CALL iom_cdf__check(il_status) 
     1912         CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ") 
    18621913 
    18631914         td_file%l_def=.TRUE. 
     
    18761927            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, & 
    18771928            &  td_att%c_name, td_att%c_value ) 
    1878             CALL iom_cdf__check(il_status) 
     1929            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ") 
    18791930 
    18801931         CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE) 
     
    18821933            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, & 
    18831934            &  td_att%c_name, td_att%d_value ) 
    1884             CALL iom_cdf__check(il_status) 
     1935            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ") 
    18851936 
    18861937      END SELECT 
     
    19171968         ! Enter define mode 
    19181969         il_status=NF90_REDEF(td_file%i_id) 
    1919          CALL iom_cdf__check(il_status) 
     1970         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ") 
    19201971 
    19211972         td_file%l_def=.TRUE. 
    19221973 
    19231974      ENDIF 
    1924        
     1975  
    19251976      ! check if file and variable dimension conform 
    19261977      IF( file_check_var_dim(td_file, td_var) )THEN 
     
    19381989            ENDIF 
    19391990         ENDDO 
     1991         ! ugly patch until NEMO do not force to use 0. as FillValue  
    19401992         IF( ll_chg )THEN 
    19411993            ! not a dimension variable 
    19421994            ! change FillValue 
    1943  
    1944             ! ugly patch until NEMO do not force to use 0. as FillValue  
    1945             CALL var_chg_FillValue(td_var,0._dp) 
     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 
    19462002         ENDIF 
    19472003 
     
    19572013            ! Leave define mode 
    19582014            il_status=NF90_ENDDEF(td_file%i_id) 
    1959             CALL iom_cdf__check(il_status) 
     2015            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR: ") 
    19602016 
    19612017            td_file%l_def=.FALSE. 
     
    20022058      tl_var=var_copy(td_var) 
    20032059 
     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 
    20042065      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)) 
    20052069         ! scalar value 
    20062070         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name), & 
    20072071         &                        tl_var%i_type, varid=iom_cdf__write_var_def)  
    2008          CALL iom_cdf__check(il_status) 
     2072         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    20092073      ELSE 
    20102074 
     
    20202084         ENDDO 
    20212085 
    2022          CALL logger_trace( & 
     2086         CALL logger_debug( & 
    20232087         &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//& 
    20242088         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    20252089 
    20262090         DO ji=1,jj 
    2027             CALL logger_trace("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) ) 
     2091            CALL logger_debug("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) ) 
    20282092         ENDDO 
     2093 
    20292094         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name),     & 
    20302095         &                        tl_var%i_type,                         & 
    20312096         &                        il_dimid(1:jj),                        & 
    20322097         &                        varid=iom_cdf__write_var_def           ) 
    2033          CALL iom_cdf__check(il_status) 
     2098         CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    20342099      ENDIF 
    20352100 
     
    20432108 
    20442109      DO ji = 1, tl_var%i_natt 
    2045          CALL logger_trace( & 
     2110         CALL logger_debug( & 
    20462111         &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(tl_var%t_att(ji)%c_name)//& 
    20472112         &  " for variable "//TRIM(tl_var%c_name)//& 
    20482113         &  " 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 
    20492119 
    20502120         IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN 
     
    20532123               &                        TRIM(tl_var%t_att(ji)%c_name),        & 
    20542124               &                        TRIM(tl_var%t_att(ji)%c_value)        ) 
    2055                CALL iom_cdf__check(il_status) 
     2125               CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    20562126            ENDIF 
    20572127         ELSE 
     
    20822152                  &                        TRIM(tl_var%t_att(ji)%c_name),  & 
    20832153                  &                        REAL(tl_var%t_att(ji)%d_value(:),dp)) 
    2084                END SELECT 
    2085             CALL iom_cdf__check(il_status) 
     2154            END SELECT 
     2155            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ") 
    20862156         ENDIF 
    20872157      ENDDO 
     
    20972167   ! 
    20982168   !> @author J.Paul 
    2099    !> - November, 2013- Initial Version 
     2169   !> - November, 2013 - Initial Version 
     2170   !> @date June, 2015 
     2171   !> - reuse scale factor and offset, before writing variable 
    21002172   ! 
    21012173   !> @param[in] td_file   file structure 
     
    21222194      &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//& 
    21232195      &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    2124  
     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       
    21252203      jj=0 
    21262204      DO ji = 1, ip_maxdim 
     
    21532231 
    21542232      il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:)) 
    2155       CALL iom_cdf__check(il_status) 
     2233      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE: ") 
    21562234 
    21572235      DEALLOCATE( dl_value ) 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90

    r5037 r5608  
    161161 
    162162      ELSE 
     163         !  
     164         td_mpp%i_id=1 
     165 
    163166         ! if no processor file selected 
    164167         ! force to open all files  
     
    267270 
    268271      ELSE 
     272         !  
     273         td_mpp%i_id=0          
     274 
    269275         DO ji=1,td_mpp%i_nproc 
    270276            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
     
    314320         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    315321 
     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       
    316327      ELSE 
     328 
    317329 
    318330         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN 
     
    384396         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    385397 
     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       
    386403      ELSE 
    387404 
     
    400417               CALL logger_error( & 
    401418               &  " IOM MPP READ VAR: there is no variable with "//& 
    402                &  "name or standard name"//TRIM(cd_name)//& 
     419               &  "name or standard name "//TRIM(cd_name)//& 
    403420               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    404421            ENDIF 
     
    467484      IF( PRESENT(id_count) ) il_count(:)=id_count(:) 
    468485 
     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 
    469497      DO jk=1,ip_maxdim 
    470498         IF( .NOT. td_var%t_dim(jk)%l_use )THEN 
     
    476504      ENDDO 
    477505 
    478  
    479506      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)) ) 
    480517            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//& 
    481518            &                 "exceed dimension bound.") 
     
    583620   ! 
    584621   !> @details 
     622   !> optionally, you could specify the dimension order (default 'xyzt') 
    585623   ! 
    586624   !> @author J.Paul 
    587    !> - November, 2013- Initial Version 
     625   !> - November, 2013 - Initial Version 
     626   !> @date July, 2015 - add dimension order option  
    588627   ! 
    589628   !> @param[inout] td_mpp mpp structure 
    590    !------------------------------------------------------------------- 
    591    SUBROUTINE iom_mpp_write_file(td_mpp) 
     629   !> @param[In] cd_dimorder dimension order 
     630   !------------------------------------------------------------------- 
     631   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder) 
    592632      IMPLICIT NONE 
    593633      ! Argument       
    594       TYPE(TMPP), INTENT(INOUT) :: td_mpp 
     634      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
     635      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder 
    595636 
    596637      ! local variable 
     
    610651               !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 
    611652 
    612                CALL iom_write_file(td_mpp%t_proc(ji)) 
     653               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
    613654            ELSE 
    614655               CALL logger_debug( " MPP WRITE: no id associated to file "//& 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90

    r5037 r5608  
    10581058      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start 
    10591059      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count 
     1060 
    10601061      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    10611062 
     
    12041205      ENDIF 
    12051206 
     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 
    12061219   END SUBROUTINE iom_rstdimg__read_var_value 
    12071220   !------------------------------------------------------------------- 
     
    16601673         ! change FillValue to 0. 
    16611674         CALL var_chg_FillValue(td_file%t_var(ji),0._dp) 
     1675 
     1676         ! use scale factor and offset 
     1677         WHERE( td_file%t_var(ji)%d_value(:,:,:,:) /= & 
     1678         &      td_file%t_var(ji)%d_fill ) 
     1679            td_file%t_var(ji)%d_value(:,:,:,:) = & 
     1680            &  (td_file%t_var(ji)%d_value(:,:,:,:)-td_file%t_var(ji)%d_ofs) /& 
     1681            &    td_file%t_var(ji)%d_scf 
     1682         END WHERE 
    16621683 
    16631684         cl_name(ji)  = TRIM(td_file%t_var(ji)%c_name) 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/logger.f90

    r5037 r5608  
    1616!> but not necessarily "wrong".  
    1717!>    - error : Other runtime errors or unexpected conditions. 
    18 !>    - fatal : Severe errors that cause premature termination.<br /> 
     18!>    - fatal : Severe errors that cause premature termination. 
    1919!>  default verbosity is warning 
     20!>    - none  : to not create and write any information in logger file.<br /> 
    2021! 
    2122!> If total number of error exceeded maximum number  
     
    2425!> to open/create logger file:<br/> 
    2526!> @code 
    26 !>    CALL logger_open(cd_file, [cd_verbosity,] [id_loggerid,] [id_maxerror]) 
     27!>    CALL logger_open(cd_file, [cd_verbosity,] [id_maxerror,] [id_loggerid]) 
    2728!> @endcode 
    2829!> - cd_file is logger file name 
     
    121122! REVISION HISTORY: 
    122123!> @date November, 2013- Initial Version 
     124!> @date February, 2015 
     125!> - check verbosity validity 
     126!> - add 'none' verbosity level to not used logger file 
    123127!> 
    124128!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    151155 
    152156   PRIVATE :: logger__write     ! cut message to get maximum of 80 character by line in log file 
     157   PRIVATE :: logger__check_verb! check verbosity validity 
    153158 
    154159   TYPE TLOGGER   !< logger structure 
    155160      INTEGER(i4)       :: i_id = 0                 !< log file id 
     161      LOGICAL           :: l_use=.TRUE.             !< use logger or not 
    156162      CHARACTER(LEN=lc) :: c_name                   !< log file name 
    157163      CHARACTER(LEN=lc) :: c_verbosity = "warning"  !< verbosity choose 
     
    163169 
    164170   !  module variable 
    165    INTEGER(i4), PARAMETER :: im_nverbosity=6     !< number of log level 
     171   INTEGER(i4), PARAMETER :: im_nverbosity=7     !< number of log level 
    166172   CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array  
    167173   &               (/ 'trace   ',& 
     
    170176   &                  'warning ',& 
    171177   &                  'error   ',& 
    172    &                  'fatal   '/) 
     178   &                  'fatal   ',& 
     179   &                  'none    '/) 
    173180 
    174181   TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure 
     
    188195   !> @param[in] cd_file      log file name 
    189196   !> @param[in] cd_verbosity log file verbosity 
     197   !> @param[in] id_maxerror  maximum number of error 
    190198   !> @param[in] id_logid     log file id (use to flush) 
    191    !> @param[in] id_maxerror  maximum number of error 
    192    !------------------------------------------------------------------- 
    193    SUBROUTINE logger_open(cd_file, cd_verbosity, id_logid, id_maxerror) 
     199   !------------------------------------------------------------------- 
     200   SUBROUTINE logger_open(cd_file, cd_verbosity, id_maxerror, id_logid) 
    194201      IMPLICIT NONE 
    195202      ! Argument 
    196203      CHARACTER(len=*), INTENT(IN) :: cd_file                ! log file name 
    197204      CHARACTER(len=*), INTENT(IN), OPTIONAL :: cd_verbosity ! log file verbosity 
     205      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error 
    198206      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id 
    199       INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error 
    200207 
    201208      ! local variable 
    202209      INTEGER(i4) :: il_status 
    203210 
     211      LOGICAL     :: ll_valid 
     212 
    204213      ! loop 
    205214      INTEGER(i4) :: ji 
    206215      !---------------------------------------------------------------- 
    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)) 
    225216 
    226217      ! if present, change verbosity value 
    227218      IF( PRESENT(cd_verbosity) )THEN 
    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 
     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 
    244263      ENDIF 
    245264 
     
    256275      INTEGER(i4) :: il_status 
    257276      !---------------------------------------------------------------- 
    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') 
     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 
    267288      ENDIF 
    268289 
     
    277298      IMPLICIT NONE 
    278299      !---------------------------------------------------------------- 
    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') 
     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 
    287310      ENDIF 
    288311 
     
    299322      INTEGER(i4)       :: il_status 
    300323      !---------------------------------------------------------------- 
    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') 
     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 
    314339      ENDIF 
    315340 
     
    326351      INTEGER(i4)       :: il_status 
    327352      !---------------------------------------------------------------- 
    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') 
     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 
    344371      ENDIF 
    345372   END SUBROUTINE logger_footer 
     
    361388      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    362389      !---------------------------------------------------------------- 
    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       
    373          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') 
     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') 
     406         ENDIF 
    378407      ENDIF 
    379408   END SUBROUTINE logger_trace 
     
    395424      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    396425      !---------------------------------------------------------------- 
    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       
    407          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') 
     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') 
     442         ENDIF 
    412443      ENDIF 
    413444   END SUBROUTINE logger_debug 
     
    429460      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    430461      !---------------------------------------------------------------- 
    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       
    441          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') 
     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') 
     478         ENDIF 
    446479      ENDIF 
    447480   END SUBROUTINE logger_info 
     
    463496      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush 
    464497      !---------------------------------------------------------------- 
    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       
    475          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') 
     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') 
     514         ENDIF 
    480515      ENDIF 
    481516   END SUBROUTINE logger_warn 
     
    500535      CHARACTER(LEN=lc) :: cl_nerror 
    501536      !---------------------------------------------------------------- 
    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       
    515          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  
     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') 
     564         ENDIF 
     565      ENDIF 
    528566   END SUBROUTINE logger_error 
    529567   !------------------------------------------------------------------- 
     
    541579      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg 
    542580      !---------------------------------------------------------------- 
    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 
    555          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') 
     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') 
     599         ENDIF 
    560600      ENDIF 
    561601   END SUBROUTINE logger_fatal 
     
    615655 
    616656   END SUBROUTINE logger__write 
     657   !------------------------------------------------------------------- 
     658   !> @brief This function check validity of verbosity. 
     659   !> 
     660   !> @author J.Paul 
     661   !> - 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 
    617696END MODULE logger 
    618697 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/merge_bathy.f90

    r5037 r5608  
    2828!> @endcode 
    2929!>     
     30!> @note  
     31!>    you could find a template of the namelist in templates directory. 
     32!> 
    3033!>    merge_bathy.nam comprise 8 namelists: 
    3134!>       - logger namelist (namlog) 
     
    4548!>       - cn_logfile   : logger filename 
    4649!>       - cn_verbosity : verbosity ('trace','debug','info', 
    47 !>  'warning','error','fatal') 
     50!>  'warning','error','fatal','none') 
    4851!>       - in_maxerror  : maximum number of error allowed 
    4952!> 
     
    6265!>    * _variable namelist (namvar)_: 
    6366!>       - cn_varinfo : list of variable and extra information about request(s)  
    64 !>       to be used.<br/> 
     67!>       to be used (separated by ',').<br/> 
    6568!>          each elements of *cn_varinfo* is a string character.<br/> 
    6669!>          it is composed of the variable name follow by ':',  
    6770!>          then request(s) to be used on this variable.<br/>  
    6871!>          request could be: 
    69 !>             - interpolation method 
     72!>             - int = interpolation method 
    7073!>  
    7174!>                requests must be separated by ';'.<br/> 
     
    7477!>          informations about available method could be find in  
    7578!>          @ref interp modules.<br/> 
    76 !>          Example: 'bathymetry: cubic' 
     79!>          Example: 'bathymetry: int=cubic' 
    7780!>          @note  
    7881!>             If you do not specify a method which is required,  
     
    9598!>          segments are separated by '|'.<br/> 
    9699!>          each segments of the boundary is composed of: 
    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/> 
     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/> 
    102105!>             - optionally, boundary size could be added between '(' and ')'  
    103106!>             in the first segment defined. 
     
    106109!> 
    107110!>          Examples: 
    108 !>             - cn_north='index1,first1,last1(width)' 
    109 !>             - cn_north='index1(width),first1,last1|index2,first2,last2' 
     111!>             - cn_north='index1,first1:last1(width)' 
     112!>             - cn_north='index1(width),first1:last1|index2,first2:last2' 
     113!> 
    110114!>       - cn_south : south boundary indices on fine grid<br/> 
    111115!>       - cn_east  : east  boundary indices on fine grid<br/> 
     
    121125!> @date Sepember, 2014  
    122126!> - add header for user 
     127!> @date July, 2015  
     128!> - extrapolate all land points 
     129!> - add attributes with boundary string character (as in namelist) 
    123130!> 
    124131!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    153160   CHARACTER(LEN=lc)                                  :: cl_namelist 
    154161   CHARACTER(LEN=lc)                                  :: cl_date 
     162   CHARACTER(LEN=lc)                                  :: cl_tmp 
    155163 
    156164   INTEGER(i4)                                        :: il_narg 
     
    162170   INTEGER(i4)                                        :: il_jmin0 
    163171   INTEGER(i4)                                        :: il_jmax0 
     172   INTEGER(i4)                                        :: il_shift 
    164173   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho 
    165174   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind 
     
    231240   NAMELIST /namlog/ &  !< logger namelist 
    232241   &  cn_logfile,    &  !< log file 
    233    &  cn_verbosity      !< log verbosity 
     242   &  cn_verbosity,  &  !< log verbosity 
     243   &  in_maxerror       !< logger maximum error 
    234244 
    235245   NAMELIST /namcfg/ &  !< config namelist 
     
    298308      READ( il_fileid, NML = namlog ) 
    299309      ! define log file 
    300       CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity), in_maxerror) 
     310      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 
    301311      CALL logger_header() 
    302312 
     
    510520   ENDIF 
    511521 
     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 
    512596   ! create file 
    513597   CALL iom_create(tl_fileout) 
     
    525609   CALL mpp_clean(tl_bathy0) 
    526610   DEALLOCATE(dl_weight) 
     611   CALL boundary_clean(tl_bdy(:)) 
    527612 
    528613   ! close log file 
     
    908993 
    909994      ! extrapolate variable 
    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 ) 
     995      CALL extrap_fill_value( td_var ) 
    913996 
    914997      ! interpolate Bathymetry 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/mpp.f90

    r5037 r5608  
    165165!>    to get processors to be used:<br/> 
    166166!> @code 
    167 !>    CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, &  
    168 !>    &                         id_jmin, id_jmax, id_jdim ) 
     167!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, &  
     168!>    &                         id_jmin, id_jmax ) 
    169169!> @endcode 
    170170!>       - id_imin  
    171171!>       - id_imax  
    172 !>       - id_idim  
    173172!>       - id_jmin  
    174173!>       - id_jmax  
    175 !>       - id_jdim  
    176174!> 
    177175!>    to get sub domains which form global domain contour:<br/> 
     
    379377      ! copy mpp variable 
    380378      mpp__copy_unit%c_name     = TRIM(td_mpp%c_name) 
     379      mpp__copy_unit%i_id       = td_mpp%i_id 
    381380      mpp__copy_unit%i_niproc   = td_mpp%i_niproc 
    382381      mpp__copy_unit%i_njproc   = td_mpp%i_njproc 
     
    495494      ! print dimension 
    496495      IF(  td_mpp%i_ndim /= 0 )THEN 
    497          WRITE(*,'(/a)') " File dimension" 
     496         WRITE(*,'(/a)') " MPP dimension" 
    498497         DO ji=1,ip_maxdim 
    499498            IF( td_mpp%t_dim(ji)%l_use )THEN 
     
    698697      CALL dim_clean(tl_dim) 
    699698 
    700       IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. & 
     699      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. & 
    701700          ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN 
    702701          CALL logger_warn( "MPP INIT: number of processors following I and J "//& 
     
    10281027            ! create some attributes for domain decomposition (use with dimg file) 
    10291028            tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc ) 
    1030             CALL mpp_add_att(mpp__init_file, tl_att) 
     1029            CALL mpp_move_att(mpp__init_file, tl_att) 
    10311030 
    10321031            tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 
    1033             CALL mpp_add_att(mpp__init_file, tl_att) 
     1032            CALL mpp_move_att(mpp__init_file, tl_att) 
    10341033 
    10351034            tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 
    1036             CALL mpp_add_att(mpp__init_file, tl_att) 
     1035            CALL mpp_move_att(mpp__init_file, tl_att) 
    10371036 
    10381037            tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 
    1039             CALL mpp_add_att(mpp__init_file, tl_att) 
     1038            CALL mpp_move_att(mpp__init_file, tl_att) 
    10401039 
    10411040            tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 
    1042             CALL mpp_add_att(mpp__init_file, tl_att) 
     1041            CALL mpp_move_att(mpp__init_file, tl_att) 
    10431042 
    10441043            tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 
    1045             CALL mpp_add_att(mpp__init_file, tl_att) 
     1044            CALL mpp_move_att(mpp__init_file, tl_att) 
    10461045 
    10471046            tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 
    1048             CALL mpp_add_att(mpp__init_file, tl_att) 
     1047            CALL mpp_move_att(mpp__init_file, tl_att) 
    10491048 
    10501049            tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 
    1051             CALL mpp_add_att(mpp__init_file, tl_att) 
     1050            CALL mpp_move_att(mpp__init_file, tl_att) 
    10521051 
    10531052            tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 
    1054             CALL mpp_add_att(mpp__init_file, tl_att) 
     1053            CALL mpp_move_att(mpp__init_file, tl_att) 
    10551054             
    10561055            ! clean 
     
    11221121      CALL file_clean(tl_file) 
    11231122 
    1124       CALL logger_debug("MPP INIT READ: fin init_read ") 
    11251123   END FUNCTION mpp__init_file 
    11261124   !------------------------------------------------------------------- 
     
    11311129   ! 
    11321130   !> @author J.Paul 
    1133    !> - November, 2013- Initial Version 
     1131   !> - November, 2013 - Initial Version 
     1132   !> @date July, 2015 - add only use dimension in MPP structure 
    11341133   !> 
    11351134   !> @param[in] td_file   file strcuture 
     
    11631162         IF( td_file%i_id == 0 )THEN 
    11641163            CALL logger_info(" id "//TRIM(fct_str(td_file%i_id)))  
    1165             CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//& 
    1166             " not opened") 
     1164            CALL logger_error("MPP INIT READ: netcdf file "//& 
     1165               &  TRIM(td_file%c_name)//" not opened") 
    11671166         ELSE 
    11681167 
     
    11911190               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    11921191            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) 
     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 
    11981202 
    11991203            ! initialise file/processor 
     
    16241628            IF( il_varid /= 0 )THEN 
    16251629 
    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) ) 
    16361639 
    16371640            ELSE 
     
    18401843   !> @author J.Paul 
    18411844   !> @date November, 2013 - Initial version 
     1845   !> @date February, 2015 - define local variable structure to avoid mistake 
     1846   !> with pointer 
    18421847   ! 
    18431848   !> @param[inout] td_mpp    mpp strcuture 
     
    18521857      ! local variable 
    18531858      INTEGER(i4)       :: il_varid 
     1859      TYPE(TVAR)        :: tl_var 
    18541860      !---------------------------------------------------------------- 
    18551861      ! check if mpp exist 
     
    18821888            ELSE 
    18831889 
    1884                CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid))  
     1890               tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid)) 
     1891               CALL mpp_del_var(td_mpp, tl_var) 
    18851892 
    18861893            ENDIF 
     
    21942201   !> @author J.Paul 
    21952202   !> - November, 2013- Initial Version 
     2203   !> @date July, 2015 - rewrite the same as way var_add_dim 
    21962204   !> 
    21972205   !> @param[inout] td_mpp mpp structure 
     
    22082216 
    22092217      ! loop indices 
    2210       INTEGER(i4) :: ji 
    22112218      !---------------------------------------------------------------- 
    22122219      IF( td_mpp%i_ndim <= ip_maxdim )THEN 
    22132220 
    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  
     2221         ! check if dimension already used in mpp structure 
     2222         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
     2223         IF( il_ind == 0 )THEN 
     2224            CALL logger_warn( & 
     2225            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
     2226            &  ", short name "//TRIM(td_dim%c_sname)//& 
     2227            &  ", will not be added in mpp "//TRIM(td_mpp%c_name) ) 
     2228         ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN 
     2229            CALL logger_error( & 
     2230            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
     2231            &  ", short name "//TRIM(td_dim%c_sname)//& 
     2232            &  ", already used in mpp "//TRIM(td_mpp%c_name) ) 
    22302233         ELSE 
    22312234 
    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 
     2235            ! back to disorder dimension array  
     2236            CALL dim_disorder(td_mpp%t_dim(:)) 
     2237 
     2238            ! add new dimension 
     2239            td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim) 
     2240 
     2241            ! update number of attribute 
     2242            td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
    22552243 
    22562244         ENDIF 
     2245         ! reorder dimension to ('x','y','z','t') 
     2246         CALL dim_reorder(td_mpp%t_dim(:)) 
    22572247 
    22582248      ELSE 
     
    22692259   !> @author J.Paul 
    22702260   !> - November, 2013- Initial Version 
     2261   !> @date July, 2015 - rewrite the same as way var_del_dim 
    22712262   !> 
    22722263   !> @param[inout] td_mpp mpp structure 
     
    22802271 
    22812272      ! local variable 
    2282       INTEGER(i4) :: il_status 
    22832273      INTEGER(i4) :: il_ind 
    2284       TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim 
     2274      TYPE(TDIM)  :: tl_dim 
    22852275 
    22862276      ! loop indices 
    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)//& 
     2277      !---------------------------------------------------------------- 
     2278 
     2279 
     2280      IF( td_mpp%i_ndim <= ip_maxdim )THEN 
     2281 
     2282         CALL logger_trace( & 
     2283         &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 
    22952284         &  ", short name "//TRIM(td_dim%c_sname)//& 
    22962285         &  ", in mpp "//TRIM(td_mpp%c_name) ) 
     2286          
     2287         ! check if dimension already in variable structure 
     2288         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
     2289 
     2290         ! replace dimension by empty one 
     2291         td_mpp%t_dim(il_ind)=dim_copy(tl_dim) 
     2292 
     2293         ! update number of dimension 
     2294         td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
     2295 
     2296         ! reorder dimension to ('x','y','z','t') 
     2297         CALL dim_reorder(td_mpp%t_dim) 
    22972298 
    22982299      ELSE 
    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  
     2300         CALL logger_error( & 
     2301         &  " MPP DEL DIM: too much dimension in mpp "//& 
     2302         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")") 
    23332303      ENDIF 
    23342304 
     
    24882458            &  ", in mpp structure "//TRIM(td_mpp%c_name) ) 
    24892459 
    2490             IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN 
     2460            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN 
    24912461               DO ji=1,td_mpp%t_proc(1)%i_natt 
    24922462                  CALL logger_debug( "MPP DEL ATT: in mpp structure : & 
    2493                   &  attribute : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) ) 
     2463                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) ) 
    24942464               ENDDO 
    24952465            ENDIF 
     
    25162486   !> @author J.Paul 
    25172487   !> @date November, 2013 - Initial version 
     2488   !> @date February, 2015 - define local attribute structure to avoid mistake 
     2489   !> with pointer 
    25182490   ! 
    25192491   !> @param[inout] td_mpp    mpp strcuture 
     
    25272499 
    25282500      ! local variable 
    2529       INTEGER(i4)       :: il_attid 
     2501      INTEGER(i4) :: il_attid 
     2502      TYPE(TATT)  :: tl_att 
    25302503      !---------------------------------------------------------------- 
    25312504      ! check if mpp exist 
     
    25512524            IF( il_attid == 0 )THEN 
    25522525 
    2553                CALL logger_warn( & 
     2526               CALL logger_debug( & 
    25542527               &  "MPP DEL ATT : there is no attribute with "//& 
    25552528               &  "name "//TRIM(cd_name)//" in mpp structure "//& 
     
    25582531            ELSE 
    25592532 
    2560                CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid))  
     2533               tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid)) 
     2534               CALL mpp_del_att(td_mpp, tl_att)  
    25612535 
    25622536            ENDIF 
     
    28632837 
    28642838            CALL logger_info("MPP OPTIMIZ: number of processor "//& 
    2865             &  TRIM(fct_str(tl_mpp%i_nproc)) ) 
     2839            &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     2840            &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28662841            IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 
    28672842            &   tl_mpp%i_nproc <= il_maxproc )THEN 
    28682843               ! save optimiz decomposition  
     2844 
     2845               CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
     2846               &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     2847               &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28692848 
    28702849               ! clean mpp 
     
    34173396 
    34183397      ! local variable 
    3419       INTEGER(i4) :: il_ndim 
    34203398 
    34213399      ! loop indices 
     
    34293407         mpp__check_var_dim=.FALSE. 
    34303408 
    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  
    34363409         CALL logger_debug( & 
    34373410         &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//& 
    34383411         &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) ) 
    3439          il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim ) 
    3440          DO ji = 1, il_ndim 
     3412         DO ji = 1, ip_maxdim 
    34413413            CALL logger_debug( & 
    34423414            &  "MPP CHECK DIM: for dimension "//& 
     
    34483420            &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use))) 
    34493421         ENDDO 
     3422 
     3423         CALL logger_error( & 
     3424         &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
     3425         &  " for variable "//TRIM(td_var%c_name)//& 
     3426         &  " and mpp "//TRIM(td_mpp%c_name)) 
     3427 
    34503428      ENDIF 
    34513429 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/multi.f90

    r5037 r5608  
    170170   !> @author J.Paul 
    171171   !> - November, 2013- Initial Version 
     172   !> @date July, 2015 - check if variable to be read is in file 
    172173   !> 
    173174   !> @param[in] cd_varfile   variable location information (from namelist)  
     
    190191 
    191192      INTEGER(i4)       :: il_nvar 
     193      INTEGER(i4)       :: il_varid 
    192194 
    193195      LOGICAL           :: ll_dim 
     
    242244                  ! define variable 
    243245                  IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN 
     246 
     247                     ! check if variable is in file 
     248                     il_varid=var_get_index(tl_mpp%t_proc(1)%t_var(:),cl_lower) 
     249                     IF( il_varid == 0 )THEN 
     250                        CALL logger_fatal("MULTI INIT: variable "//& 
     251                           & TRIM(cl_name)//" not in file "//& 
     252                           & TRIM(cl_file) ) 
     253                     ENDIF 
    244254 
    245255                     ! clean var 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/phycst.f90

    r5037 r5608  
    2525   PUBLIC :: dp_rearth  !< earth radius (km) 
    2626   PUBLIC :: dp_deg2rad !< degree to radian ratio  
     27   PUBLIC :: dp_rad2deg !< radian to degree ratio  
    2728   PUBLIC :: dp_delta   !<   
    2829 
     
    3132   REAL(dp), PARAMETER :: dp_rearth = 6871._dp 
    3233   REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0 
     34   REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi 
    3335 
    34    REAL(dp), PARAMETER :: dp_delta=1.e-2 
     36   REAL(dp), PARAMETER :: dp_delta=1.e-6 
    3537END MODULE phycst 
    3638 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/variable.f90

    r5037 r5608  
    281281!> @date November, 2014  
    282282!> - Fix memory leaks bug 
     283!> @date June, 2015 
     284!> - change way to get variable information in namelist 
     285!> @date July, 2015  
     286!> - add subroutine var_chg_unit to change unit of output variable 
    283287! 
    284288!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    293297   USE att                             ! attribute manager 
    294298   USE dim                             ! dimension manager 
     299   USE math                            ! mathematical function 
    295300   IMPLICIT NONE 
    296301   ! NOTE_avoid_public_variables_if_possible 
     
    318323   PUBLIC :: var_concat        !< concatenate two variables 
    319324   PUBLIC :: var_limit_value   !< forced min and max value 
     325   PUBLIC :: var_chg_unit      !< change variable unit and value 
    320326   PUBLIC :: var_max_dim       !< get array of maximum dimension use 
    321327   PUBLIC :: var_reorder       !< reorder table of value in variable structure 
     
    382388   PRIVATE :: var__get_max       ! get maximum value from namelist  
    383389   PRIVATE :: var__get_min       ! get minimum value from namelist 
     390   PRIVATE :: var__get_unf       ! get scale factor value from namelist 
     391   PRIVATE :: var__get_unt       ! get unit from namelist 
    384392   PRIVATE :: var__get_interp    ! get interpolation method from namelist 
    385393   PRIVATE :: var__get_extrap    ! get extrapolation method from namelist 
     
    401409      TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes 
    402410      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension 
    403        
     411  
    404412      LOGICAL           :: l_file = .FALSE.  !< variable read in a file 
    405413 
     
    414422      REAL(dp)          :: d_min = dp_fill      !< minimum value  
    415423      REAL(dp)          :: d_max = dp_fill      !< maximum value  
    416        
     424  
     425      CHARACTER(LEN=lc) :: c_unt = ''           !< new variables units (linked to units factor) 
     426      REAL(dp)          :: d_unf = 1._dp        !< units factor 
     427 
    417428      !!! netcdf4 
    418429      LOGICAL           :: l_contiguous = .FALSE. !< use contiguous storage or not 
     
    549560      var__copy_unit%d_max      = td_var%d_max 
    550561 
     562      var__copy_unit%c_unt      = TRIM(td_var%c_unt) 
     563      var__copy_unit%d_unf      = td_var%d_unf 
     564 
    551565      var__copy_unit%i_type     = td_var%i_type 
    552566      var__copy_unit%i_natt     = td_var%i_natt 
     
    577591      var__copy_unit%c_units    = TRIM(td_var%c_units) 
    578592      var__copy_unit%c_axis     = TRIM(td_var%c_axis) 
     593      var__copy_unit%d_unf      = td_var%d_unf 
    579594      var__copy_unit%d_scf      = td_var%d_scf 
    580595      var__copy_unit%d_ofs      = td_var%d_ofs 
     
    788803   !>   - id_id : variable id (read from a file). 
    789804   !>   - id_ew : number of point composing east west wrap band. 
     805   !>   - dd_unf : real(8) value for units factor attribute. 
    790806   !>   - dd_scf : real(8) value for scale factor attribute. 
    791807   !>   - dd_ofs : real(8) value for add offset attribute. 
     
    801817   !>   - cd_extrap  : a array of character defining extrapolation method. 
    802818   !>   - cd_filter  : a array of character defining filtering method. 
     819   !>   - cd_unt : a string character to define output unit 
     820   !>   - dd_unf : real(8) factor applied to change unit 
    803821   !> 
    804822   !>  @note most of these optionals arguments will be inform automatically, 
     
    807825   !> @author J.Paul 
    808826   !> - November, 2013- Initial Version 
     827   !> @date February, 2015 - Bug fix: conversion of the FillValue type (float case) 
     828   !> @date June, 2015 - add unit factor (to change unit) 
    809829   !> 
    810830   !> @param[in] cd_name         variable name 
     
    833853   !> @param[in] cd_extrap       extrapolation method 
    834854   !> @param[in] cd_filter       filter method 
     855   !> @param[in] cd_unt          new units (linked to units factor) 
     856   !> @param[in] dd_unf          units factor 
    835857   !> @return variable structure 
    836858   !------------------------------------------------------------------- 
     
    843865   &                              ld_contiguous, ld_shuffle,& 
    844866   &                              ld_fletcher32, id_deflvl, id_chunksz, & 
    845    &                              cd_interp, cd_extrap, cd_filter ) 
     867   &                              cd_interp, cd_extrap, cd_filter, & 
     868   &                              cd_unt, dd_unf ) 
    846869      IMPLICIT NONE 
    847870      ! Argument 
     
    871894      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
    872895      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     896      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     897      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    873898 
    874899 
     
    933958               tl_att=att_init('_FillValue', INT(dd_fill,i4) ) 
    934959            CASE(NF90_FLOAT) 
    935                tl_att=att_init('_FillValue', INT(dd_fill,sp) ) 
     960               tl_att=att_init('_FillValue', REAL(dd_fill,sp) ) 
    936961            CASE DEFAULT ! NF90_DOUBLE 
    937                      tl_att=att_init('_FillValue', dd_fill ) 
     962               tl_att=att_init('_FillValue', dd_fill ) 
    938963         END SELECT 
    939964         CALL var_move_att(var__init, tl_att) 
     
    10381063      ENDIF 
    10391064 
     1065      ! units factor 
     1066      IF( PRESENT(dd_unf) )THEN 
     1067         tl_att=att_init('units_factor',dd_unf) 
     1068         CALL var_move_att(var__init, tl_att) 
     1069      ENDIF 
     1070 
     1071      ! new units (linked to units factor) 
     1072      IF( PRESENT(cd_unt) )THEN 
     1073         tl_att=att_init('new_units',cd_units) 
     1074         CALL var_move_att(var__init, tl_att) 
     1075      ENDIF 
     1076 
    10401077      ! add extra information 
    10411078      CALL var__get_extra(var__init) 
     
    10471084      CALL var_del_att(var__init, 'filter') 
    10481085      CALL var_del_att(var__init, 'src_file') 
     1086      CALL var_del_att(var__init, 'src_i_indices') 
     1087      CALL var_del_att(var__init, 'src_j_indices') 
    10491088      CALL var_del_att(var__init, 'valid_min') 
    10501089      CALL var_del_att(var__init, 'valid_max') 
     
    10731112   !> @author J.Paul 
    10741113   !> - November, 2013- Initial Version 
    1075    ! 
     1114   !> @date June, 2015 
     1115   !> - add interp, extrap, and filter argument 
     1116   !> @date July, 2015 
     1117   !> - add unit factor (to change unit) 
     1118   !> 
    10761119   !> @param[in] cd_name         variable name 
    10771120   !> @param[in] dd_value        1D array of real(8) value 
     
    11001143   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use 
    11011144   !> @param[in] id_chunksz      chunk size 
     1145   !> @param[in] cd_interp       interpolation method 
     1146   !> @param[in] cd_extrap       extrapolation method 
     1147   !> @param[in] cd_filter       filter method 
     1148   !> @param[in] cd_unt          new units (linked to units factor) 
     1149   !> @param[in] dd_unf          units factor 
    11021150   !> @return variable structure 
    11031151   !------------------------------------------------------------------- 
     
    11101158   &                                    dd_min, dd_max,           & 
    11111159   &                                    ld_contiguous, ld_shuffle,& 
    1112    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1160   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1161   &                                    cd_interp, cd_extrap, cd_filter, & 
     1162   &                                    cd_unt, dd_unf) 
    11131163      IMPLICIT NONE 
    11141164      ! Argument 
     
    11381188      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    11391189      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1190      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1191      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1192      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1193      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1194      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    11401195 
    11411196      ! local variable 
     
    11931248      &                          ld_fletcher32=ld_fletcher32,        & 
    11941249      &                          id_deflvl=id_deflvl,                & 
    1195       &                          id_chunksz=id_chunksz(:)) 
     1250      &                          id_chunksz=id_chunksz(:),           & 
     1251      &                          cd_interp=cd_interp(:),             & 
     1252      &                          cd_extrap=cd_extrap(:),             & 
     1253      &                          cd_filter=cd_filter(:),             & 
     1254      &                          cd_unt=cd_unt, dd_unf=dd_unf ) 
    11961255    
    11971256      ! add value 
     
    12401299   !> @author J.Paul 
    12411300   !> - November, 2013- Initial Version 
     1301   !> @date February, 2015 - bug fix: array initialise with dimension 
     1302   !> array not only one value 
     1303   !> @date June, 2015 
     1304   !> - add interp, extrap, and filter argument 
     1305   !> - Bux fix: dimension array initialise not only one value 
     1306   !> @date July, 2015 
     1307   !> - add unit factor (to change unit) 
    12421308   ! 
    12431309   !> @param[in] cd_name         variable name 
     
    12691335   !> no deflation is in use 
    12701336   !> @param[in] id_chunksz      chunk size 
     1337   !> @param[in] cd_interp       interpolation method 
     1338   !> @param[in] cd_extrap       extrapolation method 
     1339   !> @param[in] cd_filter       filter method 
     1340   !> @param[in] cd_unt          new units (linked to units factor) 
     1341   !> @param[in] dd_unf          units factor 
    12711342   !> @return variable structure 
    12721343   !------------------------------------------------------------------- 
     
    12791350   &                                    dd_min, dd_max,           & 
    12801351   &                                    ld_contiguous, ld_shuffle,& 
    1281    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1352   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1353   &                                    cd_interp, cd_extrap, cd_filter, & 
     1354   &                                    cd_unt, dd_unf) 
    12821355      IMPLICIT NONE 
    12831356      ! Argument 
     
    13071380      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    13081381      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1382      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1383      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1384      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1385      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1386      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    13091387 
    13101388      ! local variable 
     
    13501428      ENDIF 
    13511429 
    1352       il_count(:)=tl_dim(1)%i_len 
     1430      il_count(:)=tl_dim(:)%i_len 
    13531431      IF( PRESENT(id_count) )THEN 
    13541432         IF( SIZE(id_count(:)) /= 2 )THEN 
     
    13811459      &                          ld_fletcher32=ld_fletcher32,        & 
    13821460      &                          id_deflvl=id_deflvl,                & 
    1383       &                          id_chunksz=id_chunksz(:)) 
     1461      &                          id_chunksz=id_chunksz(:),           & 
     1462      &                          cd_interp=cd_interp(:),             & 
     1463      &                          cd_extrap=cd_extrap(:),             & 
     1464      &                          cd_filter=cd_filter(:),             & 
     1465      &                          cd_unt=cd_unt, dd_unf=dd_unf ) 
    13841466    
    13851467      ! add value 
     
    14321514   !> @author J.Paul 
    14331515   !> - November, 2013- Initial Version 
    1434    ! 
     1516   !> @date June, 2015 
     1517   !> - add interp, extrap, and filter argument 
     1518   !> @date July, 2015 
     1519   !> - add unit factor (to change unit) 
     1520   !> 
    14351521   !> @param[in] cd_name         variable name 
    14361522   !> @param[in] dd_value        1D array of real(8) value 
     
    14611547   !> deflation is in use 
    14621548   !> @param[in] id_chunksz      chunk size 
     1549   !> @param[in] cd_interp       interpolation method 
     1550   !> @param[in] cd_extrap       extrapolation method 
     1551   !> @param[in] cd_filter       filter method 
     1552   !> @param[in] cd_unt          new units (linked to units factor) 
     1553   !> @param[in] dd_unf          units factor 
    14631554   !> @return variable structure 
    14641555   !------------------------------------------------------------------- 
     
    14711562   &                                    dd_min, dd_max,           & 
    14721563   &                                    ld_contiguous, ld_shuffle,& 
    1473    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1564   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1565   &                                    cd_interp, cd_extrap, cd_filter, & 
     1566   &                                    cd_unt, dd_unf) 
    14741567      IMPLICIT NONE 
    14751568      ! Argument 
     
    14991592      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    15001593      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1594      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1595      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1596      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1597      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1598      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    15011599 
    15021600      ! local variable 
     
    15771675      &                          ld_fletcher32=ld_fletcher32,        & 
    15781676      &                          id_deflvl=id_deflvl,                & 
    1579       &                          id_chunksz=id_chunksz(:)) 
     1677      &                          id_chunksz=id_chunksz(:),           & 
     1678      &                          cd_interp=cd_interp(:),             & 
     1679      &                          cd_extrap=cd_extrap(:),             & 
     1680      &                          cd_filter=cd_filter(:),             & 
     1681      &                          cd_unt=cd_unt, dd_unf=dd_unf ) 
    15801682    
    15811683      ! add value 
     
    16241726   !> @author J.Paul 
    16251727   !> - November, 2013- Initial Version 
    1626    ! 
     1728   !> @date June, 2015 
     1729   !> - add interp, extrap, and filter argument 
     1730   !> @date July, 2015 
     1731   !> - add unit factor (to change unit) 
     1732   !> 
    16271733   !> @param[in] cd_name         variable name 
    16281734   !> @param[in] dd_value        4D array of real(8) value 
     
    16531759   !> deflation is in use 
    16541760   !> @param[in] id_chunksz      chunk size 
     1761   !> @param[in] cd_interp       interpolation method 
     1762   !> @param[in] cd_extrap       extrapolation method 
     1763   !> @param[in] cd_filter       filter method 
     1764   !> @param[in] cd_unt          new units (linked to units factor) 
     1765   !> @param[in] dd_unf          units factor 
    16551766   !> @return variable structure 
    16561767   !------------------------------------------------------------------- 
     
    16631774   &                                 dd_min, dd_max,           & 
    16641775   &                                 ld_contiguous, ld_shuffle,& 
    1665    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     1776   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     1777   &                                 cd_interp, cd_extrap, cd_filter, & 
     1778   &                                 cd_unt, dd_unf ) 
    16661779      IMPLICIT NONE 
    16671780      ! Argument 
     
    16911804      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    16921805      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1806      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1807      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1808      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1809      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1810      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    16931811 
    16941812      ! local variable 
     
    17231841      &                       ld_fletcher32=ld_fletcher32,        & 
    17241842      &                       id_deflvl=id_deflvl,                & 
    1725       &                       id_chunksz=id_chunksz(:)) 
     1843      &                       id_chunksz=id_chunksz(:),           & 
     1844      &                       cd_interp=cd_interp(:),             & 
     1845      &                       cd_extrap=cd_extrap(:),             & 
     1846      &                       cd_filter=cd_filter(:),             & 
     1847      &                       cd_unt=cd_unt, dd_unf=dd_unf ) 
    17261848  
    17271849      ! add value 
     
    17591881   !> @author J.Paul 
    17601882   !> - November, 2013- Initial Version 
     1883   !> @date June, 2015 
     1884   !> - add interp, extrap, and filter argument 
     1885   !> @date July, 2015 
     1886   !> - add unit factor (to change unit) 
    17611887   ! 
    17621888   !> @param[in] cd_name         variable name 
     
    17881914   !> deflation is in use 
    17891915   !> @param[in] id_chunksz      chunk size 
     1916   !> @param[in] cd_interp       interpolation method 
     1917   !> @param[in] cd_extrap       extrapolation method 
     1918   !> @param[in] cd_filter       filter method 
     1919   !> @param[in] cd_unt          new units (linked to units factor) 
     1920   !> @param[in] dd_unf          units factor 
    17901921   !> @return variable structure 
    17911922   !------------------------------------------------------------------- 
     
    17981929   &                                    dd_min, dd_max,           & 
    17991930   &                                    ld_contiguous, ld_shuffle,& 
    1800    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     1931   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     1932   &                                    cd_interp, cd_extrap, cd_filter, & 
     1933   &                                    cd_unt, dd_unf) 
    18011934 
    18021935      IMPLICIT NONE 
     
    18271960      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    18281961      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     1962      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     1963      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     1964      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     1965      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     1966      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     1967 
    18291968 
    18301969      ! local variable 
     
    18702009      &                         ld_fletcher32=ld_fletcher32,        & 
    18712010      &                         id_deflvl=id_deflvl,                & 
    1872       &                         id_chunksz=id_chunksz(:)) 
     2011      &                         id_chunksz=id_chunksz(:),           & 
     2012      &                         cd_interp=cd_interp(:),             & 
     2013      &                         cd_extrap=cd_extrap(:),             & 
     2014      &                         cd_filter=cd_filter(:),             & 
     2015      &                         cd_unt=cd_unt, dd_unf=dd_unf ) 
    18732016  
    18742017      DEALLOCATE( dl_value ) 
     
    18932036   !> @author J.Paul 
    18942037   !> - November, 2013- Initial Version 
     2038   !> @date June, 2015 
     2039   !> - add interp, extrap, and filter argument 
     2040   !> @date July, 2015 
     2041   !> - add unit factor (to change unit) 
    18952042   ! 
    18962043   !> @param[in] cd_name         : variable name 
     
    19222069   !> deflation is in use 
    19232070   !> @param[in] id_chunksz      : chunk size 
     2071   !> @param[in] cd_interp       interpolation method 
     2072   !> @param[in] cd_extrap       extrapolation method 
     2073   !> @param[in] cd_filter       filter method 
     2074   !> @param[in] cd_unt          new units (linked to units factor) 
     2075   !> @param[in] dd_unf          units factor 
    19242076   !> @return variable structure 
    19252077   !------------------------------------------------------------------- 
     
    19322084   &                                    dd_min, dd_max,           & 
    19332085   &                                    ld_contiguous, ld_shuffle,& 
    1934    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2086   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2087   &                                    cd_interp, cd_extrap, cd_filter, & 
     2088   &                                    cd_unt, dd_unf) 
    19352089 
    19362090      IMPLICIT NONE 
     
    19612115      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    19622116      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2117      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2118      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2119      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2120      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2121      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    19632122 
    19642123      ! local variable 
     
    20062165      &                         ld_fletcher32=ld_fletcher32,        & 
    20072166      &                         id_deflvl=id_deflvl,                & 
    2008       &                         id_chunksz=id_chunksz(:)) 
     2167      &                         id_chunksz=id_chunksz(:),           & 
     2168      &                         cd_interp=cd_interp(:),             & 
     2169      &                         cd_extrap=cd_extrap(:),             & 
     2170      &                         cd_filter=cd_filter(:),             & 
     2171      &                         cd_unt=cd_unt, dd_unf=dd_unf ) 
    20092172       
    20102173      DEALLOCATE( dl_value ) 
     
    20292192   !> @author J.Paul 
    20302193   !> - November, 2013- Initial Version 
     2194   !> @date June, 2015 
     2195   !> - add interp, extrap, and filter argument 
     2196   !> @date July, 2015 
     2197   !> - add unit factor (to change unit) 
    20312198   ! 
    20322199   !> @param[in] cd_name         : variable name 
     
    20582225   !> deflation is in use 
    20592226   !> @param[in] id_chunksz      : chunk size 
     2227   !> @param[in] cd_interp       interpolation method 
     2228   !> @param[in] cd_extrap       extrapolation method 
     2229   !> @param[in] cd_filter       filter method 
     2230   !> @param[in] cd_unt          new units (linked to units factor) 
     2231   !> @param[in] dd_unf          units factor 
    20602232   !> @return variable structure 
    20612233   !------------------------------------------------------------------- 
     
    20682240   &                                    dd_min, dd_max,           & 
    20692241   &                                    ld_contiguous, ld_shuffle,& 
    2070    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2242   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2243   &                                    cd_interp, cd_extrap, cd_filter, & 
     2244   &                                    cd_unt, dd_unf) 
    20712245 
    20722246      IMPLICIT NONE 
     
    20972271      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    20982272      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2273      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2274      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2275      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2276      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2277      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    20992278 
    21002279      ! local variable 
     
    21432322      &                         ld_fletcher32=ld_fletcher32,        & 
    21442323      &                         id_deflvl=id_deflvl,                & 
    2145       &                         id_chunksz=id_chunksz(:)) 
     2324      &                         id_chunksz=id_chunksz(:),           & 
     2325      &                         cd_interp=cd_interp(:),             & 
     2326      &                         cd_extrap=cd_extrap(:),             & 
     2327      &                         cd_filter=cd_filter(:),             & 
     2328      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    21462329       
    21472330      DEALLOCATE( dl_value ) 
     
    21662349   !> @author J.Paul 
    21672350   !> - November, 2013- Initial Version 
     2351   !> @date June, 2015 
     2352   !> - add interp, extrap, and filter argument 
     2353   !> @date July, 2015 
     2354   !> - add unit factor (to change unit) 
    21682355   ! 
    21692356   !> @param[in] cd_name         variable name 
     
    21952382   !> deflation is in use 
    21962383   !> @param[in] id_chunksz      chunk size 
     2384   !> @param[in] cd_interp       interpolation method 
     2385   !> @param[in] cd_extrap       extrapolation method 
     2386   !> @param[in] cd_filter       filter method 
     2387   !> @param[in] cd_unt          new units (linked to units factor) 
     2388   !> @param[in] dd_unf          units factor 
    21972389   !> @return variable structure 
    21982390   !------------------------------------------------------------------- 
     
    22052397   &                                 dd_min, dd_max,           & 
    22062398   &                                 ld_contiguous, ld_shuffle,& 
    2207    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     2399   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     2400   &                                 cd_interp, cd_extrap, cd_filter, & 
     2401   &                                 cd_unt, dd_unf) 
    22082402 
    22092403      IMPLICIT NONE 
     
    22342428      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    22352429      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2430      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2431      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2432      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2433      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2434      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    22362435 
    22372436      ! local variable 
     
    22812480      &                      ld_fletcher32=ld_fletcher32,        & 
    22822481      &                      id_deflvl=id_deflvl,                & 
    2283       &                      id_chunksz=id_chunksz(:)) 
     2482      &                      id_chunksz=id_chunksz(:),           & 
     2483      &                      cd_interp=cd_interp(:),             & 
     2484      &                      cd_extrap=cd_extrap(:),             & 
     2485      &                      cd_filter=cd_filter(:),             & 
     2486      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    22842487       
    22852488      DEALLOCATE( dl_value ) 
     
    23042507   !> @author J.Paul 
    23052508   !> - November, 2013- Initial Version 
     2509   !> @date June, 2015 
     2510   !> - add interp, extrap, and filter argument 
     2511   !> @date July, 2015 
     2512   !> - add unit factor (to change unit) 
    23062513   ! 
    23072514   !> @param[in] cd_name         : variable name 
     
    23332540   !> deflation is in use 
    23342541   !> @param[in] id_chunksz      : chunk size 
     2542   !> @param[in] cd_interp       interpolation method 
     2543   !> @param[in] cd_extrap       extrapolation method 
     2544   !> @param[in] cd_filter       filter method 
     2545   !> @param[in] cd_unt          new units (linked to units factor) 
     2546   !> @param[in] dd_unf          units factor 
    23352547   !> @return variable structure 
    23362548   !------------------------------------------------------------------- 
     
    23432555   &                                    dd_min, dd_max,           & 
    23442556   &                                    ld_contiguous, ld_shuffle,& 
    2345    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2557   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2558   &                                    cd_interp, cd_extrap, cd_filter, & 
     2559   &                                    cd_unt, dd_unf) 
    23462560 
    23472561      IMPLICIT NONE 
     
    23722586      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    23732587      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2588      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2589      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2590      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2591      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2592      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    23742593 
    23752594      ! local variable 
     
    24152634      &                         ld_fletcher32=ld_fletcher32,        & 
    24162635      &                         id_deflvl=id_deflvl,                & 
    2417       &                         id_chunksz=id_chunksz(:)) 
     2636      &                         id_chunksz=id_chunksz(:),           & 
     2637      &                         cd_interp=cd_interp(:),             & 
     2638      &                         cd_extrap=cd_extrap(:),             & 
     2639      &                         cd_filter=cd_filter(:),             & 
     2640      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    24182641  
    24192642      DEALLOCATE( dl_value ) 
     
    24382661   !> @author J.Paul 
    24392662   !> - November, 2013- Initial Version 
     2663   !> @date June, 2015 
     2664   !> - add interp, extrap, and filter argument 
     2665   !> @date July, 2015 
     2666   !> - add unit factor (to change unit) 
    24402667   ! 
    24412668   !> @param[in] cd_name         variable name 
     
    24652692   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use 
    24662693   !> @param[in] id_chunksz      chunk size 
     2694   !> @param[in] cd_interp       interpolation method 
     2695   !> @param[in] cd_extrap       extrapolation method 
     2696   !> @param[in] cd_filter       filter method 
     2697   !> @param[in] cd_unt          new units (linked to units factor) 
     2698   !> @param[in] dd_unf          units factor 
    24672699   !> @return variable structure 
    24682700   !------------------------------------------------------------------- 
     
    24752707   &                                    dd_min, dd_max,           & 
    24762708   &                                    ld_contiguous, ld_shuffle,& 
    2477    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2709   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2710   &                                    cd_interp, cd_extrap, cd_filter, & 
     2711   &                                    cd_unt, dd_unf) 
    24782712 
    24792713      IMPLICIT NONE 
     
    25042738      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    25052739      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2740      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2741      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2742      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2743      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2744      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    25062745 
    25072746      ! local variable 
     
    25492788      &                         ld_fletcher32=ld_fletcher32,        & 
    25502789      &                         id_deflvl=id_deflvl,                & 
    2551       &                         id_chunksz=id_chunksz(:)) 
     2790      &                         id_chunksz=id_chunksz(:),           & 
     2791      &                         cd_interp=cd_interp(:),             & 
     2792      &                         cd_extrap=cd_extrap(:),             & 
     2793      &                         cd_filter=cd_filter(:),             & 
     2794      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    25522795       
    25532796      DEALLOCATE( dl_value ) 
     
    25722815   !> @author J.Paul 
    25732816   !> - November, 2013- Initial Version 
     2817   !> @date June, 2015 
     2818   !> - add interp, extrap, and filter argument 
     2819   !> @date July, 2015 
     2820   !> - add unit factor (to change unit) 
    25742821   ! 
    25752822   !> @param[in] cd_name         variable name 
     
    26012848   !> deflation is in use 
    26022849   !> @param[in] id_chunksz      chunk size 
     2850   !> @param[in] cd_interp       interpolation method 
     2851   !> @param[in] cd_extrap       extrapolation method 
     2852   !> @param[in] cd_filter       filter method 
     2853   !> @param[in] cd_unt          new units (linked to units factor) 
     2854   !> @param[in] dd_unf          units factor 
    26032855   !> @return variable structure 
    26042856   !------------------------------------------------------------------- 
     
    26112863   &                                    dd_min, dd_max,           & 
    26122864   &                                    ld_contiguous, ld_shuffle,& 
    2613    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     2865   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     2866   &                                    cd_interp, cd_extrap, cd_filter, & 
     2867   &                                    cd_unt, dd_unf) 
    26142868 
    26152869      IMPLICIT NONE 
     
    26402894      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    26412895      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     2896      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     2897      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     2898      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     2899      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     2900      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    26422901 
    26432902      ! local variable 
     
    26862945      &                         ld_fletcher32=ld_fletcher32,        & 
    26872946      &                         id_deflvl=id_deflvl,                & 
    2688       &                         id_chunksz=id_chunksz(:)) 
     2947      &                         id_chunksz=id_chunksz(:),           & 
     2948      &                         cd_interp=cd_interp(:),             & 
     2949      &                         cd_extrap=cd_extrap(:),             & 
     2950      &                         cd_filter=cd_filter(:),             & 
     2951      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    26892952       
    26902953      DEALLOCATE( dl_value ) 
     
    27092972   !> @author J.Paul 
    27102973   !> - November, 2013- Initial Version 
     2974   !> @date June, 2015 
     2975   !> - add interp, extrap, and filter argument 
     2976   !> @date July, 2015 
     2977   !> - add unit factor (to change unit) 
    27112978   ! 
    27122979   !> @param[in] cd_name         variable name 
     
    27383005   !> deflation is in use 
    27393006   !> @param[in] id_chunksz      chunk size 
     3007   !> @param[in] cd_interp       interpolation method 
     3008   !> @param[in] cd_extrap       extrapolation method 
     3009   !> @param[in] cd_filter       filter method 
     3010   !> @param[in] cd_unt          new units (linked to units factor) 
     3011   !> @param[in] dd_unf          units factor 
    27403012   !> @return variable structure 
    27413013   !------------------------------------------------------------------- 
     
    27483020   &                                 dd_min, dd_max,           & 
    27493021   &                                 ld_contiguous, ld_shuffle,& 
    2750    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     3022   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     3023   &                                 cd_interp, cd_extrap, cd_filter, & 
     3024   &                                 cd_unt, dd_unf) 
    27513025 
    27523026      IMPLICIT NONE 
     
    27773051      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    27783052      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3053      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3054      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3055      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3056      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3057      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     3058 
    27793059 
    27803060      ! local variable 
     
    28243104      &                      ld_fletcher32=ld_fletcher32,        & 
    28253105      &                      id_deflvl=id_deflvl,                & 
    2826       &                      id_chunksz=id_chunksz(:)) 
     3106      &                      id_chunksz=id_chunksz(:),           & 
     3107      &                      cd_interp=cd_interp(:),             & 
     3108      &                      cd_extrap=cd_extrap(:),             & 
     3109      &                      cd_filter=cd_filter(:),             & 
     3110      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    28273111       
    28283112      DEALLOCATE( dl_value ) 
     
    28473131   !> @author J.Paul 
    28483132   !> - November, 2013- Initial Version 
     3133   !> @date June, 2015 
     3134   !> - add interp, extrap, and filter argument 
     3135   !> @date July, 2015 
     3136   !> - add unit factor (to change unit) 
    28493137   ! 
    28503138   !> @param[in] cd_name         variable name 
     
    28763164   !> deflation is in use 
    28773165   !> @param[in] id_chunksz      chunk size 
     3166   !> @param[in] cd_interp       interpolation method 
     3167   !> @param[in] cd_extrap       extrapolation method 
     3168   !> @param[in] cd_filter       filter method 
     3169   !> @param[in] cd_unt          new units (linked to units factor) 
     3170   !> @param[in] dd_unf          units factor 
    28783171   !> @return variable structure 
    28793172   !------------------------------------------------------------------- 
     
    28863179   &                                    dd_min, dd_max,           & 
    28873180   &                                    ld_contiguous, ld_shuffle,& 
    2888    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3181   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3182   &                                    cd_interp, cd_extrap, cd_filter, & 
     3183   &                                    cd_unt, dd_unf) 
    28893184 
    28903185      IMPLICIT NONE 
     
    29153210      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    29163211      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3212      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3213      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3214      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3215      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3216      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    29173217 
    29183218      ! local variable 
     
    29583258      &                         ld_fletcher32=ld_fletcher32,        & 
    29593259      &                         id_deflvl=id_deflvl,                & 
    2960       &                         id_chunksz=id_chunksz(:)) 
     3260      &                         id_chunksz=id_chunksz(:),           & 
     3261      &                         cd_interp=cd_interp(:),             & 
     3262      &                         cd_extrap=cd_extrap(:),             & 
     3263      &                         cd_filter=cd_filter(:),             & 
     3264      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    29613265  
    29623266      DEALLOCATE( dl_value ) 
     
    29813285   !> @author J.Paul 
    29823286   !> - November, 2013- Initial Version 
     3287   !> @date June, 2015 
     3288   !> - add interp, extrap, and filter argument 
     3289   !> @date July, 2015 
     3290   !> - add unit factor (to change unit) 
    29833291   ! 
    29843292   !> @param[in] cd_name         variable name 
     
    30103318   !> deflation is in use 
    30113319   !> @param[in] id_chunksz      chunk size 
     3320   !> @param[in] cd_interp       interpolation method 
     3321   !> @param[in] cd_extrap       extrapolation method 
     3322   !> @param[in] cd_filter       filter method 
     3323   !> @param[in] cd_unt          new units (linked to units factor) 
     3324   !> @param[in] dd_unf          units factor 
    30123325   !> @return variable structure 
    30133326   !------------------------------------------------------------------- 
     
    30203333   &                                    dd_min, dd_max,           & 
    30213334   &                                    ld_contiguous, ld_shuffle,& 
    3022    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3335   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3336   &                                    cd_interp, cd_extrap, cd_filter, & 
     3337   &                                    cd_unt, dd_unf) 
    30233338 
    30243339      IMPLICIT NONE 
     
    30493364      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    30503365      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3366      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3367      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3368      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3369      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3370      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    30513371 
    30523372      ! local variable 
     
    30943414      &                         ld_fletcher32=ld_fletcher32,        & 
    30953415      &                         id_deflvl=id_deflvl,                & 
    3096       &                         id_chunksz=id_chunksz(:)) 
     3416      &                         id_chunksz=id_chunksz(:),           & 
     3417      &                         cd_interp=cd_interp(:),             & 
     3418      &                         cd_extrap=cd_extrap(:),             & 
     3419      &                         cd_filter=cd_filter(:),             & 
     3420      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    30973421       
    30983422      DEALLOCATE( dl_value ) 
     
    31173441   !> @author J.Paul 
    31183442   !> - November, 2013- Initial Version 
     3443   !> @date June, 2015 
     3444   !> - add interp, extrap, and filter argument 
     3445   !> @date July, 2015 
     3446   !> - add unit factor (to change unit) 
    31193447   ! 
    31203448   !> @param[in] cd_name         variable name 
     
    31463474   !> deflation is in use 
    31473475   !> @param[in] id_chunksz      chunk size 
     3476   !> @param[in] cd_interp       interpolation method 
     3477   !> @param[in] cd_extrap       extrapolation method 
     3478   !> @param[in] cd_filter       filter method 
     3479   !> @param[in] cd_unt          new units (linked to units factor) 
     3480   !> @param[in] dd_unf          units factor 
    31483481   !> @return variable structure 
    31493482   !------------------------------------------------------------------- 
     
    31563489   &                                    dd_min, dd_max,           & 
    31573490   &                                    ld_contiguous, ld_shuffle,& 
    3158    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3491   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3492   &                                    cd_interp, cd_extrap, cd_filter, & 
     3493   &                                    cd_unt, dd_unf) 
    31593494 
    31603495      IMPLICIT NONE 
     
    31853520      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    31863521      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3522      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3523      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3524      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3525      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3526      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    31873527 
    31883528      ! local variable 
     
    32313571      &                         ld_fletcher32=ld_fletcher32,        & 
    32323572      &                         id_deflvl=id_deflvl,                & 
    3233       &                         id_chunksz=id_chunksz(:)) 
     3573      &                         id_chunksz=id_chunksz(:),           & 
     3574      &                         cd_interp=cd_interp(:),             & 
     3575      &                         cd_extrap=cd_extrap(:),             & 
     3576      &                         cd_filter=cd_filter(:),             & 
     3577      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    32343578       
    32353579      DEALLOCATE( dl_value ) 
     
    32543598   !> @author J.Paul 
    32553599   !> - November, 2013- Initial Version 
     3600   !> @date June, 2015 
     3601   !> - add interp, extrap, and filter argument 
     3602   !> @date July, 2015 
     3603   !> - add unit factor (to change unit) 
    32563604   ! 
    32573605   !> @param[in] cd_name         variable name 
     
    32833631   !> deflation is in use 
    32843632   !> @param[in] id_chunksz      chunk size 
     3633   !> @param[in] cd_interp       interpolation method 
     3634   !> @param[in] cd_extrap       extrapolation method 
     3635   !> @param[in] cd_filter       filter method 
     3636   !> @param[in] cd_unt          new units (linked to units factor) 
     3637   !> @param[in] dd_unf          units factor 
     3638 
    32853639   !> @return variable structure 
    32863640   !------------------------------------------------------------------- 
     
    32933647   &                                 dd_min, dd_max,           & 
    32943648   &                                 ld_contiguous, ld_shuffle,& 
    3295    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     3649   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     3650   &                                 cd_interp, cd_extrap, cd_filter, & 
     3651   &                                 cd_unt, dd_unf) 
    32963652 
    32973653      IMPLICIT NONE 
     
    33223678      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    33233679      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3680      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3681      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3682      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3683      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3684      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    33243685 
    33253686      ! local variable 
     
    33693730      &                      ld_fletcher32=ld_fletcher32,        & 
    33703731      &                      id_deflvl=id_deflvl,                & 
    3371       &                      id_chunksz=id_chunksz(:)) 
     3732      &                      id_chunksz=id_chunksz(:),           & 
     3733      &                      cd_interp=cd_interp(:),             & 
     3734      &                      cd_extrap=cd_extrap(:),             & 
     3735      &                      cd_filter=cd_filter(:),             & 
     3736      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    33723737       
    33733738      DEALLOCATE( dl_value ) 
     
    33923757   !> @author J.Paul 
    33933758   !> - November, 2013- Initial Version 
     3759   !> @date June, 2015 
     3760   !> - add interp, extrap, and filter argument 
     3761   !> @date July, 2015 
     3762   !> - add unit factor (to change unit) 
    33943763   ! 
    33953764   !> @param[in] cd_name         variable name 
     
    34213790   !> deflation is in use 
    34223791   !> @param[in] id_chunksz      chunk size 
     3792   !> @param[in] cd_interp       interpolation method 
     3793   !> @param[in] cd_extrap       extrapolation method 
     3794   !> @param[in] cd_filter       filter method 
     3795   !> @param[in] cd_unt          new units (linked to units factor) 
     3796   !> @param[in] dd_unf          units factor 
    34233797   !> @return variable structure 
    34243798   !------------------------------------------------------------------- 
     
    34313805   &                                    dd_min, dd_max,           & 
    34323806   &                                    ld_contiguous, ld_shuffle,& 
    3433    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3807   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3808   &                                    cd_interp, cd_extrap, cd_filter, & 
     3809   &                                    cd_unt, dd_unf) 
    34343810 
    34353811      IMPLICIT NONE 
     
    34603836      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    34613837      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3838      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3839      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3840      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3841      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3842      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     3843 
    34623844 
    34633845      ! local variable 
     
    35033885      &                         ld_fletcher32=ld_fletcher32,        & 
    35043886      &                         id_deflvl=id_deflvl,                & 
    3505       &                         id_chunksz=id_chunksz(:)) 
     3887      &                         id_chunksz=id_chunksz(:),           & 
     3888      &                         cd_interp=cd_interp(:),             & 
     3889      &                         cd_extrap=cd_extrap(:),             & 
     3890      &                         cd_filter=cd_filter(:),             & 
     3891      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    35063892  
    35073893      DEALLOCATE( dl_value ) 
     
    35263912   !> @author J.Paul 
    35273913   !> - November, 2013- Initial Version 
     3914   !> @date June, 2015 
     3915   !> - add interp, extrap, and filter argument 
     3916   !> @date July, 2015 
     3917   !> - add unit factor (to change unit) 
    35283918   ! 
    35293919   !> @param[in] cd_name         variable name 
     
    35553945   !> deflation is in use 
    35563946   !> @param[in] id_chunksz      chunk size 
     3947   !> @param[in] cd_interp       interpolation method 
     3948   !> @param[in] cd_extrap       extrapolation method 
     3949   !> @param[in] cd_filter       filter method 
     3950   !> @param[in] cd_unt          new units (linked to units factor) 
     3951   !> @param[in] dd_unf          units factor 
    35573952   !> @return variable structure 
    35583953   !------------------------------------------------------------------- 
     
    35653960   &                                    dd_min, dd_max,           & 
    35663961   &                                    ld_contiguous, ld_shuffle,& 
    3567    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     3962   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     3963   &                                    cd_interp, cd_extrap, cd_filter, & 
     3964   &                                    cd_unt, dd_unf) 
    35683965 
    35693966      IMPLICIT NONE 
     
    35943991      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    35953992      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     3993      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     3994      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     3995      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     3996      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     3997      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
     3998 
    35963999 
    35974000      ! local variable 
     
    36394042      &                         ld_fletcher32=ld_fletcher32,        & 
    36404043      &                         id_deflvl=id_deflvl,                & 
    3641       &                         id_chunksz=id_chunksz(:)) 
     4044      &                         id_chunksz=id_chunksz(:),           & 
     4045      &                         cd_interp=cd_interp(:),             & 
     4046      &                         cd_extrap=cd_extrap(:),             & 
     4047      &                         cd_filter=cd_filter(:),             & 
     4048      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    36424049       
    36434050      DEALLOCATE( dl_value ) 
     
    36624069   !> @author J.Paul 
    36634070   !> - November, 2013- Initial Version 
     4071   !> @date June, 2015 
     4072   !> - add interp, extrap, and filter argument 
     4073   !> @date July, 2015 
     4074   !> - add unit factor (to change unit) 
    36644075   ! 
    36654076   !> @param[in] cd_name         variable name 
     
    36914102   !> deflation is in use 
    36924103   !> @param[in] id_chunksz      chunk size 
     4104   !> @param[in] cd_interp       interpolation method 
     4105   !> @param[in] cd_extrap       extrapolation method 
     4106   !> @param[in] cd_filter       filter method 
     4107   !> @param[in] cd_unt          new units (linked to units factor) 
     4108   !> @param[in] dd_unf          units factor 
    36934109   !> @return variable structure 
    36944110   !------------------------------------------------------------------- 
     
    37014117   &                                    dd_min, dd_max,           & 
    37024118   &                                    ld_contiguous, ld_shuffle,& 
    3703    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4119   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4120   &                                    cd_interp, cd_extrap, cd_filter, & 
     4121   &                                    cd_unt, dd_unf) 
    37044122 
    37054123      IMPLICIT NONE 
     
    37304148      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    37314149      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4150      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4151      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4152      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4153      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4154      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    37324155 
    37334156      ! local variable 
     
    37764199      &                         ld_fletcher32=ld_fletcher32,        & 
    37774200      &                         id_deflvl=id_deflvl,                & 
    3778       &                         id_chunksz=id_chunksz(:)) 
     4201      &                         id_chunksz=id_chunksz(:),           & 
     4202      &                         cd_interp=cd_interp(:),             & 
     4203      &                         cd_extrap=cd_extrap(:),             & 
     4204      &                         cd_filter=cd_filter(:),             & 
     4205      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    37794206       
    37804207      DEALLOCATE( dl_value ) 
     
    37994226   !> @author J.Paul 
    38004227   !> - November, 2013- Initial Version 
     4228   !> @date June, 2015 
     4229   !> - add interp, extrap, and filter argument 
     4230   !> @date July, 2015 
     4231   !> - add unit factor (to change unit) 
    38014232   ! 
    38024233   !> @param[in] cd_name         variable name 
     
    38284259   !> deflation is in use 
    38294260   !> @param[in] id_chunksz      chunk size 
     4261   !> @param[in] cd_interp       interpolation method 
     4262   !> @param[in] cd_extrap       extrapolation method 
     4263   !> @param[in] cd_filter       filter method 
     4264   !> @param[in] cd_unt          new units (linked to units factor) 
     4265   !> @param[in] dd_unf          units factor 
    38304266   !> @return variable structure 
    38314267   !------------------------------------------------------------------- 
     
    38384274   &                                 dd_min, dd_max,           & 
    38394275   &                                 ld_contiguous, ld_shuffle,& 
    3840    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     4276   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     4277   &                                 cd_interp, cd_extrap, cd_filter, & 
     4278   &                                 cd_unt, dd_unf) 
    38414279 
    38424280      IMPLICIT NONE 
     
    38674305      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    38684306      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4307      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4308      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4309      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4310      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4311      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    38694312 
    38704313      ! local variable 
     
    39144357      &                      ld_fletcher32=ld_fletcher32,        & 
    39154358      &                      id_deflvl=id_deflvl,                & 
    3916       &                      id_chunksz=id_chunksz(:)) 
     4359      &                      id_chunksz=id_chunksz(:),           & 
     4360      &                      cd_interp=cd_interp(:),             & 
     4361      &                      cd_extrap=cd_extrap(:),             & 
     4362      &                      cd_filter=cd_filter(:),             & 
     4363      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    39174364       
    39184365      DEALLOCATE( dl_value ) 
     
    39374384   !> @author J.Paul 
    39384385   !> - November, 2013- Initial Version 
     4386   !> @date June, 2015 
     4387   !> - add interp, extrap, and filter argument 
     4388   !> @date July, 2015 
     4389   !> - add unit factor (to change unit) 
    39394390   ! 
    39404391   !> @param[in] cd_name         variable name 
     
    39664417   !> deflation is in use 
    39674418   !> @param[in] id_chunksz      chunk size 
     4419   !> @param[in] cd_interp       interpolation method 
     4420   !> @param[in] cd_extrap       extrapolation method 
     4421   !> @param[in] cd_filter       filter method 
     4422   !> @param[in] cd_unt          new units (linked to units factor) 
     4423   !> @param[in] dd_unf          units factor 
    39684424   !> @return variable structure 
    39694425   !------------------------------------------------------------------- 
     
    39764432   &                                    dd_min, dd_max,           & 
    39774433   &                                    ld_contiguous, ld_shuffle,& 
    3978    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4434   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4435   &                                    cd_interp, cd_extrap, cd_filter, & 
     4436   &                                    cd_unt, dd_unf) 
    39794437 
    39804438      IMPLICIT NONE 
     
    40054463      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    40064464      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4465      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4466      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4467      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4468      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4469      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    40074470 
    40084471      ! local variable 
     
    40484511      &                         ld_fletcher32=ld_fletcher32,        & 
    40494512      &                         id_deflvl=id_deflvl,                & 
    4050       &                         id_chunksz=id_chunksz(:)) 
     4513      &                         id_chunksz=id_chunksz(:),           & 
     4514      &                         cd_interp=cd_interp(:),             & 
     4515      &                         cd_extrap=cd_extrap(:),             & 
     4516      &                         cd_filter=cd_filter(:),             & 
     4517      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    40514518  
    40524519      DEALLOCATE( dl_value ) 
     
    40714538   !> @author J.Paul 
    40724539   !> - November, 2013- Initial Version 
     4540   !> @date June, 2015 
     4541   !> - add interp, extrap, and filter argument 
     4542   !> @date July, 2015 
     4543   !> - add unit factor (to change unit) 
    40734544   ! 
    40744545   !> @param[in] cd_name         variable name 
     
    41004571   !> deflation is in use 
    41014572   !> @param[in] id_chunksz      chunk size 
     4573   !> @param[in] cd_interp       interpolation method 
     4574   !> @param[in] cd_extrap       extrapolation method 
     4575   !> @param[in] cd_filter       filter method 
     4576   !> @param[in] cd_unt          new units (linked to units factor) 
     4577   !> @param[in] dd_unf          units factor 
    41024578   !> @return variable structure 
    41034579   !------------------------------------------------------------------- 
     
    41104586   &                                    dd_min, dd_max,           & 
    41114587   &                                    ld_contiguous, ld_shuffle,& 
    4112    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4588   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4589   &                                    cd_interp, cd_extrap, cd_filter, & 
     4590   &                                    cd_unt, dd_unf) 
    41134591 
    41144592      IMPLICIT NONE 
     
    41394617      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    41404618      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4619      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4620      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4621      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4622      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4623      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    41414624 
    41424625      ! local variable 
     
    41844667      &                         ld_fletcher32=ld_fletcher32,        & 
    41854668      &                         id_deflvl=id_deflvl,                & 
    4186       &                         id_chunksz=id_chunksz(:)) 
     4669      &                         id_chunksz=id_chunksz(:),           & 
     4670      &                         cd_interp=cd_interp(:),             & 
     4671      &                         cd_extrap=cd_extrap(:),             & 
     4672      &                         cd_filter=cd_filter(:),             & 
     4673      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    41874674       
    41884675      DEALLOCATE( dl_value ) 
     
    42074694   !> @author J.Paul 
    42084695   !> - November, 2013- Initial Version 
     4696   !> @date June, 2015 
     4697   !> - add interp, extrap, and filter argument 
     4698   !> @date July, 2015 
     4699   !> - add unit factor (to change unit) 
    42094700   ! 
    42104701   !> @param[in] cd_name         variable name 
     
    42364727   !> deflation is in use 
    42374728   !> @param[in] id_chunksz      chunk size 
     4729   !> @param[in] cd_interp       interpolation method 
     4730   !> @param[in] cd_extrap       extrapolation method 
     4731   !> @param[in] cd_filter       filter method 
     4732   !> @param[in] cd_unt          new units (linked to units factor) 
     4733   !> @param[in] dd_unf          units factor 
    42384734   !> @return variable structure 
    42394735   !------------------------------------------------------------------- 
     
    42464742   &                                    dd_min, dd_max,           & 
    42474743   &                                    ld_contiguous, ld_shuffle,& 
    4248    &                                    ld_fletcher32, id_deflvl, id_chunksz) 
     4744   &                                    ld_fletcher32, id_deflvl, id_chunksz, & 
     4745   &                                    cd_interp, cd_extrap, cd_filter, & 
     4746   &                                    cd_unt, dd_unf) 
    42494747 
    42504748      IMPLICIT NONE 
     
    42754773      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    42764774      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4775      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4776      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4777      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4778      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4779      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    42774780 
    42784781      ! local variable 
     
    43214824      &                         ld_fletcher32=ld_fletcher32,        & 
    43224825      &                         id_deflvl=id_deflvl,                & 
    4323       &                         id_chunksz=id_chunksz(:)) 
     4826      &                         id_chunksz=id_chunksz(:),           & 
     4827      &                         cd_interp=cd_interp(:),             & 
     4828      &                         cd_extrap=cd_extrap(:),             & 
     4829      &                         cd_filter=cd_filter(:),             & 
     4830      &                         cd_unt=cd_unt, dd_unf=dd_unf) 
    43244831       
    43254832      DEALLOCATE( dl_value ) 
     
    43444851   !> @author J.Paul 
    43454852   !> - November, 2013- Initial Version 
     4853   !> @date June, 2015 
     4854   !> - add interp, extrap, and filter argument 
     4855   !> @date July, 2015 
     4856   !> - add unit factor (to change unit) 
    43464857   ! 
    43474858   !> @param[in] cd_name         variable name 
     
    43734884   !> deflation is in use 
    43744885   !> @param[in] id_chunksz      chunk size 
     4886   !> @param[in] cd_interp       interpolation method 
     4887   !> @param[in] cd_extrap       extrapolation method 
     4888   !> @param[in] cd_filter       filter method 
     4889   !> @param[in] cd_unt          new units (linked to units factor) 
     4890   !> @param[in] dd_unf          units factor 
    43754891   !> @return variable structure 
    43764892   !------------------------------------------------------------------- 
     
    43834899   &                                 dd_min, dd_max,           & 
    43844900   &                                 ld_contiguous, ld_shuffle,& 
    4385    &                                 ld_fletcher32, id_deflvl, id_chunksz) 
     4901   &                                 ld_fletcher32, id_deflvl, id_chunksz, & 
     4902   &                                 cd_interp, cd_extrap, cd_filter, & 
     4903   &                                 cd_unt, dd_unf) 
    43864904 
    43874905      IMPLICIT NONE 
     
    44124930      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl 
    44134931      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz 
     4932      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp 
     4933      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap 
     4934      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter 
     4935      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt 
     4936      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf 
    44144937 
    44154938      ! local variable 
     
    44594982      &                      ld_fletcher32=ld_fletcher32,        & 
    44604983      &                      id_deflvl=id_deflvl,                & 
    4461       &                      id_chunksz=id_chunksz(:)) 
     4984      &                      id_chunksz=id_chunksz(:),           & 
     4985      &                      cd_interp=cd_interp(:),             & 
     4986      &                      cd_extrap=cd_extrap(:),             & 
     4987      &                      cd_filter=cd_filter(:),             & 
     4988      &                      cd_unt=cd_unt, dd_unf=dd_unf) 
    44624989       
    44634990      DEALLOCATE( dl_value ) 
     
    48215348   !> @author J.Paul 
    48225349   !> - November, 2013- Initial Version 
     5350   !> @date June, 2015 - add all element of the array in the same time 
    48235351   !> 
    48245352   !> @param[inout] td_var variable structure 
     
    48335361      ! local variable 
    48345362      INTEGER(i4) :: il_natt 
     5363      INTEGER(i4) :: il_status 
     5364      INTEGER(i4) :: il_ind 
     5365      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
    48355366 
    48365367      ! loop indices 
     
    48405371      il_natt=SIZE(td_att(:)) 
    48415372 
     5373      IF( td_var%i_natt > 0 )THEN 
     5374      ! already other attribute in variable structure 
     5375         ALLOCATE( tl_att(td_var%i_natt), stat=il_status ) 
     5376         IF(il_status /= 0 )THEN 
     5377 
     5378            CALL logger_error( & 
     5379            &  " VAR ADD ATT: not enough space to put attributes from "//& 
     5380            &  TRIM(td_var%c_name)//" in temporary attribute structure") 
     5381 
     5382         ELSE 
     5383 
     5384            ! save temporary global attribute's variable structure 
     5385            tl_att(:)=att_copy(td_var%t_att(:)) 
     5386 
     5387            CALL att_clean(td_var%t_att(:)) 
     5388            DEALLOCATE( td_var%t_att ) 
     5389            ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 
     5390            IF(il_status /= 0 )THEN 
     5391 
     5392               CALL logger_error( & 
     5393               &  " VAR ADD ATT: not enough space to put attributes "//& 
     5394               &  "in variable structure "//TRIM(td_var%c_name) ) 
     5395 
     5396            ENDIF 
     5397 
     5398            ! copy attribute in variable before 
     5399            td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 
     5400 
     5401            ! clean 
     5402            CALL att_clean(tl_att(:)) 
     5403            DEALLOCATE(tl_att) 
     5404             
     5405         ENDIF 
     5406      ELSE 
     5407      ! no attribute in variable structure 
     5408         IF( ASSOCIATED(td_var%t_att) )THEN 
     5409            CALL att_clean(td_var%t_att(:)) 
     5410            DEALLOCATE(td_var%t_att) 
     5411         ENDIF 
     5412         ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status ) 
     5413         IF(il_status /= 0 )THEN 
     5414 
     5415            CALL logger_error( & 
     5416            &  " VAR ADD ATT: not enough space to put attributes "//& 
     5417            &  "in variable structure "//TRIM(td_var%c_name) ) 
     5418 
     5419         ENDIF 
     5420      ENDIF 
     5421 
     5422      ALLOCATE( tl_att(il_natt) ) 
     5423      tl_att(:)=att_copy(td_att(:)) 
     5424 
     5425      ! check if attribute already in variable structure 
    48425426      DO ji=1,il_natt 
    4843          CALL var_add_att(td_var, td_att(ji)) 
     5427         il_ind=0 
     5428         il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name ) 
     5429         IF( il_ind /= 0 )THEN 
     5430            CALL logger_error( & 
     5431            &  " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//& 
     5432            &  ", already in variable "//TRIM(td_var%c_name) ) 
     5433            CALL att_clean(tl_att(ji)) 
     5434         ENDIF 
    48445435      ENDDO 
     5436 
     5437      ! add new attributes 
     5438      td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:)) 
     5439 
     5440      DEALLOCATE(tl_att) 
     5441 
     5442      DO ji=1,il_natt 
     5443         ! highlight some attribute 
     5444         IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. & 
     5445           & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN 
     5446            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name)) 
     5447 
     5448               CASE("add_offset") 
     5449                  td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1) 
     5450               CASE("scale_factor") 
     5451                  td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1) 
     5452               CASE("_FillValue") 
     5453                  td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1) 
     5454               CASE("ew_overlap") 
     5455                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4)  
     5456               CASE("standard_name") 
     5457                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5458               CASE("long_name") 
     5459                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5460               CASE("units") 
     5461                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5462               CASE("grid_point") 
     5463                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value) 
     5464 
     5465            END SELECT 
     5466         ENDIF 
     5467      ENDDO 
     5468 
     5469      ! update number of attribute 
     5470      td_var%i_natt=td_var%i_natt+il_natt 
     5471 
    48455472 
    48465473   END SUBROUTINE var__add_att_arr 
     
    48505477   ! 
    48515478   !> @author J.Paul 
    4852    !> - November, 2013- Initial Version 
     5479   !> - November, 2013 - Initial Version 
     5480   !> @date June, 2015 - use var__add_att_arr subroutine 
    48535481   ! 
    48545482   !> @param[inout] td_var variable structure 
     
    48625490 
    48635491      ! local variable 
    4864       INTEGER(i4) :: il_status 
    4865       INTEGER(i4) :: il_ind 
    4866       TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
     5492      TYPE(TATT), DIMENSION(1) :: tl_att 
    48675493 
    48685494      ! loop indices 
    4869       INTEGER(i4) :: ji 
    48705495      !---------------------------------------------------------------- 
    48715496 
    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 
     5497      ! copy structure in an array 
     5498      tl_att(1)=att_copy(td_att) 
     5499 
     5500      !  
     5501      CALL var_add_att( td_var, tl_att(:) ) 
    49775502 
    49785503   END SUBROUTINE var__add_att_unit 
     
    49835508   !> @author J.Paul 
    49845509   !> - November, 2013- Initial Version 
     5510   !> @date February, 2015 - define local attribute structure to avoid mistake  
     5511   !> with pointer 
    49855512   ! 
    49865513   !> @param[inout] td_var variable structure 
     
    49965523      INTEGER(i4) :: il_ind 
    49975524 
     5525      TYPE(TATT)  :: tl_att 
    49985526      ! loop indices 
    49995527      !---------------------------------------------------------------- 
     
    50075535      IF( il_ind == 0 )THEN 
    50085536 
    5009          CALL logger_warn( & 
     5537         CALL logger_debug( & 
    50105538         &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//& 
    50115539         &  ", in variable "//TRIM(td_var%c_name) ) 
     
    50135541      ELSE 
    50145542          
    5015          CALL var_del_att(td_var, td_var%t_att(il_ind)) 
     5543         tl_att=att_copy(td_var%t_att(il_ind)) 
     5544         CALL var_del_att(td_var, tl_att) 
    50165545 
    50175546      ENDIF 
     
    50245553   !> @author J.Paul 
    50255554   !> - November, 2013- Initial Version 
     5555   !> @date February, 2015 - delete highlight attribute too, when attribute  
     5556   !> is deleted 
    50265557   ! 
    50275558   !> @param[inout] td_var variable structure 
     
    50405571 
    50415572      ! loop indices 
    5042       !INTEGER(i4) :: ji 
    50435573      !---------------------------------------------------------------- 
    50445574 
     
    50515581      IF( il_ind == 0 )THEN 
    50525582 
    5053          CALL logger_warn( & 
     5583         CALL logger_debug( & 
    50545584         &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//& 
    50555585         &  ", in variable "//TRIM(td_var%c_name) ) 
     
    51035633               td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 
    51045634 
    5105                !! change attribute id 
    5106                !DO ji=1,td_var%i_natt 
    5107                !   td_var%t_att(ji)%i_id=ji 
    5108                !ENDDO 
    5109  
    51105635               ! clean 
    51115636               CALL att_clean(tl_att(:)) 
     
    51135638            ENDIF  
    51145639         ENDIF 
     5640 
     5641         ! highlight attribute 
     5642         SELECT CASE( TRIM(td_att%c_name) ) 
     5643 
     5644            CASE("add_offset") 
     5645               td_var%d_ofs = 0._dp 
     5646            CASE("scale_factor") 
     5647               td_var%d_scf = 1._dp 
     5648            CASE("_FillValue") 
     5649               td_var%d_fill = 0._dp 
     5650            CASE("ew_overlap") 
     5651               td_var%i_ew = -1  
     5652            CASE("standard_name") 
     5653               td_var%c_stdname = '' 
     5654            CASE("long_name") 
     5655               td_var%c_longname = '' 
     5656            CASE("units") 
     5657               td_var%c_units = '' 
     5658            CASE("grid_point") 
     5659               td_var%c_point = '' 
     5660 
     5661         END SELECT 
     5662 
    51155663      ENDIF 
    51165664 
     
    52115759      !---------------------------------------------------------------- 
    52125760 
    5213       IF( td_var%i_ndim <= 4 )THEN 
     5761      IF( td_var%i_ndim <= ip_maxdim )THEN 
    52145762 
    52155763         ! check if dimension already used in variable structure 
     
    52275775         ELSE 
    52285776 
    5229          ! back to unorder dimension array  
    5230          CALL dim_unorder(td_var%t_dim(:)) 
     5777            ! back to disorder dimension array  
     5778            CALL dim_disorder(td_var%t_dim(:)) 
     5779 
    52315780            ! add new dimension 
    52325781            td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim) 
     
    52725821      !---------------------------------------------------------------- 
    52735822 
    5274       IF( td_var%i_ndim <= 4 )THEN 
     5823      IF( td_var%i_ndim <= ip_maxdim )THEN 
    52755824 
    52765825         CALL logger_trace( & 
     
    63226871   !>  
    63236872   !> @author J.Paul 
    6324    !> - November, 2013- Initial Version 
     6873   !> - November, 2013 - Initial Version 
     6874   !> @date June, 2015  
     6875   !> - new namelist format to get extra information (interpolation,...) 
    63256876   ! 
    63266877   !> @param[in] cd_file   configuration file of variable 
     
    63576908 
    63586909         il_fileid=fct_getunit() 
    6359          CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file)) 
    63606910         OPEN( il_fileid, FILE=TRIM(cd_file), & 
    63616911         &                FORM='FORMATTED',   & 
     
    63666916         CALL fct_err(il_status) 
    63676917         IF( il_status /= 0 )THEN 
    6368             CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file)) 
     6918            CALL logger_fatal("VAR DEF EXTRA: can not open file "//& 
     6919            &                 TRIM(cd_file)) 
    63696920         ENDIF 
    63706921 
     
    63756926         DO WHILE( il_status == 0 ) 
    63766927 
    6377          ! search line do not beginning with comment character 
     6928         ! search line not beginning with comment character 
    63786929            IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 
    63796930               il_nvar=il_nvar+1 
     
    64196970                  tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3)) 
    64206971                  tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4)) 
    6421                   tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,5)) 
    6422                   tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6)) 
    6423  
    6424                   cl_interp=TRIM(fct_split(cl_line,7)) 
     6972 
     6973                  cl_interp='int='//TRIM(fct_split(cl_line,5)) 
    64256974                  tg_varextra(ji)%c_interp(:) = & 
    64266975                  &  var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp) 
    64276976                  CALL logger_debug("VAR DEF EXTRA: "//& 
    64286977                  &  TRIM(tg_varextra(ji)%c_name)//& 
    6429                   &  " "//TRIM(cl_interp)) 
     6978                  &  " "//TRIM(tg_varextra(ji)%c_interp(1))) 
     6979 
     6980                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6)) 
     6981                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7)) 
    64306982               ELSE 
    64316983                  ji=ji-1 
     
    64587010   !> @details  
    64597011   !> string character format must be : <br/> 
    6460    !> "varname:interp; filter; extrap; > min; < max"<br/> 
     7012   !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/> 
    64617013   !> you could specify only interpolation, filter or extrapolation method,  
    64627014   !> whatever the order. you could find more 
     
    64647016   !> \ref extrap module.<br/> 
    64657017   !> Examples:  
    6466    !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.' 
    6467    !> cn_varinfo='votemper:cubic; dist_weight; <40.' 
     7018   !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.' 
     7019   !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.' 
     7020   !> 
     7021   !> 
     7022   !> @warning variable should be define in tg_varextra (ie in configuration 
     7023   !> file, to be able to add information from namelist 
    64687024   !> 
    64697025   !> @note If you do not specify a method which is required, default one is 
     
    64717027   !> 
    64727028   !> @author J.Paul 
    6473    !> - November, 2013- Initial Version 
     7029   !> - November, 2013 - Initial Version 
     7030   !> @date July, 2015 - get unit and unit factor (to change unit)  
    64747031   ! 
    64757032   !> @param[in] cd_varinfo   variable information from namelist 
     
    64867043      CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap 
    64877044      CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter 
     7045      CHARACTER(LEN=lc)                            :: cl_unt 
    64887046 
    64897047      INTEGER(i4)                                  :: il_ind 
     
    64927050      REAL(dp)                                     :: dl_min 
    64937051      REAL(dp)                                     :: dl_max 
     7052      REAL(dp)                                     :: dl_unf 
    64947053 
    64957054      TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra 
     
    65087067            dl_min=var__get_min(cl_name, cl_method) 
    65097068            dl_max=var__get_max(cl_name, cl_method) 
     7069            dl_unf=var__get_unf(cl_name, cl_method) 
    65107070            cl_interp(:)=var__get_interp(cl_name, cl_method) 
    65117071            cl_extrap(:)=var__get_extrap(cl_name, cl_method) 
    65127072            cl_filter(:)=var__get_filter(cl_name, cl_method) 
     7073            cl_unt=var__get_unt(cl_name, cl_method) 
     7074 
    65137075 
    65147076            il_ind=var_get_index(tg_varextra(:), TRIM(cl_name)) 
     
    65167078               IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min 
    65177079               IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max 
     7080               IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf 
     7081               IF(cl_unt      /='') tg_varextra(il_ind)%c_unt      =cl_unt 
    65187082               IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:) 
    65197083               IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:) 
     
    65517115               &                               cd_filter=cl_filter(:), & 
    65527116               &                               dd_min = dl_min, & 
    6553                &                               dd_max = dl_max ) 
     7117               &                               dd_max = dl_max, & 
     7118               &                               cd_unt = cl_unt, & 
     7119               &                               dd_unf = dl_unf ) 
    65547120 
    65557121            ENDIF 
    65567122 
    65577123            ji=ji+1 
    6558             CALL logger_trace( "VAR CHG EXTRA: name       "//& 
     7124            CALL logger_debug( "VAR CHG EXTRA: name       "//& 
    65597125            &                  TRIM(tg_varextra(il_ind)%c_name) ) 
    6560             CALL logger_trace( "VAR CHG EXTRA: interp     "//& 
     7126            CALL logger_debug( "VAR CHG EXTRA: interp     "//& 
    65617127            &                  TRIM(tg_varextra(il_ind)%c_interp(1)) )          
    6562             CALL logger_trace( "VAR CHG EXTRA: filter     "//& 
     7128            CALL logger_debug( "VAR CHG EXTRA: filter     "//& 
    65637129            &                  TRIM(tg_varextra(il_ind)%c_filter(1)) )          
    6564             CALL logger_trace( "VAR CHG EXTRA: extrap     "//& 
     7130            CALL logger_debug( "VAR CHG EXTRA: extrap     "//& 
    65657131            &                  TRIM(tg_varextra(il_ind)%c_extrap(1)) ) 
    65667132            IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN 
    6567                CALL logger_trace( "VAR CHG EXTRA: min value  "//& 
     7133               CALL logger_debug( "VAR CHG EXTRA: min value  "//& 
    65687134               &                  TRIM(fct_str(tg_varextra(il_ind)%d_min)) ) 
    65697135            ENDIF 
    65707136            IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN 
    6571                CALL logger_trace( "VAR CHG EXTRA: max value  "//& 
     7137               CALL logger_debug( "VAR CHG EXTRA: max value  "//& 
    65727138               &                  TRIM(fct_str(tg_varextra(il_ind)%d_max)) ) 
     7139            ENDIF 
     7140            IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 
     7141               CALL logger_debug( "VAR CHG EXTRA: new unit  "//& 
     7142               &                  TRIM(tg_varextra(il_ind)%c_unt) ) 
     7143            ENDIF 
     7144            IF( tg_varextra(il_ind)%d_unf /= 1. )THEN 
     7145               CALL logger_debug( "VAR CHG EXTRA: new unit factor  "//& 
     7146               &                  TRIM(fct_str(tg_varextra(il_ind)%d_unf)) ) 
    65737147            ENDIF 
    65747148         ENDDO 
     
    68087382            ENDIF 
    68097383 
    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))) 
     7384            ! unt 
     7385            IF( TRIM(td_var%c_unt) == '' .AND. & 
     7386            &   TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN 
     7387               td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt) 
     7388            ENDIF 
     7389 
     7390            ! units factor 
     7391            IF( td_var%d_unf == 1._dp .AND. & 
     7392            &   tg_varextra(il_ind)%d_unf /= 1._dp )THEN 
     7393               td_var%d_unf=tg_varextra(il_ind)%d_unf 
     7394            ENDIF 
     7395 
    68197396         ENDIF 
    68207397 
     
    68337410   !>  
    68347411   !> @details 
    6835    !> minimum value is assume to follow sign '>' 
     7412   !> minimum value is assume to follow string "min =" 
    68367413   !> 
    68377414   !> @author J.Paul 
    6838    !> - November, 2013- Initial Version 
     7415   !> - November, 2013 - Initial Version 
     7416   !> @date June, 2015 - change way to get information in namelist,  
     7417   !> value follows string "min =" 
    68397418   ! 
    68407419   !> @param[in] cd_name      variable name 
     
    68677446      cl_tmp=fct_split(cd_varinfo,ji,';') 
    68687447      DO WHILE( TRIM(cl_tmp) /= '' ) 
    6869          il_ind=SCAN(TRIM(cl_tmp),'>') 
     7448         il_ind=INDEX(TRIM(cl_tmp),'min') 
    68707449         IF( il_ind /= 0 )THEN 
    6871             cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 
     7450            cl_min=fct_split(cl_tmp,2,'=') 
    68727451            EXIT 
    68737452         ENDIF 
     
    68777456 
    68787457      IF( TRIM(cl_min) /= '' )THEN 
    6879          IF( fct_is_num(cl_min) )THEN 
     7458         IF( fct_is_real(cl_min) )THEN 
    68807459            READ(cl_min,*) var__get_min 
    68817460            CALL logger_debug("VAR GET MIN: will use minimum value of "//& 
     
    68947473   !>  
    68957474   !> @details 
    6896    !> maximum value is assume to follow sign '<' 
     7475   !> maximum value is assume to follow string "max =" 
    68977476   !> 
    68987477   !> @author J.Paul 
    6899    !> - November, 2013- Initial Version 
     7478   !> - November, 2013 - Initial Version 
     7479   !> @date June, 2015 - change way to get information in namelist,  
     7480   !> value follows string "max =" 
    69007481   ! 
    69017482   !> @param[in] cd_name      variable name 
     
    69287509      cl_tmp=fct_split(cd_varinfo,ji,';') 
    69297510      DO WHILE( TRIM(cl_tmp) /= '' ) 
    6930          il_ind=SCAN(TRIM(cl_tmp),'<') 
     7511         il_ind=INDEX(TRIM(cl_tmp),'max') 
    69317512         IF( il_ind /= 0 )THEN 
    6932             cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:))) 
     7513            cl_max=fct_split(cl_tmp,2,'=') 
    69337514            EXIT 
    69347515         ENDIF 
     
    69387519 
    69397520      IF( TRIM(cl_max) /= '' )THEN 
    6940          IF( fct_is_num(cl_max) )THEN 
     7521         IF( fct_is_real(cl_max) )THEN 
    69417522            READ(cl_max,*) var__get_max 
    69427523            CALL logger_debug("VAR GET MAX: will use maximum value of "//& 
     
    69527533   !> @brief 
    69537534   !> This function check if variable information read in namelist contains  
     7535   !> units factor value and return it if true.  
     7536   !>  
     7537   !> @details 
     7538   !> units factor value is assume to follow string "unf =" 
     7539   !> 
     7540   !> @author J.Paul 
     7541   !> - June, 2015- Initial Version 
     7542   ! 
     7543   !> @param[in] cd_name      variable name 
     7544   !> @param[in] cd_varinfo   variable information read in namelist  
     7545   !> @return untis factor value to be used (FillValue if none) 
     7546   !------------------------------------------------------------------- 
     7547   FUNCTION var__get_unf( cd_name, cd_varinfo ) 
     7548      IMPLICIT NONE 
     7549      ! Argument 
     7550      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name 
     7551      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo 
     7552 
     7553      ! function 
     7554      REAL(dp) :: var__get_unf 
     7555 
     7556      ! local variable 
     7557      CHARACTER(LEN=lc) :: cl_tmp 
     7558      CHARACTER(LEN=lc) :: cl_unf 
     7559       
     7560      INTEGER(i4)       :: il_ind 
     7561 
     7562      REAL(dp)          :: rl_unf 
     7563 
     7564      ! loop indices 
     7565      INTEGER(i4) :: ji 
     7566      !---------------------------------------------------------------- 
     7567      ! init 
     7568      cl_unf='' 
     7569      var__get_unf=dp_fill 
     7570 
     7571      ji=1 
     7572      cl_tmp=fct_split(cd_varinfo,ji,';') 
     7573      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7574         il_ind=INDEX(TRIM(cl_tmp),'unf') 
     7575         IF( il_ind /= 0 )THEN 
     7576            cl_unf=fct_split(cl_tmp,2,'=') 
     7577            EXIT 
     7578         ENDIF 
     7579         ji=ji+1 
     7580         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7581      ENDDO 
     7582 
     7583      IF( TRIM(cl_unf) /= '' )THEN 
     7584         rl_unf=math_compute(cl_unf) 
     7585         IF( rl_unf /= dp_fill )THEN 
     7586            var__get_unf = rl_unf 
     7587            CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//& 
     7588               &  "value of "//TRIM(fct_str(var__get_unf))//" for variable "//& 
     7589               &   TRIM(cd_name) ) 
     7590         ELSE 
     7591            CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//& 
     7592               &  "value for variable "//TRIM(cd_name)//". check namelist." ) 
     7593         ENDIF 
     7594      ENDIF 
     7595 
     7596   END FUNCTION var__get_unf 
     7597   !------------------------------------------------------------------- 
     7598   !> @brief 
     7599   !> This function check if variable information read in namelist contains  
    69547600   !> interpolation method and return it if true.  
    69557601   !>  
    69567602   !> @details  
    6957    !> split namelist information, using ';' as separator. 
     7603   !> interpolation method is assume to follow string "int =" 
     7604   !> 
    69587605   !> compare method name with the list of interpolation method available (see 
    69597606   !> module global). 
    69607607   !> check if factor (*rhoi, /rhoj..) are present.<br/> 
    69617608   !> Example:<br/>  
    6962    !> - cubic/rhoi ; dist_weight 
    6963    !> - bilin 
     7609   !> - int=cubic/rhoi ; ext=dist_weight 
     7610   !> - int=bilin 
    69647611   !> see @ref interp module for more information. 
    69657612   !> 
    69667613   !> @author J.Paul 
    6967    !> - November, 2013- Initial Version 
     7614   !> - November, 2013 - Initial Version 
     7615   !> @date June, 2015 - change way to get information in namelist,  
     7616   !> value follows string "int =" 
    69687617   ! 
    69697618   !> @param[in] cd_name      variable name 
     
    69827631      ! local variable 
    69837632      CHARACTER(LEN=lc) :: cl_tmp 
     7633      CHARACTER(LEN=lc) :: cl_int 
    69847634      CHARACTER(LEN=lc) :: cl_factor 
    69857635       
     
    70007650      cl_tmp=fct_split(cd_varinfo,ji,';') 
    70017651      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7652         il_ind=INDEX(TRIM(cl_tmp),'int') 
     7653         IF( il_ind /= 0 )THEN 
     7654            cl_int=fct_split(cl_tmp,2,'=') 
     7655            EXIT 
     7656         ENDIF 
     7657         ji=ji+1 
     7658         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7659      ENDDO 
     7660 
     7661      IF( TRIM(cl_int) /= '' )THEN 
    70027662         DO jj=1,ip_ninterp 
    7003             il_ind= INDEX(fct_lower(cl_tmp),TRIM(cp_interp_list(jj))) 
     7663            il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj))) 
    70047664            IF( il_ind /= 0 )THEN 
    70057665 
     
    70097669               ! look for factor 
    70107670               IF( il_ind==1 )THEN 
    7011                   cl_factor=cl_tmp(il_len+1:) 
     7671                  cl_factor=cl_int(il_len+1:) 
    70127672               ELSE 
    7013                   cl_factor=cl_tmp(1:il_ind-1) 
     7673                  cl_factor=cl_int(1:il_ind-1) 
    70147674               ENDIF 
    70157675               il_mul=SCAN(TRIM(cl_factor),'*') 
     
    70527712            ENDIF 
    70537713         ENDDO 
    7054          IF( jj /= ip_ninterp + 1 ) EXIT 
    7055          ji=ji+1 
    7056          cl_tmp=fct_split(cd_varinfo,ji,';')          
    7057       ENDDO 
     7714      ENDIF 
    70587715 
    70597716   END FUNCTION var__get_interp 
     
    70647721   !>  
    70657722   !> @details  
    7066    !> split namelist information, using ';' as separator. 
     7723   !> extrapolation method is assume to follow string "ext =" 
     7724   !>  
    70677725   !> compare method name with the list of extrapolation method available (see 
    70687726   !> module global).<br/> 
    70697727   !> Example:<br/> 
    7070    !> - cubic ; dist_weight 
    7071    !> - min_error 
     7728   !> - int=cubic ; ext=dist_weight 
     7729   !> - ext=min_error 
    70727730   !> see @ref extrap module for more information. 
    70737731   !> 
    70747732   !> @author J.Paul 
    7075    !> - November, 2013- Initial Version 
     7733   !> - November, 2013 - Initial Version 
     7734   !> @date June, 2015 - change way to get information in namelist,  
     7735   !> value follows string "ext =" 
    70767736   ! 
    70777737   !> @param[in] cd_name      variable name 
     
    70907750      ! local variable 
    70917751      CHARACTER(LEN=lc) :: cl_tmp 
     7752      CHARACTER(LEN=lc) :: cl_ext 
     7753 
     7754      INTEGER(i4)       :: il_ind 
    70927755 
    70937756      ! loop indices 
     
    71017764      cl_tmp=fct_split(cd_varinfo,ji,';') 
    71027765      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7766         il_ind=INDEX(TRIM(cl_tmp),'ext') 
     7767         IF( il_ind /= 0 )THEN 
     7768            cl_ext=fct_split(cl_tmp,2,'=') 
     7769            EXIT 
     7770         ENDIF 
     7771         ji=ji+1 
     7772         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7773      ENDDO 
     7774 
     7775      IF( TRIM(cl_ext) /= '' )THEN 
    71037776         DO jj=1,ip_nextrap 
    7104             IF( TRIM(fct_lower(cl_tmp)) == TRIM(cp_extrap_list(jj)) )THEN 
     7777            IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN 
    71057778               var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 
    71067779 
     
    71117784            ENDIF 
    71127785         ENDDO 
    7113          IF( jj /= ip_nextrap + 1 ) EXIT 
    7114          ji=ji+1 
    7115          cl_tmp=fct_split(cd_varinfo,ji,';')          
    7116       ENDDO 
     7786      ENDIF 
    71177787 
    71187788 
     
    71247794   !>  
    71257795   !> @details  
    7126    !> split namelist information, using ';' as separator. 
     7796   !> filter method is assume to follow string "flt =" 
     7797   !> 
    71277798   !> compare method name with the list of filter method available (see 
    71287799   !> module global). 
    7129    !> look for the number of turn, using '*' separator, and method parameters inside 
     7800   !> look for the number of run, using '*' separator, and method parameters inside 
    71307801   !> bracket.<br/> 
    71317802   !> Example:<br/> 
    7132    !> - cubic ; 2*hamming(2,3) 
    7133    !> - hann 
     7803   !> - int=cubic ; flt=2*hamming(2,3) 
     7804   !> - flt=hann 
    71347805   !> see @ref filter module for more information. 
    71357806   !> 
    71367807   !> @author J.Paul 
    7137    !> - November, 2013- Initial Version 
    7138    ! 
     7808   !> - November, 2013 - Initial Version 
     7809   !> @date June, 2015 - change way to get information in namelist,  
     7810   !> value follows string "flt =" 
     7811   !> 
    71397812   !> @param[in] cd_name      variable name 
    71407813   !> @param[in] cd_varinfo   variable information read in namelist  
     
    71517824      ! local variable 
    71527825      CHARACTER(LEN=lc) :: cl_tmp 
     7826      CHARACTER(LEN=lc) :: cl_flt 
    71537827      INTEGER(i4)       :: il_ind 
    71547828 
     
    71637837      cl_tmp=fct_split(cd_varinfo,ji,';') 
    71647838      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7839         il_ind=INDEX(TRIM(cl_tmp),'flt') 
     7840         IF( il_ind /= 0 )THEN 
     7841            cl_flt=fct_split(cl_tmp,2,'=') 
     7842            EXIT 
     7843         ENDIF 
     7844         ji=ji+1 
     7845         cl_tmp=fct_split(cd_varinfo,ji,';')          
     7846      ENDDO 
     7847       
     7848      IF( TRIM(cl_flt) /= '' )THEN 
    71657849         DO jj=1,ip_nfilter 
    7166             il_ind=INDEX(fct_lower(cl_tmp),TRIM(cp_filter_list(jj))) 
     7850            il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj))) 
    71677851            IF( il_ind /= 0 )THEN 
    71687852               var__get_filter(1)=TRIM(cp_filter_list(jj)) 
    71697853 
    7170                ! look for number of turn 
    7171                il_ind=SCAN(fct_lower(cl_tmp),'*') 
     7854               ! look for number of run 
     7855               il_ind=SCAN(fct_lower(cl_flt),'*') 
    71727856               IF( il_ind /=0 )THEN 
    7173                   IF( fct_is_num(cl_tmp(1:il_ind-1)) )THEN 
    7174                      var__get_filter(2)=TRIM(cl_tmp(1:il_ind-1)) 
    7175                   ELSE IF( fct_is_num(cl_tmp(il_ind+1:)) )THEN 
    7176                      var__get_filter(2)=TRIM(cl_tmp(il_ind+1:)) 
     7857                  IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN 
     7858                     var__get_filter(2)=TRIM(cl_flt(1:il_ind-1)) 
     7859                  ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN 
     7860                     var__get_filter(2)=TRIM(cl_flt(il_ind+1:)) 
    71777861                  ELSE 
    71787862                     var__get_filter(2)='1' 
     
    71837867 
    71847868               ! look for filter parameter 
    7185                il_ind=SCAN(fct_lower(cl_tmp),'(') 
     7869               il_ind=SCAN(fct_lower(cl_flt),'(') 
    71867870               IF( il_ind /=0 )THEN 
    7187                   cl_tmp=TRIM(cl_tmp(il_ind+1:)) 
    7188                   il_ind=SCAN(fct_lower(cl_tmp),')') 
     7871                  cl_flt=TRIM(cl_flt(il_ind+1:)) 
     7872                  il_ind=SCAN(fct_lower(cl_flt),')') 
    71897873                  IF( il_ind /=0 )THEN 
    7190                      cl_tmp=TRIM(cl_tmp(1:il_ind-1)) 
     7874                     cl_flt=TRIM(cl_flt(1:il_ind-1)) 
    71917875                     ! look for cut-off frequency 
    7192                      var__get_filter(3)=fct_split(cl_tmp,1,',') 
     7876                     var__get_filter(3)=fct_split(cl_flt,1,',') 
    71937877                     ! look for halo size 
    7194                      var__get_filter(4)=fct_split(cl_tmp,2,',') 
     7878                     var__get_filter(4)=fct_split(cl_flt,2,',') 
    71957879                     ! look for alpha parameter 
    7196                      var__get_filter(5)=fct_split(cl_tmp,3,',') 
     7880                     var__get_filter(5)=fct_split(cl_flt,3,',') 
    71977881                  ELSE 
    71987882                     CALL logger_error("VAR GET FILTER: variable "//& 
     
    72157899            ENDIF 
    72167900         ENDDO 
    7217          IF( jj /= ip_nfilter + 1 ) EXIT 
     7901      ENDIF 
     7902 
     7903   END FUNCTION var__get_filter 
     7904   !------------------------------------------------------------------- 
     7905   !> @brief 
     7906   !> This function check if variable information read in namelist contains  
     7907   !> unit and return it if true.  
     7908   !>  
     7909   !> @details  
     7910   !> unit is assume to follow string "unt =" 
     7911   !> 
     7912   !> @author J.Paul 
     7913   !> - June, 2015- Initial Version 
     7914   ! 
     7915   !> @param[in] cd_name      variable name 
     7916   !> @param[in] cd_varinfo   variable information read in namelist 
     7917   !> @return unit string character  
     7918   !------------------------------------------------------------------- 
     7919   FUNCTION var__get_unt( cd_name, cd_varinfo ) 
     7920      IMPLICIT NONE 
     7921      ! Argument 
     7922      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name 
     7923      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo 
     7924 
     7925      ! function 
     7926      CHARACTER(LEN=lc)               :: var__get_unt 
     7927 
     7928      ! local variable 
     7929      CHARACTER(LEN=lc) :: cl_tmp 
     7930       
     7931      INTEGER(i4)       :: il_ind 
     7932 
     7933      ! loop indices 
     7934      INTEGER(i4) :: ji 
     7935      !---------------------------------------------------------------- 
     7936 
     7937      var__get_unt='' 
     7938 
     7939      ji=1 
     7940      cl_tmp=fct_split(cd_varinfo,ji,';') 
     7941      DO WHILE( TRIM(cl_tmp) /= '' ) 
     7942         il_ind=INDEX(TRIM(cl_tmp),'unt') 
     7943         IF( il_ind /= 0 )THEN 
     7944            var__get_unt=fct_split(cl_tmp,2,'=') 
     7945            EXIT 
     7946         ENDIF 
    72187947         ji=ji+1 
    72197948         cl_tmp=fct_split(cd_varinfo,ji,';')          
    72207949      ENDDO 
    72217950 
    7222    END FUNCTION var__get_filter 
     7951      IF( TRIM(var__get_unt) /= '' )THEN 
     7952         CALL logger_debug("VAR GET UNIT: will use units "//& 
     7953            &  TRIM(var__get_unt)//" for variable "//& 
     7954            &  TRIM(cd_name) ) 
     7955      ENDIF 
     7956 
     7957   END FUNCTION var__get_unt 
    72237958   !------------------------------------------------------------------- 
    72247959   !> @brief  
     
    73198054 
    73208055   END SUBROUTINE var_limit_value 
     8056   !------------------------------------------------------------------- 
     8057   !> @brief 
     8058   !> This subroutine replace unit name of the variable, 
     8059   !> and apply unit factor to the value of this variable. 
     8060   !>  
     8061   !> @details 
     8062   !> new unit name (unt) and unit factor (unf) are read from the namelist. 
     8063   !> 
     8064   !> @note the variable value should be already read. 
     8065   !> 
     8066   !> @author J.Paul 
     8067   !> - June, 2015- Initial Version 
     8068   ! 
     8069   !> @param[inout] td_var variable structure 
     8070   !------------------------------------------------------------------- 
     8071   SUBROUTINE var_chg_unit( td_var ) 
     8072      IMPLICIT NONE 
     8073      ! Argument 
     8074      TYPE(TVAR), INTENT(INOUT) :: td_var 
     8075 
     8076      ! local variable 
     8077      TYPE(TATT)                :: tl_att 
     8078 
     8079      ! loop indices 
     8080      !---------------------------------------------------------------- 
     8081 
     8082      IF( ASSOCIATED(td_var%d_value) )THEN 
     8083         !- change value 
     8084         IF( td_var%d_unf /= 1._dp )THEN 
     8085            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
     8086               td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf 
     8087            END WHERE 
     8088 
     8089            !- change scale factor and offset to avoid mistake 
     8090            tl_att=att_init('scale_factor',1) 
     8091            CALL var_move_att(td_var, tl_att) 
     8092 
     8093            tl_att=att_init('add_offset',0) 
     8094            CALL var_move_att(td_var, tl_att) 
     8095         ENDIF 
     8096 
     8097         !- change unit name  
     8098         IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. & 
     8099         &   TRIM(td_var%c_unt) /= '' )THEN 
     8100            tl_att=att_init('units',TRIM(td_var%c_unt)) 
     8101            CALL var_move_att(td_var,tl_att) 
     8102         ENDIF 
     8103 
     8104      ENDIF 
     8105 
     8106   END SUBROUTINE var_chg_unit 
    73218107   !------------------------------------------------------------------- 
    73228108   !> @brief 
     
    74148200   !>  
    74158201   !> @author J.Paul 
    7416    !> - August, 2014- Initial Version 
     8202   !> - August, 2014 - Initial Version 
     8203   !> @date July 2015 - do not use dim_disorder anymore 
    74178204   ! 
    74188205   !> @param[inout] td_var       variable structure 
     
    74388225      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 
    74398226 
     8227      CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//& 
     8228         &  " new dimension order "//TRIM(cl_dimorder)) 
     8229 
    74408230      tl_dim(:)=dim_copy(td_var%t_dim(:)) 
    74418231 
    7442       CALL dim_unorder(tl_dim(:)) 
    74438232      CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 
    74448233 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/vgrid.f90

    r5037 r5608  
    7070!> @date Spetember, 2014 
    7171!> - add header 
     72!> @date June, 2015 - update subroutine with NEMO 3.6 
    7273!> 
    7374!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    139140   !------------------------------------------------------------------- 
    140141   SUBROUTINE vgrid_zgr_z( dd_gdepw, dd_gdept, dd_e3w, dd_e3t,          & 
     142   &                       dd_e3w_1d, dd_e3t_1d, & 
    141143   &                       dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,    & 
    142144   &                       dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed, & 
     
    148150      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w 
    149151      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 
    150154 
    151155      REAL(dp)              , INTENT(IN   ) :: dd_ppkth 
     
    226230         DO jk = 1, il_jpk 
    227231            dl_zw = REAL(jk,dp) 
    228             dl_zt = REAL(jk,dp) + 0.5 
     232            dl_zt = REAL(jk,dp) + 0.5_dp 
    229233            dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1 
    230234            dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1 
     
    237241         DO jk = 1, il_jpk 
    238242            dl_zw = REAL( jk,dp) 
    239             dl_zt = REAL( jk,dp) + 0.5 
     243            dl_zt = REAL( jk,dp) + 0.5_dp 
    240244            dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + & 
    241245            &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + & 
     
    255259      ENDIF 
    256260 
     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 
    257274      ! Control and  print 
    258275      ! ================== 
     
    260277      DO jk = 1, il_jpk 
    261278         IF( dd_e3w(jk)  <= 0. .OR. dd_e3t(jk)  <= 0. )then 
    262             CALL logger_debug("VGRID ZGR Z: e3w or e3t =< 0 ") 
     279            CALL logger_debug("VGRID ZGR Z: e3w or e3t <= 0 ") 
    263280         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 
    264285 
    265286         IF( dd_gdepw(jk) < 0. .OR. dd_gdept(jk) < 0. )then 
     
    269290 
    270291   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 
    271331   !------------------------------------------------------------------- 
    272332   !> @brief This subroutine set the depth and vertical scale factor in partial step 
     
    327387   !------------------------------------------------------------------- 
    328388   SUBROUTINE vgrid_zgr_zps( id_mbathy, dd_bathy, id_jpkmax, & 
    329    &                         dd_gdepw, dd_e3t,               & 
    330    &                         dd_e3zps_min, dd_e3zps_rat ) 
     389   &                          dd_gdepw, dd_e3t,               & 
     390   &                          dd_e3zps_min, dd_e3zps_rat,     & 
     391   &                          dd_fill ) 
    331392      IMPLICIT NONE 
    332393      ! Argument       
     
    336397      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw 
    337398      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t 
    338       REAL(dp)                                   :: dd_e3zps_min 
    339       REAL(dp)                                   :: dd_e3zps_rat 
     399      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min 
     400      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat 
     401      REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill 
    340402 
    341403      ! local variable 
    342404      REAL(dp) :: dl_zmax     ! Maximum depth 
    343       REAL(dp) :: dl_zmin     ! Minimum depth 
     405      !REAL(dp) :: dl_zmin     ! Minimum depth 
    344406      REAL(dp) :: dl_zdepth   ! Ajusted ocean depth to avoid too small e3t  
     407      REAL(dp) :: dl_fill      
    345408 
    346409      INTEGER(i4) :: il_jpk 
     
    359422      il_jpjglo=SIZE(id_mbathy(:,:),DIM=2) 
    360423 
     424      dl_fill=0._dp 
     425      IF( PRESENT(dd_fill) ) dl_fill=dd_fill 
     426 
    361427      ! Initialization of constant 
    362       dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) 
    363       dl_zmin = dd_gdepw(4) 
     428      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) ) 
     429 
     430      ! bounded value of bathy (min already set at the end of zgr_bat) 
     431      WHERE( dd_bathy(:,:) /= dl_fill ) 
     432         dd_bathy(:,:) = MIN( dl_zmax ,  dd_bathy(:,:) ) 
     433      END WHERE 
    364434 
    365435      ! bathymetry in level (from bathy_meter) 
     
    372442      DO jj = 1, il_jpjglo 
    373443         DO ji= 1, il_jpiglo 
    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 ) 
     444            IF( dd_bathy(ji,jj) <= 0._dp )THEN 
     445               id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4) 
     446            ELSEIF( dd_bathy(ji,jj) == dl_fill )THEN 
     447               id_mbathy(ji,jj) = 0_i4 
    389448            ENDIF 
    390449         END DO 
     
    401460         DO jj = 1, il_jpjglo 
    402461            DO ji = 1, il_jpiglo 
    403                IF( 0. < dd_bathy(ji,jj) .AND. dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1 
     462               IF( dd_bathy(ji,jj) /= dl_fill )THEN 
     463                  IF( 0. < dd_bathy(ji,jj) .AND. & 
     464                  &       dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1 
     465               ENDIF 
    404466            END DO 
    405467         END DO 
     
    567629      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w  
    568630      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t 
     631      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w_1d  
     632      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t_1d 
    569633 
    570634      INTEGER(i4)                                  :: il_status 
     
    710774      ALLOCATE( dl_gdepw(in_nlevel), dl_gdept(in_nlevel) )  
    711775      ALLOCATE(   dl_e3w(in_nlevel),   dl_e3t(in_nlevel) )  
     776      ALLOCATE(   dl_e3w_1d(in_nlevel),   dl_e3t_1d(in_nlevel) )  
    712777      CALL vgrid_zgr_z( dl_gdepw(:), dl_gdept(:), dl_e3w(:), dl_e3t(:), & 
     778      &                 dl_e3w_1d, dl_e3t_1d, & 
    713779      &                 dn_ppkth, dn_ppkth2, dn_ppacr, dn_ppacr2,       & 
    714780      &                 dn_ppdzmin, dn_pphmax, dn_pp_to_be_computed,    & 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/create_bathy.nam

    r5037 r5608  
    1919 
    2020&namvar 
     21   cn_varfile= 
    2122   cn_varinfo= 
    22    cn_varfile= 
    2323/ 
    2424 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/create_boundary.nam

    r5037 r5608  
    6060   cn_west  =  
    6161   ln_oneseg=  
    62    in_extrap=  
    6362/ 
    6463 
    6564&namout 
    6665   cn_fileout="boundary_out.nc"       
     66   dn_dayofs= 
     67   ln_extrap= 
    6768/ 
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/templates/create_restart.nam

    r5037 r5608  
    1212   cn_coord0= 
    1313   in_perio0= 
     14/ 
     15 
     16&namfin 
     17   cn_coord1= 
     18   cn_bathy1= 
     19   in_perio1= 
    1420/ 
    1521 
     
    3440/ 
    3541 
    36 &namfin 
    37    cn_coord1= 
    38    cn_bathy1= 
    39    in_perio1= 
    40    in_extrap= 
    41 / 
    42  
    4342&namvar 
    4443   cn_varinfo= 
     
    5352&namout 
    5453   cn_fileout="restart_out.nc"       
     54   ln_extrap= 
     55   in_nipro= 
     56   in_njproc= 
     57   in_nproc= 
     58   cn_type= 
    5559/ 
Note: See TracChangeset for help on using the changeset viewer.