Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (5 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/boundary.f90

    r4213 r5600  
    88!> @brief 
    99!> This module manage boundary. 
    10 ! 
     10!> 
    1111!> @details 
     12!>    define type TBDY:<br/> 
     13!> @code 
     14!>    TYPE(TBDY) :: tl_bdy<br/> 
     15!> @endcode 
    1216!> 
     17!>    to initialise boundary structure:<br/> 
     18!> @code 
     19!>    tl_bdy=boundary_init(td_var, [ld_north,] [ld_south,] [ld_east,] [ld_west,] 
     20!>    [cd_north,] [cd_south,] [cd_east,] [cd_west,] [ld_oneseg]) 
     21!> @endcode 
     22!>       - td_var is variable structure 
     23!>       - ld_north is logical to force used of north boundary [optional] 
     24!>       - ld_south is logical to force used of north boundary [optional] 
     25!>       - ld_east  is logical to force used of north boundary [optional] 
     26!>       - ld_west  is logical to force used of north boundary [optional] 
     27!>       - 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] 
     31!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional] 
    1332!> 
     33!>    to get boundary cardinal:<br/> 
     34!>    - tl_bdy\%c_card 
    1435!> 
     36!>    to know if boundary is use:<br/> 
     37!>    - tl_bdy\%l_use 
    1538!> 
     39!>    to get the number of segment in boundary:<br/> 
     40!>    - tl_bdy\%i_nseg 
    1641!> 
    17 !> @author 
    18 !> J.Paul 
     42!>    to get array of segment in boundary:<br/> 
     43!>    - tl_bdy\%t_seg(:) 
     44!> 
     45!>    to get orthogonal segment index of north boundary:<br/> 
     46!>    - tl_bdy\%t_seg(jp_north)%\i_index 
     47!> 
     48!>    to get segment width of south boundary:<br/> 
     49!>    - tl_bdy\%t_seg(jp_south)%\i_width 
     50!> 
     51!>    to get segment first indice of east boundary:<br/> 
     52!>    - tl_bdy\%t_seg(jp_east)%\i_first 
     53!> 
     54!>    to get segment last indice of west boundary:<br/> 
     55!>    - tl_bdy\%t_seg(jp_west)%\i_last 
     56!> 
     57!>    to print information about boundary:<br/> 
     58!> @code 
     59!>    CALL boundary_print(td_bdy) 
     60!> @endcode 
     61!>       - td_bdy is boundary structure or a array of boundary structure 
     62!> 
     63!>    to clean boundary structure:<br/> 
     64!> @code 
     65!>    CALL boundary_clean(td_bdy) 
     66!> @endcode 
     67!> 
     68!>    to get indices of each semgent for each boundary:<br/> 
     69!> @code 
     70!>    CALL boundary_get_indices( td_bdy, td_var, ld_oneseg) 
     71!> @endcode 
     72!>       - td_bdy is boundary structure 
     73!>       - td_var is variable structure 
     74!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional] 
     75!> 
     76!>    to check boundary indices and corner:<br/> 
     77!> @code 
     78!>    CALL boundary_check(td_bdy, td_var) 
     79!> @endcode 
     80!>       - td_bdy is boundary structure 
     81!>       - td_var is variable structure 
     82!> 
     83!>    to check boundary corner:<br/> 
     84!> @code 
     85!>    CALL boundary_check_corner(td_bdy, td_var) 
     86!> @endcode 
     87!>       - td_bdy is boundary structure 
     88!>       - td_var is variable structure 
     89!> 
     90!>    to create filename with cardinal name inside:<br/> 
     91!> @code 
     92!>    cl_filename=boundary_set_filename(cd_file, cd_card) 
     93!> @endcode 
     94!>       - cd_file = original file name 
     95!>       - cd_card = cardinal name 
     96!> 
     97!>    to swap array for east and north boundary:<br/> 
     98!> @code 
     99!>    CALL boundary_swap( td_var, td_bdy ) 
     100!> @endcode 
     101!>       - td_var is variable strucutre 
     102!>       - td_bdy is boundary strucutre 
     103!> 
     104!> @author J.Paul 
    19105! REVISION HISTORY: 
    20 !> @date Nov, 2013 - Initial Version 
    21 !> @todo 
    22 !> - add description generique de l'objet boundary 
     106!> @date November, 2013 - Initial Version 
     107!> @date September, 2014 - add boundary description 
     108!> @date November, 2014 - Fix memory leaks bug 
     109!>  
     110!> @todo add schematic to boundary structure description 
    23111!>  
    24112!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    29117   USE phycst                          ! physical constant 
    30118   USE kind                            ! F90 kind parameter 
    31    USE logger                             ! log file manager 
     119   USE logger                          ! log file manager 
    32120   USE fct                             ! basic useful function 
    33 !   USE date                            ! date manager 
    34 !   USE att                             ! attribute manager 
    35 !   USE dim                             ! dimension manager 
    36121   USE var                             ! variable manager 
    37 !   USE file                            ! file manager 
    38 !   USE iom                             ! I/O manager 
    39 !   USE dom                             ! domain  manager 
    40 !   USE grid                            ! grid manager 
    41 !   USE extrap                          ! extrapolation manager 
    42 !   USE interp                          ! interpolation manager 
    43 !   USE filter                          ! filter manager 
    44 !   USE mpp                             ! MPP manager 
    45 !   USE iom_mpp                         ! MPP I/O manager 
    46122 
    47123   IMPLICIT NONE 
    48    PRIVATE 
    49124   ! NOTE_avoid_public_variables_if_possible 
    50125 
    51126   ! type and variable 
    52    PUBLIC :: ip_ncard !< number of cardinal point 
    53    PUBLIC :: ip_card  !< table of cardinal point 
    54127   PUBLIC :: TBDY     !< boundary structure 
    55128   PUBLIC :: TSEG     !< segment structure 
    56129 
     130   PRIVATE :: im_width !< boundary width 
     131 
    57132   ! function and subroutine 
     133   PUBLIC :: boundary_copy         !< copy boundary structure 
    58134   PUBLIC :: boundary_init         !< initialise boundary structure 
    59135   PUBLIC :: boundary_print        !< print information about boundary 
     
    63139   PUBLIC :: boundary_check_corner !< check boundary corner 
    64140   PUBLIC :: boundary_set_filename !< set boundary filename 
    65    PUBLIC :: boundary_clean_interp !< clean interpolated boundary 
    66141   PUBLIC :: boundary_swap         !< swap array for north and east boundary 
    67142 
    68    PRIVATE :: boundary__init_wrapper    !< initialise a boundary structure 
    69    PRIVATE :: boundary__init            !< initialise basically a boundary structure 
    70 !   PRIVATE :: boundary__copy            !< copy boundary structure in another 
    71    PRIVATE :: boundary__copy_unit       !< copy boundary structure in another 
    72    PRIVATE :: boundary__copy_tab        !< copy boundary structure in another 
    73    PRIVATE :: boundary__add_seg         !< add one segment structure to a boundary  
    74    PRIVATE :: boundary__del_seg         !< remove all segments of a boundary 
    75    PRIVATE :: boundary__get_info        !< get boundary information from boundary description string character. 
    76    PRIVATE :: boundary__get_seg_number  !< compute the number of sea segment for one boundary 
    77    PRIVATE :: boundary__get_seg_indices !< get segment indices for one boundary  
    78    PRIVATE :: boundary__print_unit      !< print information about one boundary 
    79    PRIVATE :: boundary__print_tab       !< print information about a table of boundary 
     143   PRIVATE :: boundary__clean_unit      ! clean boundary structure  
     144   PRIVATE :: boundary__clean_arr       ! clean array of boundary structure  
     145   PRIVATE :: boundary__init_wrapper    ! initialise a boundary structure 
     146   PRIVATE :: boundary__init            ! initialise basically a boundary structure 
     147   PRIVATE :: boundary__copy_unit       ! copy boundary structure in another 
     148   PRIVATE :: boundary__copy_arr        ! copy boundary structure in another 
     149   PRIVATE :: boundary__add_seg         ! add one segment structure to a boundary  
     150   PRIVATE :: boundary__del_seg         ! remove all segments of a boundary 
     151   PRIVATE :: boundary__get_info        ! get boundary information from boundary description string character. 
     152   PRIVATE :: boundary__get_seg_number  ! compute the number of sea segment for one boundary 
     153   PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary  
     154   PRIVATE :: boundary__print_unit      ! print information about one boundary 
     155   PRIVATE :: boundary__print_arr       ! print information about a array of boundary 
    80156    
    81    PRIVATE :: seg__init    !< initialise segment structure 
    82    PRIVATE :: seg__clean   !< clean segment structure 
    83    PRIVATE :: seg__copy    !< copy segment structure in another 
    84  
    85    !> @struct 
    86    TYPE TSEG    
     157   PRIVATE :: seg__init       ! initialise segment structure 
     158   PRIVATE :: seg__clean      ! clean segment structure 
     159   PRIVATE :: seg__clean_unit ! clean segment structure 
     160   PRIVATE :: seg__clean_arr  ! clean array of segment structure 
     161   PRIVATE :: seg__copy       ! copy segment structure in another 
     162   PRIVATE :: seg__copy_unit  ! copy segment structure in another 
     163   PRIVATE :: seg__copy_arr   ! copy array of segment structure in another 
     164 
     165   TYPE TSEG   !< segment structure 
    87166      INTEGER(i4) :: i_index = 0 !< segment index 
    88167      INTEGER(i4) :: i_width = 0 !< segment width 
     
    91170   END TYPE TSEG 
    92171 
    93    !> @struct 
    94    TYPE TBDY 
    95       CHARACTER(LEN=lc) :: c_card = '' 
    96       LOGICAL           :: l_use  = .FALSE. 
    97       INTEGER(i4)       :: i_nseg = 0 
    98       TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() 
     172   TYPE TBDY !< boundary structure 
     173      CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal 
     174      LOGICAL           :: l_use  = .FALSE.     !< boundary use or not  
     175      INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary 
     176      TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure 
    99177   END TYPE TBDY 
    100  
    101    INTEGER(i4), PARAMETER :: ip_ncard=4 
    102    CHARACTER(LEN=lc), DIMENSION(ip_ncard), PARAMETER :: ip_card = & 
    103    &  (/ 'north', & 
    104    &     'south', & 
    105    &     'east ', & 
    106    &     'west ' /) 
    107  
    108    INTEGER(i4), PARAMETER :: jp_north=1 
    109    INTEGER(i4), PARAMETER :: jp_south=2 
    110    INTEGER(i4), PARAMETER :: jp_east =3 
    111    INTEGER(i4), PARAMETER :: jp_west =4 
    112178 
    113179   INTEGER(i4), PARAMETER :: im_width=10 
     
    119185   INTERFACE boundary_print 
    120186      MODULE PROCEDURE boundary__print_unit  
    121       MODULE PROCEDURE boundary__print_tab  
     187      MODULE PROCEDURE boundary__print_arr  
    122188   END INTERFACE boundary_print 
    123189 
    124    INTERFACE ASSIGNMENT(=) 
     190   INTERFACE boundary_clean 
     191      MODULE PROCEDURE boundary__clean_unit    
     192      MODULE PROCEDURE boundary__clean_arr     
     193   END INTERFACE 
     194 
     195   INTERFACE seg__clean 
     196      MODULE PROCEDURE seg__clean_unit    
     197      MODULE PROCEDURE seg__clean_arr     
     198   END INTERFACE 
     199 
     200   INTERFACE boundary_copy 
    125201      MODULE PROCEDURE boundary__copy_unit  
    126       MODULE PROCEDURE boundary__copy_tab  
    127       MODULE PROCEDURE seg__copy   ! copy segment structure 
     202      MODULE PROCEDURE boundary__copy_arr  
     203   END INTERFACE    
     204 
     205   INTERFACE seg__copy 
     206      MODULE PROCEDURE seg__copy_unit   ! copy segment structure 
     207      MODULE PROCEDURE seg__copy_arr    ! copy array of segment structure 
    128208   END INTERFACE    
    129209 
     
    131211   !------------------------------------------------------------------- 
    132212   !> @brief 
    133    !> This subroutine copy boundary structure in another boundary 
    134    !> structure 
     213   !> This subroutine copy a array of boundary structure in another one 
    135214   !> @details  
    136215   !> 
     216   !> @warning do not use on the output of a function who create or read an 
     217   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden). 
     218   !> This will create memory leaks. 
    137219   !> @warning to avoid infinite loop, do not use any function inside  
    138220   !> this subroutine 
    139221   !> 
    140222   !> @author J.Paul 
    141    !> - Nov, 2013- Initial Version 
     223   !> @date November, 2013 - Initial Version 
     224   !> @date November, 2014 
     225   !>    - use function instead of overload assignment operator  
     226   !> (to avoid memory leak) 
    142227   ! 
    143    !> @param[out] td_bdy1  : boundary structure 
    144    !> @param[in] td_bdy2  : boundary structure 
     228   !> @param[in] td_bdy   array of boundary structure 
     229   !> @return copy of input array of boundary structure  
    145230   !------------------------------------------------------------------- 
    146    !> @code 
    147    SUBROUTINE boundary__copy_tab( td_bdy1, td_bdy2 ) 
     231   FUNCTION boundary__copy_arr( td_bdy ) 
    148232      IMPLICIT NONE 
    149233      ! Argument 
    150       TYPE(TBDY), DIMENSION(:), INTENT(OUT) :: td_bdy1 
    151       TYPE(TBDY), DIMENSION(:), INTENT(IN)  :: td_bdy2 
     234      TYPE(TBDY), DIMENSION(:), INTENT(IN)  :: td_bdy 
     235      ! function 
     236      TYPE(TBDY), DIMENSION(SIZE(td_bdy(:))) :: boundary__copy_arr 
    152237 
    153238      ! local variable 
     
    156241      !---------------------------------------------------------------- 
    157242 
    158       IF( SIZE(td_bdy1(:)) /= SIZE(td_bdy2(:)) )THEN 
    159          CALL logger_error("BOUNDARY COPY: dimension of table of boundary differ") 
    160       ELSE 
    161          DO jk=1,SIZE(td_bdy1(:)) 
    162             td_bdy1(jk)=td_bdy2(jk) 
    163          ENDDO 
    164       ENDIF 
    165    END SUBROUTINE boundary__copy_tab 
    166    !> @endcode 
     243      DO jk=1,SIZE(td_bdy(:)) 
     244         boundary__copy_arr(jk)=boundary_copy(td_bdy(jk)) 
     245      ENDDO 
     246 
     247   END FUNCTION boundary__copy_arr 
    167248   !------------------------------------------------------------------- 
    168249   !> @brief 
    169    !> This subroutine copy boundary structure in another boundary 
    170    !> structure 
     250   !> This subroutine copy boundary structure in another one 
    171251   !> @details  
    172252   !> 
     253   !> @warning do not use on the output of a function who create or read an 
     254   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden). 
     255   !> This will create memory leaks. 
    173256   !> @warning to avoid infinite loop, do not use any function inside  
    174257   !> this subroutine 
    175258   !> 
    176259   !> @author J.Paul 
    177    !> - Nov, 2013- Initial Version 
     260   !> @date November, 2013 - Initial Version 
     261   !> @date November, 2014 
     262   !>    - use function instead of overload assignment operator  
     263   !> (to avoid memory leak) 
    178264   ! 
    179    !> @param[out] td_bdy1  : boundary structure 
    180    !> @param[in] td_bdy2  : boundary structure 
     265   !> @param[in] td_bdy  boundary structure 
     266   !> @return copy of input boundary structure 
    181267   !------------------------------------------------------------------- 
    182    !> @code 
    183    SUBROUTINE boundary__copy_unit( td_bdy1, td_bdy2 ) 
     268   FUNCTION boundary__copy_unit( td_bdy ) 
    184269      IMPLICIT NONE 
    185270      ! Argument 
    186       TYPE(TBDY), INTENT(OUT) :: td_bdy1 
    187       TYPE(TBDY), INTENT(IN)  :: td_bdy2 
     271      TYPE(TBDY), INTENT(IN)  :: td_bdy 
     272      ! function 
     273      TYPE(TBDY) :: boundary__copy_unit 
    188274 
    189275      ! local variable 
     
    193279 
    194280      ! copy variable name, id, .. 
    195       td_bdy1%c_card     = TRIM(td_bdy2%c_card) 
    196       td_bdy1%i_nseg     = td_bdy2%i_nseg 
    197       td_bdy1%l_use      = td_bdy2%l_use 
     281      boundary__copy_unit%c_card     = TRIM(td_bdy%c_card) 
     282      boundary__copy_unit%i_nseg     = td_bdy%i_nseg 
     283      boundary__copy_unit%l_use      = td_bdy%l_use 
    198284 
    199285      ! copy segment 
    200       IF( ASSOCIATED(td_bdy1%t_seg) ) DEALLOCATE(td_bdy1%t_seg) 
    201       IF( ASSOCIATED(td_bdy2%t_seg) .AND. td_bdy1%i_nseg > 0 )THEN 
    202          ALLOCATE( td_bdy1%t_seg(td_bdy1%i_nseg) ) 
    203          DO ji=1,td_bdy1%i_nseg 
    204             td_bdy1%t_seg(ji)=td_bdy2%t_seg(ji) 
     286      IF( ASSOCIATED(boundary__copy_unit%t_seg) )THEN 
     287         CALL seg__clean(boundary__copy_unit%t_seg(:)) 
     288         DEALLOCATE(boundary__copy_unit%t_seg) 
     289      ENDIF 
     290      IF( ASSOCIATED(td_bdy%t_seg) .AND. boundary__copy_unit%i_nseg > 0 )THEN 
     291         ALLOCATE( boundary__copy_unit%t_seg(boundary__copy_unit%i_nseg) ) 
     292         DO ji=1,boundary__copy_unit%i_nseg 
     293            boundary__copy_unit%t_seg(ji)=td_bdy%t_seg(ji) 
    205294         ENDDO 
    206295      ENDIF 
    207296 
    208    END SUBROUTINE boundary__copy_unit 
    209    !> @endcode 
     297   END FUNCTION boundary__copy_unit 
    210298   !------------------------------------------------------------------- 
    211299   !> @brief This subroutine clean boundary structure 
    212300   ! 
    213301   !> @author J.Paul 
    214    !> - Nov, 2013- Initial Version 
     302   !> @date November, 2013 - Initial Version 
    215303   ! 
    216    !> @param[inout] td_bdy : boundary strucutre 
     304   !> @param[inout] td_bdy boundary strucutre 
    217305   !------------------------------------------------------------------- 
    218    !> @code 
    219    SUBROUTINE boundary_clean( td_bdy ) 
     306   SUBROUTINE boundary__clean_unit( td_bdy ) 
    220307      IMPLICIT NONE 
    221308      ! Argument 
     
    226313 
    227314      ! loop indices 
     315      !---------------------------------------------------------------- 
     316 
     317      CALL logger_info( & 
     318      &  " CLEAN: reset boundary "//TRIM(td_bdy%c_card) ) 
     319 
     320      ! del segment 
     321      IF( ASSOCIATED(td_bdy%t_seg) )THEN 
     322         ! clean each segment 
     323         CALL seg__clean(td_bdy%t_seg(:) ) 
     324         DEALLOCATE( td_bdy%t_seg ) 
     325      ENDIF 
     326 
     327      ! replace by empty structure 
     328      td_bdy=boundary_copy(tl_bdy) 
     329 
     330   END SUBROUTINE boundary__clean_unit 
     331   !------------------------------------------------------------------- 
     332   !> @brief This subroutine clean array of boundary structure 
     333   ! 
     334   !> @author J.Paul 
     335   !> @date September, 2014 - Initial Version 
     336   ! 
     337   !> @param[inout] td_bdy boundary strucutre 
     338   !------------------------------------------------------------------- 
     339   SUBROUTINE boundary__clean_arr( td_bdy ) 
     340      IMPLICIT NONE 
     341      ! Argument 
     342      TYPE(TBDY), DIMENSION(:), INTENT(INOUT) :: td_bdy 
     343 
     344      ! local variable 
     345      ! loop indices 
    228346      INTEGER(i4) :: ji 
    229347      !---------------------------------------------------------------- 
    230348 
    231       CALL logger_info( & 
    232       &  " CLEAN: reset boundary "//TRIM(td_bdy%c_card) ) 
    233  
    234       ! del segment 
    235       IF( ASSOCIATED(td_bdy%t_seg) )THEN 
    236          ! clean each attribute 
    237          DO ji=td_bdy%i_nseg,1,-1 
    238             CALL seg__clean(td_bdy%t_seg(ji) ) 
    239          ENDDO 
    240          DEALLOCATE( td_bdy%t_seg ) 
    241       ENDIF 
    242  
    243       ! replace by empty structure 
    244       td_bdy=tl_bdy 
    245  
    246    END SUBROUTINE boundary_clean 
    247    !> @endcode 
    248    !-------------------------------------------------------------------  
    249    !> @brief This function put cardinal name inside file name   
     349      DO ji=SIZE(td_bdy(:)),1,-1 
     350         CALL boundary_clean( td_bdy(ji) ) 
     351      ENDDO 
     352 
     353   END SUBROUTINE boundary__clean_arr 
     354   !-------------------------------------------------------------------  
     355   !> @brief This function put cardinal name inside file name. 
    250356   !  
    251357   !> @details  
    252358   !  
    253359   !> @author J.Paul  
    254    !> - Nov, 2013- Initial Version  
    255    !  
    256    !> @param[in] cd_file : file name  
    257    !> @param[in] cd_card : cardinal name  
     360   !> @date November, 2013 - Initial Version  
     361   !  
     362   !> @param[in] cd_file   file name  
     363   !> @param[in] cd_card   cardinal name  
     364   !> @param[in] id_seg    segment number  
     365   !> @param[in] cd_date   file date (format: y????m??d??)  
    258366   !> @return file name with cardinal name inside 
    259367   !-------------------------------------------------------------------  
    260    !> @code  
    261    FUNCTION boundary_set_filename(cd_file, cd_card)  
     368   FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date)  
    262369      IMPLICIT NONE  
    263370      ! Argument 
    264371      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
    265372      CHARACTER(LEN=*), INTENT(IN) :: cd_card 
     373      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_seg 
     374      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date 
    266375 
    267376      ! function  
     
    273382      CHARACTER(LEN=lc) :: cl_base 
    274383      CHARACTER(LEN=lc) :: cl_suffix 
     384      CHARACTER(LEN=lc) :: cl_segnum 
     385      CHARACTER(LEN=lc) :: cl_date 
    275386      CHARACTER(LEN=lc) :: cl_name 
    276387      ! loop indices  
     
    288399         cl_base  =fct_split(TRIM(cl_basename),1,'.') 
    289400         cl_suffix=fct_split(TRIM(cl_basename),2,'.') 
    290  
    291          cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//"."//TRIM(cl_suffix) 
     401          
     402         IF( PRESENT(id_seg) )THEN 
     403            cl_segnum="_"//TRIM(fct_str(id_seg))//"_" 
     404         ELSE 
     405            cl_segnum="" 
     406         ENDIF 
     407 
     408         IF( PRESENT(cd_date) )THEN 
     409            cl_date=TRIM(ADJUSTL(cd_date)) 
     410         ELSE 
     411            cl_date="" 
     412         ENDIF 
     413 
     414         cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 
     415         &        TRIM(cl_date)//"."//TRIM(cl_suffix) 
    292416 
    293417         boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) 
     
    298422  
    299423   END FUNCTION boundary_set_filename  
    300    !> @endcode 
    301    !-------------------------------------------------------------------  
    302    !> @brief This function initialise a boundary structure  
     424   !-------------------------------------------------------------------  
     425   !> @brief This function initialise a boundary structure. 
    303426   !  
    304427   !> @details  
     
    318441   !> specify it for each segment. 
    319442   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 
    320    !  
     443   !> 
     444   !> @note boundaries are compute on T point. change will be done to get data 
     445   !> on other point when need be.  
     446   !> 
    321447   !> @author J.Paul  
    322    !> - Nov, 2013- Initial Version  
    323    !  
    324    !> @param[in] td_var : variable structure  
    325    !> @param[in] ld_north : use north boundary or not  
    326    !> @param[in] ld_south : use south boundary or not  
    327    !> @param[in] ld_east  : use east  boundary or not  
    328    !> @param[in] ld_west  : use west  boundary or not  
    329    !> @param[in] cd_north : north boundary description  
    330    !> @param[in] cd_south : south boundary description  
    331    !> @param[in] cd_east  : east  boundary description  
    332    !> @param[in] cd_west  : west  boundary description  
     448   !> @date November, 2013 - Initial Version  
     449   !> @date September, 2014 
     450   !> - add boolean to use only one segment for each boundary 
     451   !> - check boundary width 
     452   !  
     453   !> @param[in] td_var    variable structure  
     454   !> @param[in] ld_north  use north boundary or not  
     455   !> @param[in] ld_south  use south boundary or not  
     456   !> @param[in] ld_east   use east  boundary or not  
     457   !> @param[in] ld_west   use west  boundary or not  
     458   !> @param[in] cd_north  north boundary description  
     459   !> @param[in] cd_south  south boundary description  
     460   !> @param[in] cd_east   east  boundary description  
     461   !> @param[in] cd_west   west  boundary description  
     462   !> @param[in] ld_oneseg force to use only one segment for each boundary  
    333463   !> @return boundary structure 
    334    !> @todo use bondary_get_indices !!!! 
    335    !-------------------------------------------------------------------  
    336    !> @code  
     464   !-------------------------------------------------------------------  
    337465   FUNCTION boundary__init_wrapper(td_var, & 
    338466   &                               ld_north, ld_south, ld_east, ld_west, & 
     
    356484 
    357485      ! local variable  
     486      INTEGER(i4)                            :: il_width 
     487      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max_width 
    358488      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_index 
    359489      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_min 
     
    390520         tl_bdy(jp_west )=boundary__init('west ',ld_west ) 
    391521 
    392          ! if EW cyclic no east west boundary 
     522         ! if EW cyclic no east west boundary and force to use one segment 
    393523         IF( td_var%i_ew >= 0 )THEN 
    394             CALL logger_debug("BOUNDARY INIT: cyclic no East West boundary") 
     524            CALL logger_info("BOUNDARY INIT: cyclic domain, "//& 
     525            &  "no East West boundary") 
    395526            tl_bdy(jp_east )%l_use=.FALSE. 
    396527            tl_bdy(jp_west )%l_use=.FALSE. 
     528 
     529            CALL logger_info("BOUNDARY INIT: force to use one segment due"//& 
     530            &  " to EW cyclic domain") 
     531            ll_oneseg=.TRUE. 
    397532         ENDIF 
    398533 
    399          ! attention cas U /= T ??? 
    400          il_index(jp_north)=td_var%t_dim(2)%i_len-ig_ghost 
    401          il_index(jp_south)=1+ig_ghost 
    402          il_index(jp_east )=td_var%t_dim(1)%i_len-ig_ghost 
    403          il_index(jp_west )=1+ig_ghost 
     534         il_index(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 
     535         il_index(jp_south)=1+ip_ghost 
     536         il_index(jp_east )=td_var%t_dim(1)%i_len-ip_ghost 
     537         il_index(jp_west )=1+ip_ghost 
    404538 
    405539         il_min(jp_north)=1 
     
    419553         IF( PRESENT(cd_west ) ) cl_card(jp_west )=TRIM(cd_west ) 
    420554 
     555         il_max_width(jp_north)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost)) 
     556         il_max_width(jp_south)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost)) 
     557         il_max_width(jp_east )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost)) 
     558         il_max_width(jp_west )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost)) 
     559 
    421560         DO jk=1,ip_ncard 
    422561 
     562            ! check boundary width 
     563            IF( il_max_width(jk) <= im_width )THEN 
     564               IF( il_max_width(jk) <= 0 )THEN 
     565                  CALL logger_fatal("BOUNDARY INIT: domain too small to define"//& 
     566                  &                " boundaries.") 
     567               ELSE 
     568                  CALL logger_warn("BOUNDARY INIT: default boundary width too "//& 
     569                  &                "large for boundaries. force to use boundary"//& 
     570                  &                " on one point") 
     571                  il_width=1 
     572               ENDIF 
     573            ELSE 
     574               il_width=im_width 
     575            ENDIF 
     576 
    423577            ! define default segment 
    424             tl_seg=seg__init(il_index(jk),im_width,il_min(jk),il_max(jk)) 
     578            tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk)) 
    425579 
    426580            IF( tl_bdy(jk)%l_use )THEN 
     
    453607 
    454608            ENDIF 
     609            ! clean 
     610            CALL seg__clean(tl_seg) 
    455611 
    456612         ENDDO 
     
    460616         CALL boundary_check(tl_bdy, td_var) 
    461617 
    462          boundary__init_wrapper(:)=tl_bdy(:) 
     618         boundary__init_wrapper(:)=boundary_copy(tl_bdy(:)) 
    463619 
    464620         ! clean 
     
    470626  
    471627   END FUNCTION boundary__init_wrapper  
    472    !> @endcode  
    473628   !-------------------------------------------------------------------  
    474629   !> @brief This function initialise basically a boundary structure with 
     
    480635   !  
    481636   !> @author J.Paul  
    482    !> - Nov, 2013- Initial Version  
    483    !  
    484    !> @param[in]  cd_card : cardinal name 
    485    !> @param[in]  ld_use  : boundary use or not 
    486    !> @param[in]  td_seg  : segment structure 
     637   !> @date November, 2013 - Initial Version  
     638   !  
     639   !> @param[in]  cd_card cardinal name 
     640   !> @param[in]  ld_use  boundary use or not 
     641   !> @param[in]  td_seg  segment structure 
    487642   !> @return boundary structure 
    488643   !-------------------------------------------------------------------  
    489    !> @code  
    490644   FUNCTION boundary__init( cd_card, ld_use, td_seg )  
    491645      IMPLICIT NONE  
     
    520674 
    521675   END FUNCTION boundary__init 
    522    !> @endcode 
    523676   !-------------------------------------------------------------------  
    524677   !> @brief This subroutine add one segment structure to a boundary structure  
     
    527680   !  
    528681   !> @author J.Paul  
    529    !> - Nov, 2013- Initial Version  
    530    !  
    531    !> @param[inout] td_bdy : boundary structure   
    532    !> @param[in] td_seg : segment structure   
    533    !-------------------------------------------------------------------  
    534    !> @code  
     682   !> @date November, 2013 - Initial Version  
     683   !  
     684   !> @param[inout] td_bdy boundary structure   
     685   !> @param[in] td_seg    segment structure   
     686   !-------------------------------------------------------------------  
    535687   SUBROUTINE boundary__add_seg(td_bdy, td_seg)  
    536688      IMPLICIT NONE  
     
    554706         ELSE 
    555707            ! save temporary segment 
    556             tl_seg(:)=td_bdy%t_seg(:) 
    557  
     708            tl_seg(:)=seg__copy(td_bdy%t_seg(:)) 
     709 
     710            CALL seg__clean(td_bdy%t_seg(:)) 
    558711            DEALLOCATE( td_bdy%t_seg ) 
    559712            ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status ) 
     
    564717 
    565718            ! copy segment in boundary before 
    566             td_bdy%t_seg(1:td_bdy%i_nseg)=tl_seg(:) 
    567  
     719            td_bdy%t_seg(1:td_bdy%i_nseg)=seg__copy(tl_seg(:)) 
     720 
     721            ! clean 
     722            CALL seg__clean(tl_seg(:)) 
    568723            DEALLOCATE(tl_seg)             
    569724             
     
    572727         ! no segment in boundary structure 
    573728         IF( ASSOCIATED(td_bdy%t_seg) )THEN 
     729            CALL seg__clean(td_bdy%t_seg(:)) 
    574730            DEALLOCATE(td_bdy%t_seg) 
    575731         ENDIF 
     
    585741 
    586742      ! add new segment 
    587       td_bdy%t_seg(td_bdy%i_nseg)=td_seg 
     743      td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg) 
    588744 
    589745   END SUBROUTINE boundary__add_seg  
    590    !> @endcode 
    591746   !-------------------------------------------------------------------  
    592747   !> @brief This subroutine remove all segments of a boundary structure  
     
    595750   !  
    596751   !> @author J.Paul  
    597    !> - Nov, 2013- Initial Version  
    598    !  
    599    !> @param[inout]  td_bdy : boundary structure 
    600    !-------------------------------------------------------------------  
    601    !> @code  
     752   !> @date November, 2013 - Initial Version  
     753   !  
     754   !> @param[inout]  td_bdy   boundary structure 
     755   !-------------------------------------------------------------------  
    602756   SUBROUTINE boundary__del_seg(td_bdy)  
    603757      IMPLICIT NONE  
     
    610764 
    611765      IF( ASSOCIATED(td_bdy%t_seg) )THEN 
     766         CALL seg__clean(td_bdy%t_seg(:)) 
    612767         DEALLOCATE(td_bdy%t_seg) 
    613768      ENDIF 
     
    616771 
    617772   END SUBROUTINE boundary__del_seg  
    618    !> @endcode 
    619773   !-------------------------------------------------------------------  
    620774   !> @brief This function get information about boundary from string character.  
     
    627781   !>  
    628782   !> @author J.Paul  
    629    !> - Nov, 2013- Initial Version  
    630    !  
    631    !> @param[in] cd_card : boundary description 
     783   !> @date November, 2013 - Initial Version  
     784   !  
     785   !> @param[in] cd_card   boundary description 
    632786   !> @return boundary structure 
    633787   !-------------------------------------------------------------------  
    634    !> @code  
    635788   FUNCTION boundary__get_info(cd_card)  
    636789      IMPLICIT NONE  
     
    737890         ji=ji+1 
    738891         cl_seg=fct_split(cd_card,ji) 
     892 
     893         ! clean 
     894         CALL seg__clean(tl_seg) 
    739895      ENDDO  
    740896 
    741897   END FUNCTION boundary__get_info  
    742    !> @endcode 
    743898   !-------------------------------------------------------------------  
    744899   !> @brief This subroutine get indices of each semgent for each boundary. 
     
    757912   !  
    758913   !> @author J.Paul  
    759    !> - Nov, 2013- Initial Version  
    760    !  
    761    !> @param[inout] td_bdy : boundary structure   
    762    !> @param[in] td_var : variable structure  
    763    !> @param[in] ld_onseg : use only one sgment for each boundary  
    764    !-------------------------------------------------------------------  
    765    !> @code  
     914   !> @date November, 2013 - Initial Version  
     915   !  
     916   !> @param[inout] td_bdy boundary structure   
     917   !> @param[in] td_var    variable structure  
     918   !> @param[in] ld_onseg  use only one sgment for each boundary  
     919   !-------------------------------------------------------------------  
    766920   SUBROUTINE boundary_get_indices( td_bdy, td_var, ld_oneseg)  
    767921      IMPLICIT NONE  
     
    811965 
    812966               IF( ll_oneseg .AND. td_bdy(jk)%l_use )THEN 
    813                   tl_seg=td_bdy(jk)%t_seg(1) 
     967                  tl_seg=seg__copy(td_bdy(jk)%t_seg(1)) 
    814968                  ! use last indice of last segment 
    815969                  tl_seg%i_last=td_bdy(jk)%t_seg(td_bdy(jk)%i_nseg)%i_last 
     
    820974                  ! add one segment 
    821975                  CALL boundary__add_seg(td_bdy(jk),tl_seg) 
     976 
     977                  ! clean 
     978                  CALL seg__clean(tl_seg) 
    822979               ENDIF 
    823980 
     
    829986 
    830987   END SUBROUTINE boundary_get_indices  
    831    !> @endcode 
    832988   !-------------------------------------------------------------------  
    833989   !> @brief This subroutine compute the number of sea segment.  
     
    841997   !  
    842998   !> @author J.Paul  
    843    !> - Nov, 2013- Initial Version  
    844    !  
    845    !> @param[inout] td_bdy : boundary structure  
    846    !> @param[in] td_var : variable structure  
    847    !-------------------------------------------------------------------  
    848    !> @code  
     999   !> @date November, 2013 - Initial Version  
     1000   !  
     1001   !> @param[inout] td_bdy boundary structure  
     1002   !> @param[in] td_var    variable structure  
     1003   !-------------------------------------------------------------------  
    8491004   SUBROUTINE boundary__get_seg_number( td_bdy, td_var)  
    8501005      IMPLICIT NONE  
     
    9271082         END SELECT 
    9281083      ENDIF 
    929  
    930        
     1084  
    9311085   END SUBROUTINE boundary__get_seg_number  
    932    !> @endcode 
    9331086   !-------------------------------------------------------------------  
    9341087   !> @brief This subroutine get segment indices for one boundary. 
     
    9371090   !  
    9381091   !> @author J.Paul  
    939    !> - Nov, 2013- Initial Version  
    940    !  
    941    !> @param[inout] td_bdy : boundary structure   
    942    !> @param[in] td_var : variable structure   
    943    !> @param[in] id_index : boundary orthogonal index   
    944    !> @param[in] id_width : bounary width  
    945    !> @param[in] id_first : boundary first indice 
    946    !> @param[in] id_last  : boundary last  indice 
    947    !-------------------------------------------------------------------  
    948    !> @code  
     1092   !> @date November, 2013 - Initial Version  
     1093   !  
     1094   !> @param[inout] td_bdy boundary structure   
     1095   !> @param[in] td_var    variable structure   
     1096   !> @param[in] id_index  boundary orthogonal index   
     1097   !> @param[in] id_width  bounary width  
     1098   !> @param[in] id_first  boundary first indice 
     1099   !> @param[in] id_last   boundary last  indice 
     1100   !-------------------------------------------------------------------  
    9491101   SUBROUTINE boundary__get_seg_indices( td_bdy, td_var, & 
    9501102   &                                     id_index, id_width, id_first, id_last)  
     
    10041156      END SELECT 
    10051157 
    1006       il_max(jp_north)=td_var%t_dim(1)%i_len-ig_ghost 
    1007       il_max(jp_south)=td_var%t_dim(1)%i_len-ig_ghost 
    1008       il_max(jp_east )=td_var%t_dim(2)%i_len-ig_ghost 
    1009       il_max(jp_west )=td_var%t_dim(2)%i_len-ig_ghost 
    1010  
    1011       il_min(jp_north)=1+ig_ghost 
    1012       il_min(jp_south)=1+ig_ghost 
    1013       il_min(jp_east )=1+ig_ghost 
    1014       il_min(jp_west )=1+ig_ghost 
     1158      il_max(jp_north)=td_var%t_dim(1)%i_len-ip_ghost 
     1159      il_max(jp_south)=td_var%t_dim(1)%i_len-ip_ghost 
     1160      il_max(jp_east )=td_var%t_dim(2)%i_len-ip_ghost 
     1161      il_max(jp_west )=td_var%t_dim(2)%i_len-ip_ghost 
     1162 
     1163      il_min(jp_north)=1+ip_ghost 
     1164      il_min(jp_south)=1+ip_ghost 
     1165      il_min(jp_east )=1+ip_ghost 
     1166      il_min(jp_west )=1+ip_ghost 
    10151167          
    10161168      ! special case for EW cyclic  
     
    10741226         CALL boundary__add_seg(td_bdy,tl_seg) 
    10751227 
     1228         ! clean 
    10761229         CALL seg__clean(tl_seg) 
    10771230          
     
    10811234       
    10821235   END SUBROUTINE boundary__get_seg_indices  
    1083    !> @endcode 
    10841236   !-------------------------------------------------------------------  
    10851237   !> @brief This subroutine check if there is boundary at corner, and  
     
    10941246   !  
    10951247   !> @author J.Paul  
    1096    !> - Nov, 2013- Initial Version  
    1097    !  
    1098    !> @param[inout] td_bdy : boundary structure 
    1099    !> @param[in] td_var : variable structure 
    1100    !>  
    1101    !> @todo add schematic to description 
    1102    !-------------------------------------------------------------------  
    1103    !> @code  
     1248   !> @date November, 2013 - Initial Version  
     1249   !  
     1250   !> @param[inout] td_bdy boundary structure 
     1251   !> @param[in] td_var    variable structure 
     1252   !-------------------------------------------------------------------  
    11041253   SUBROUTINE boundary_check_corner( td_bdy, td_var ) 
    11051254      IMPLICIT NONE  
     
    11261275      ! check north west corner 
    11271276      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_west)%l_use )THEN 
    1128          tl_west =td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg) 
    1129          tl_north=td_bdy(jp_north)%t_seg(1) 
     1277         tl_west =seg__copy(td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)) 
     1278         tl_north=seg__copy(td_bdy(jp_north)%t_seg(1)) 
    11301279 
    11311280         IF( tl_west%i_last  >= tl_north%i_index .AND. & 
     
    11481297            ENDIF 
    11491298 
    1150             td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)=tl_west 
    1151             td_bdy(jp_north)%t_seg(1)                     =tl_north 
     1299            td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)=seg__copy(tl_west) 
     1300            td_bdy(jp_north)%t_seg(1)                     =seg__copy(tl_north) 
    11521301 
    11531302         ELSE 
     
    11691318      ! check north east corner 
    11701319      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_east)%l_use )THEN 
    1171          tl_east =td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg) 
    1172          tl_north=td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg) 
     1320         tl_east =seg__copy(td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)) 
     1321         tl_north=seg__copy(td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)) 
    11731322 
    11741323         IF( tl_east%i_last  >= tl_north%i_index .AND. & 
     
    11911340            ENDIF 
    11921341 
    1193             td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)=tl_east 
    1194             td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)=tl_north 
     1342            td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)=seg__copy(tl_east) 
     1343            td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)=seg__copy(tl_north) 
    11951344         ELSE 
    11961345 
     
    12111360      ! check south east corner 
    12121361      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_east)%l_use )THEN 
    1213          tl_east =td_bdy(jp_east )%t_seg(1) 
    1214          tl_south=td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg) 
     1362         tl_east =seg__copy(td_bdy(jp_east )%t_seg(1)) 
     1363         tl_south=seg__copy(td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)) 
    12151364 
    12161365         IF( tl_east%i_first <= tl_south%i_index .AND. & 
     
    12331382            ENDIF 
    12341383 
    1235             td_bdy(jp_east )%t_seg(1)                      =tl_east 
    1236             td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)=tl_south 
     1384            td_bdy(jp_east )%t_seg(1)                      =seg__copy(tl_east) 
     1385            td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)=seg__copy(tl_south) 
    12371386         ELSE 
    12381387 
     
    12531402      ! check south west corner 
    12541403      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_west)%l_use )THEN 
    1255          tl_west =td_bdy(jp_west )%t_seg(1) 
    1256          tl_south=td_bdy(jp_south)%t_seg(1) 
     1404         tl_west =seg__copy(td_bdy(jp_west )%t_seg(1)) 
     1405         tl_south=seg__copy(td_bdy(jp_south)%t_seg(1)) 
    12571406 
    12581407         IF( tl_west%i_first <= tl_south%i_index .AND. & 
     
    12751424            ENDIF 
    12761425 
    1277             td_bdy(jp_west )%t_seg(1) = tl_west 
    1278             td_bdy(jp_south)%t_seg(1) = tl_south 
     1426            td_bdy(jp_west )%t_seg(1) = seg__copy(tl_west) 
     1427            td_bdy(jp_south)%t_seg(1) = seg__copy(tl_south) 
    12791428         ELSE 
    12801429 
     
    12931442      ENDIF 
    12941443 
     1444      ! clean 
     1445      CALL seg__clean(tl_north) 
     1446      CALL seg__clean(tl_south) 
     1447      CALL seg__clean(tl_east ) 
     1448      CALL seg__clean(tl_west ) 
     1449 
    12951450   END SUBROUTINE boundary_check_corner  
    1296    !> @endcode 
    12971451   !-------------------------------------------------------------------  
    12981452   !> @brief This subroutine check boundary. 
     
    13031457   !  
    13041458   !> @author J.Paul  
    1305    !> - Nov, 2013- Initial Version  
    1306    !  
    1307    !> @param[inout] td_bdy : boundary structure  
    1308    !> @param[in] td_var : variable structure  
    1309    !-------------------------------------------------------------------  
    1310    !> @code  
     1459   !> @date November, 2013 - Initial Version  
     1460   !  
     1461   !> @param[inout] td_bdy boundary structure  
     1462   !> @param[in] td_var    variable structure  
     1463   !-------------------------------------------------------------------  
    13111464   SUBROUTINE boundary_check(td_bdy, td_var)  
    13121465      IMPLICIT NONE  
     
    13281481      il_max(jp_west )=td_var%t_dim(2)%i_len 
    13291482       
    1330       il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ig_ghost 
    1331       il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ig_ghost 
    1332       il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ig_ghost 
    1333       il_maxindex(jp_west )=td_var%t_dim(1)%i_len-ig_ghost 
     1483      il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 
     1484      il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost 
     1485      il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ip_ghost 
     1486      il_maxindex(jp_west )=td_var%t_dim(1)%i_len-ip_ghost 
    13341487 
    13351488      DO jk=1,ip_ncard 
     
    13661519 
    13671520   END SUBROUTINE boundary_check 
    1368    !> @endcode 
    1369    !------------------------------------------------------------------- 
    1370    !> @brief This subroutine clean interpolated boundary in variable structure. 
    1371    ! 
    1372    !> @detail 
    1373    !> interpolation could create more point than needed for boundary (depending 
    1374    !> on refinement factor). This subroutine keep only useful point on variable 
    1375    !>  
    1376    !> @note we use width define in first segment, cause every segment of a 
    1377    !> boundary should have the same width  
    1378    !> 
    1379    !> @author J.Paul 
    1380    !> - Nov, 2013- Initial Version 
    1381    ! 
    1382    !> @param[inout] td_var : variable strucutre 
    1383    !> @param[in   ] td_bdy : boundary strucutre 
    1384    !------------------------------------------------------------------- 
    1385    !> @code 
    1386    SUBROUTINE boundary_clean_interp( td_var, td_bdy ) 
    1387       IMPLICIT NONE 
    1388       ! Argument 
    1389       TYPE(TVAR), INTENT(INOUT) :: td_var 
    1390       TYPE(TBDY), INTENT(IN   ) :: td_bdy 
    1391  
    1392       ! local variable 
    1393       TYPE(TVAR)  :: tl_var 
    1394  
    1395       INTEGER(i4) :: il_imin 
    1396       INTEGER(i4) :: il_imax 
    1397       INTEGER(i4) :: il_jmin 
    1398       INTEGER(i4) :: il_jmax 
    1399  
    1400       ! loop indices 
    1401       !---------------------------------------------------------------- 
    1402  
    1403       ! copy input variable 
    1404       tl_var=td_var 
    1405  
    1406       DEALLOCATE(td_var%d_value) 
    1407  
    1408       SELECT CASE(TRIM(td_bdy%c_card)) 
    1409       CASE('north') 
    1410  
    1411          il_imin=1 
    1412          il_imax=tl_var%t_dim(1)%i_len 
    1413          SELECT CASE(td_var%c_point) 
    1414          CASE('V','F') 
    1415             il_jmin=td_bdy%t_seg(1)%i_width+1 
    1416             il_jmax=2 
    1417          CASE DEFAULT ! 'T','U' 
    1418             il_jmin=td_bdy%t_seg(1)%i_width 
    1419             il_jmax=1 
    1420          END SELECT 
    1421  
    1422          ! use width as dimension length 
    1423          td_var%t_dim(2)%i_len=td_bdy%t_seg(1)%i_width 
    1424  
    1425       CASE('south') 
    1426  
    1427          il_imin=1 
    1428          il_imax=tl_var%t_dim(1)%i_len 
    1429  
    1430          il_jmin=1 
    1431          il_jmax=td_bdy%t_seg(1)%i_width 
    1432           
    1433          ! use width as dimension length 
    1434          td_var%t_dim(2)%i_len=td_bdy%t_seg(1)%i_width 
    1435  
    1436       CASE('east') 
    1437  
    1438          SELECT CASE(td_var%c_point) 
    1439          CASE('U','F') 
    1440             il_imin=td_bdy%t_seg(1)%i_width+1 
    1441             il_imax=2 
    1442          CASE DEFAULT ! 'T','V' 
    1443             il_imin=td_bdy%t_seg(1)%i_width 
    1444             il_imax=1 
    1445          END SELECT 
    1446  
    1447          il_jmin=1 
    1448          il_jmax=tl_var%t_dim(2)%i_len 
    1449  
    1450          ! use width as dimension length 
    1451          td_var%t_dim(1)%i_len=td_bdy%t_seg(1)%i_width 
    1452  
    1453       CASE('west') 
    1454  
    1455          il_imin=1 
    1456          il_imax=td_bdy%t_seg(1)%i_width 
    1457  
    1458          il_jmin=1 
    1459          il_jmax=tl_var%t_dim(2)%i_len 
    1460  
    1461          ! use width as dimension length 
    1462          td_var%t_dim(1)%i_len=td_bdy%t_seg(1)%i_width 
    1463  
    1464       END SELECT 
    1465  
    1466  
    1467       ALLOCATE( td_var%d_value(td_var%t_dim(1)%i_len, & 
    1468       &                        td_var%t_dim(2)%i_len, & 
    1469       &                        td_var%t_dim(3)%i_len, & 
    1470       &                        td_var%t_dim(4)%i_len) ) 
    1471  
    1472       IF( il_imin > il_imax )THEN 
    1473          il_imin=tl_var%t_dim(1)%i_len-il_imin+1 
    1474          il_imax=tl_var%t_dim(1)%i_len-il_imax+1 
    1475       ENDIF 
    1476  
    1477       IF( il_jmin > il_jmax )THEN 
    1478          il_jmin=tl_var%t_dim(2)%i_len-il_jmin+1 
    1479          il_jmax=tl_var%t_dim(2)%i_len-il_jmax+1 
    1480       ENDIF       
    1481  
    1482       td_var%d_value(:,:,:,:)=tl_var%d_value( il_imin:il_imax, & 
    1483       &                                       il_jmin:il_jmax, & 
    1484       &                                       :,: ) 
    1485  
    1486       CALL var_clean(tl_var) 
    1487  
    1488  
    1489    END SUBROUTINE boundary_clean_interp 
    1490    !> @endcode 
    14911521   !------------------------------------------------------------------- 
    14921522   !> @brief This subroutine swap array for east and north boundary. 
     
    14951525   !>  
    14961526   !> @author J.Paul 
    1497    !> - Nov, 2013- Initial Version 
     1527   !> @date November, 2013 - Initial Version 
    14981528   ! 
    1499    !> @param[inout] td_var : variable strucutre 
    1500    !> @param[in   ] td_bdy : boundary strucutre 
     1529   !> @param[inout] td_var variable strucutre 
     1530   !> @param[in   ] td_bdy boundary strucutre 
    15011531   !------------------------------------------------------------------- 
    1502    !> @code 
    15031532   SUBROUTINE boundary_swap( td_var, td_bdy ) 
    15041533      IMPLICIT NONE 
     
    15161545 
    15171546      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 
    1518          CALL logger_error("BOUNDARY SWAP: no table of value "//& 
     1547         CALL logger_error("BOUNDARY SWAP: no array of value "//& 
    15191548         &  "associted to variable "//TRIM(td_var%c_name) ) 
    15201549      ELSE       
     
    15551584      ENDIF 
    15561585   END SUBROUTINE boundary_swap 
    1557    !> @endcode 
    1558    !-------------------------------------------------------------------  
    1559    !> @brief This subroutine print information about one boundary  
    1560    !  
    1561    !> @details  
     1586   !-------------------------------------------------------------------  
     1587   !> @brief This subroutine print information about one boundary.  
    15621588   !  
    15631589   !> @author J.Paul  
    1564    !> - Nov, 2013- Initial Version  
    1565    !  
    1566    !> @param[in] td_bdy : boundary structure  
    1567    !-------------------------------------------------------------------  
    1568    !> @code  
     1590   !> @date November, 2013 - Initial Version  
     1591   !  
     1592   !> @param[in] td_bdy boundary structure  
     1593   !-------------------------------------------------------------------  
    15691594   SUBROUTINE boundary__print_unit( td_bdy )  
    15701595      IMPLICIT NONE  
     
    15881613  
    15891614   END SUBROUTINE boundary__print_unit 
    1590    !> @endcode 
    1591    !-------------------------------------------------------------------  
    1592    !> @brief This subroutine print information about a table of boundary  
     1615   !-------------------------------------------------------------------  
     1616   !> @brief This subroutine print information about a array of boundary  
    15931617   !  
    15941618   !> @details  
    15951619   !  
    15961620   !> @author J.Paul  
    1597    !> - Nov, 2013- Initial Version  
    1598    !  
    1599    !> @param[in] td_bdy : boundary structure  
    1600    !-------------------------------------------------------------------  
    1601    !> @code  
    1602    SUBROUTINE boundary__print_tab( td_bdy )  
     1621   !> @date November, 2013 - Initial Version  
     1622   !  
     1623   !> @param[in] td_bdy boundary structure  
     1624   !-------------------------------------------------------------------  
     1625   SUBROUTINE boundary__print_arr( td_bdy )  
    16031626      IMPLICIT NONE  
    16041627      ! Argument 
     
    16131636      ENDDO 
    16141637  
    1615    END SUBROUTINE boundary__print_tab 
    1616    !> @endcode 
     1638   END SUBROUTINE boundary__print_arr 
    16171639   !------------------------------------------------------------------- 
    16181640   !> @brief 
    1619    !> This subroutine copy segment structure in another segment 
    1620    !> structure 
    1621    !> @details  
     1641   !> This subroutine copy segment structure in another one. 
    16221642   !> 
     1643   !> @warning do not use on the output of a function who create or read a 
     1644   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 
     1645   !> This will create memory leaks. 
    16231646   !> @warning to avoid infinite loop, do not use any function inside  
    16241647   !> this subroutine 
    16251648   !> 
    16261649   !> @author J.Paul 
    1627    !> - Nov, 2013- Initial Version 
     1650   !> @date November, 2013 - Initial Version 
     1651   !> @date November, 2014 
     1652   !>    - use function instead of overload assignment operator  
     1653   !> (to avoid memory leak) 
    16281654   ! 
    1629    !> @param[out] td_seg1  : segment structure 
    1630    !> @param[in] td_seg2  : segment structure 
     1655   !> @param[in] td_seg  segment structure 
     1656   !> @return copy of input segment structure 
    16311657   !------------------------------------------------------------------- 
    1632    !> @code 
    1633    SUBROUTINE seg__copy( td_seg1, td_seg2 ) 
     1658   FUNCTION seg__copy_unit( td_seg ) 
    16341659      IMPLICIT NONE 
    16351660      ! Argument 
    1636       TYPE(TSEG), INTENT(OUT) :: td_seg1 
    1637       TYPE(TSEG), INTENT(IN)  :: td_seg2 
     1661      TYPE(TSEG), INTENT(IN)  :: td_seg 
     1662      ! function 
     1663      TYPE(TSEG) :: seg__copy_unit 
    16381664 
    16391665      ! local variable 
     
    16421668 
    16431669      ! copy segment index, width, .. 
    1644       td_seg1%i_index    = td_seg2%i_index 
    1645       td_seg1%i_width    = td_seg2%i_width 
    1646       td_seg1%i_first    = td_seg2%i_first 
    1647       td_seg1%i_last     = td_seg2%i_last  
    1648  
    1649    END SUBROUTINE seg__copy 
    1650    !> @endcode 
     1670      seg__copy_unit%i_index    = td_seg%i_index 
     1671      seg__copy_unit%i_width    = td_seg%i_width 
     1672      seg__copy_unit%i_first    = td_seg%i_first 
     1673      seg__copy_unit%i_last     = td_seg%i_last  
     1674 
     1675   END FUNCTION seg__copy_unit 
     1676   !------------------------------------------------------------------- 
     1677   !> @brief 
     1678   !> This subroutine copy segment structure in another one. 
     1679   !> 
     1680   !> @warning do not use on the output of a function who create or read a 
     1681   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 
     1682   !> This will create memory leaks.    
     1683   !> @warning to avoid infinite loop, do not use any function inside  
     1684   !> this subroutine 
     1685   !> 
     1686   !> @author J.Paul 
     1687   !> @date November, 2013 - Initial Version 
     1688   !> @date November, 2014 
     1689   !>    - use function instead of overload assignment operator  
     1690   !> (to avoid memory leak) 
     1691   ! 
     1692   !> @param[in] td_seg   segment structure 
     1693   !> @return copy of input array of segment structure 
     1694   !------------------------------------------------------------------- 
     1695   FUNCTION seg__copy_arr( td_seg ) 
     1696      IMPLICIT NONE 
     1697      ! Argument 
     1698      TYPE(TSEG), DIMENSION(:), INTENT(IN)  :: td_seg 
     1699      ! function 
     1700      TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: seg__copy_arr 
     1701 
     1702      ! local variable 
     1703      ! loop indices 
     1704      INTEGER(i4) :: ji 
     1705      !---------------------------------------------------------------- 
     1706 
     1707      DO ji=1,SIZE(td_seg(:)) 
     1708         seg__copy_arr(ji)=seg__copy(td_seg(ji)) 
     1709      ENDDO 
     1710 
     1711   END FUNCTION seg__copy_arr 
    16511712   !-------------------------------------------------------------------  
    16521713   !> @brief This function  initialise segment structure. 
     
    16571718   !  
    16581719   !> @author J.Paul  
    1659    !> - Nov, 2013- Initial Version  
    1660    !  
    1661    !> @param[in] id_index : orthogonal index 
    1662    !> @param[in] id_width : width of the segment  
    1663    !> @param[in] id_first : first indices  
    1664    !> @param[in] id_last  : last  indices 
     1720   !> @date November, 2013 - Initial Version  
     1721   !  
     1722   !> @param[in] id_index orthogonal index 
     1723   !> @param[in] id_width width of the segment  
     1724   !> @param[in] id_first first indices  
     1725   !> @param[in] id_last  last  indices 
    16651726   !> @return segment structure 
    16661727   !-------------------------------------------------------------------  
    1667    !> @code  
    16681728   FUNCTION seg__init( id_index, id_width, id_first, id_last )  
    16691729      IMPLICIT NONE  
     
    16891749 
    16901750   END FUNCTION seg__init  
    1691    !> @endcode 
    16921751   !-------------------------------------------------------------------  
    16931752   !> @brief This subroutine clean segment structure.  
    16941753   !  
    1695    !> @details  
    1696    !  
    16971754   !> @author J.Paul  
    1698    !> - Nov, 2013- Initial Version  
    1699    !  
    1700    !> @param[inout] td_seg : segment structure 
    1701    !-------------------------------------------------------------------  
    1702    !> @code  
    1703    SUBROUTINE seg__clean(td_seg)  
     1755   !> @date November, 2013 - Initial Version  
     1756   !  
     1757   !> @param[inout] td_seg segment structure 
     1758   !-------------------------------------------------------------------  
     1759   SUBROUTINE seg__clean_unit(td_seg)  
    17041760      IMPLICIT NONE  
    17051761      ! Argument        
     
    17101766      !----------------------------------------------------------------  
    17111767 
    1712       td_seg=tl_seg 
     1768      td_seg=seg__copy(tl_seg) 
    17131769  
    1714    END SUBROUTINE seg__clean  
    1715    !> @endcode 
    1716 !   !-------------------------------------------------------------------  
    1717 !   !> @brief This function   
    1718 !   !  
    1719 !   !> @details  
    1720 !   !  
    1721 !   !> @author J.Paul  
    1722 !   !> - Nov, 2013- Initial Version  
    1723 !   !  
    1724 !   !> @param[in]   
    1725 !   !-------------------------------------------------------------------  
    1726 !   !> @code  
    1727 !   FUNCTION boundary_()  
    1728 !      IMPLICIT NONE  
    1729 !      ! Argument        
    1730 !      ! function  
    1731 !      ! local variable  
    1732 !      ! loop indices  
    1733 !      !----------------------------------------------------------------  
    1734 !  
    1735 !   END FUNCTION boundary_  
    1736 !   !> @endcode  
    1737 !   !-------------------------------------------------------------------  
    1738 !   !> @brief This subroutine   
    1739 !   !  
    1740 !   !> @details  
    1741 !   !  
    1742 !   !> @author J.Paul  
    1743 !   !> - Nov, 2013- Initial Version  
    1744 !   !  
    1745 !   !> @param[in]   
    1746 !   !-------------------------------------------------------------------  
    1747 !   !> @code  
    1748 !   SUBROUTINE boundary_()  
    1749 !      IMPLICIT NONE  
    1750 !      ! Argument        
    1751 !      ! local variable  
    1752 !      ! loop indices  
    1753 !      !----------------------------------------------------------------  
    1754 !  
    1755 !   END SUBROUTINE boundary_  
    1756 !   !> @endcode 
     1770   END SUBROUTINE seg__clean_unit 
     1771   !-------------------------------------------------------------------  
     1772   !> @brief This subroutine clean segment structure.  
     1773   !  
     1774   !> @author J.Paul  
     1775   !> @date November, 2013 - Initial Version  
     1776   !  
     1777   !> @param[inout] td_seg array of segment structure 
     1778   !-------------------------------------------------------------------  
     1779   SUBROUTINE seg__clean_arr(td_seg)  
     1780      IMPLICIT NONE  
     1781      ! Argument        
     1782      TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg 
     1783      ! local variable  
     1784      ! loop indices  
     1785      INTEGER(i4) :: ji 
     1786      !----------------------------------------------------------------  
     1787 
     1788      DO ji=SIZE(td_seg(:)),1,-1 
     1789         CALL seg__clean(td_seg(ji)) 
     1790      ENDDO 
     1791  
     1792   END SUBROUTINE seg__clean_arr  
    17571793END MODULE boundary 
Note: See TracChangeset for help on using the changeset viewer.