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 5609 – NEMO

Changeset 5609


Ignore:
Timestamp:
2015-07-17T17:42:15+02:00 (8 years ago)
Author:
jpaul
Message:

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

Location:
trunk/NEMOGCM/TOOLS/SIREN
Files:
2 added
33 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/TOOLS/SIREN/src/attribute.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/boundary.f90

    r5037 r5609  
    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   ! 
  • trunk/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/create_coord.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/create_restart.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r5037 r5609  
    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         
  • trunk/NEMOGCM/TOOLS/SIREN/src/docsrc/1_install.md

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/docsrc/3_codingRules.md

    r5037 r5609  
    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} 
  • trunk/NEMOGCM/TOOLS/SIREN/src/domain.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/extrap.f90

    r5037 r5609  
    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  
  • trunk/NEMOGCM/TOOLS/SIREN/src/file.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/filter.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/function.f90

    r5037 r5609  
    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 
  • trunk/NEMOGCM/TOOLS/SIREN/src/grid.f90

    r5037 r5609  
    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