source: NEMO/trunk/tools/SIREN/src/boundary.f90 @ 9598

Last change on this file since 9598 was 9598, checked in by nicolasmartin, 2 years ago

Reorganisation plan for NEMO repository: changes to make compilation succeed with new structure
Juste one issue left with AGRIF_NORDIC with AGRIF preprocessing
Standardisation of routines header with version 4.0 and year 2018
Fix for some broken symlinks

File size: 65.4 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: boundary
6!
7! DESCRIPTION:
8!> @brief
9!> This module manage boundary.
10!>
11!> @details
12!>    define type TBDY:<br/>
13!> @code
14!>    TYPE(TBDY) :: tl_bdy<br/>
15!> @endcode
16!>
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 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]
31!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
32!>
33!>    to get boundary cardinal:<br/>
34!>    - tl_bdy\%c_card
35!>
36!>    to know if boundary is use:<br/>
37!>    - tl_bdy\%l_use
38!>
39!>    to know if boundary come from namelist (cn_north,..):<br/>
40!>    - tl_bdy\%l_nam
41!>
42!>    to get the number of segment in boundary:<br/>
43!>    - tl_bdy\%i_nseg
44!>
45!>    to get array of segment in boundary:<br/>
46!>    - tl_bdy\%t_seg(:)
47!>
48!>    to get orthogonal segment index of north boundary:<br/>
49!>    - tl_bdy\%t_seg(jp_north)%\i_index
50!>
51!>    to get segment width of south boundary:<br/>
52!>    - tl_bdy\%t_seg(jp_south)%\i_width
53!>
54!>    to get segment first indice of east boundary:<br/>
55!>    - tl_bdy\%t_seg(jp_east)%\i_first
56!>
57!>    to get segment last indice of west boundary:<br/>
58!>    - tl_bdy\%t_seg(jp_west)%\i_last
59!>
60!>    to print information about boundary:<br/>
61!> @code
62!>    CALL boundary_print(td_bdy)
63!> @endcode
64!>       - td_bdy is boundary structure or a array of boundary structure
65!>
66!>    to clean boundary structure:<br/>
67!> @code
68!>    CALL boundary_clean(td_bdy)
69!> @endcode
70!>
71!>    to get indices of each semgent for each boundary:<br/>
72!> @code
73!>    CALL boundary_get_indices( td_bdy, td_var, ld_oneseg)
74!> @endcode
75!>       - td_bdy is boundary structure
76!>       - td_var is variable structure
77!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
78!>
79!>    to check boundary indices and corner:<br/>
80!> @code
81!>    CALL boundary_check(td_bdy, td_var)
82!> @endcode
83!>       - td_bdy is boundary structure
84!>       - td_var is variable structure
85!>
86!>    to check boundary corner:<br/>
87!> @code
88!>    CALL boundary_check_corner(td_bdy, td_var)
89!> @endcode
90!>       - td_bdy is boundary structure
91!>       - td_var is variable structure
92!>
93!>    to create filename with cardinal name inside:<br/>
94!> @code
95!>    cl_filename=boundary_set_filename(cd_file, cd_card)
96!> @endcode
97!>       - cd_file = original file name
98!>       - cd_card = cardinal name
99!>
100!>    to swap array for east and north boundary:<br/>
101!> @code
102!>    CALL boundary_swap( td_var, td_bdy )
103!> @endcode
104!>       - td_var is variable strucutre
105!>       - td_bdy is boundary strucutre
106!>
107!> @author J.Paul
108! REVISION HISTORY:
109!> @date November, 2013 - Initial Version
110!> @date September, 2014
111!> - add boundary description
112!> @date November, 2014
113!> - Fix memory leaks bug
114!> @date February, 2015
115!> - Do not change indices read from namelist
116!> - Change string character format of boundary read from namelist,
117!>  see boundary__get_info
118!>
119!> @todo add schematic to boundary structure description
120!>
121!> @note Software governed by the CeCILL licence     (./LICENSE)
122!----------------------------------------------------------------------
123MODULE boundary
124   USE netcdf                          ! nf90 library                           
125   USE global                          ! global parameter
126   USE phycst                          ! physical constant
127   USE kind                            ! F90 kind parameter
128   USE logger                          ! log file manager
129   USE fct                             ! basic useful function
130   USE var                             ! variable manager
131
132   IMPLICIT NONE
133   ! NOTE_avoid_public_variables_if_possible
134
135   ! type and variable
136   PUBLIC :: TBDY     !< boundary structure
137   PUBLIC :: TSEG     !< segment structure
138
139   PRIVATE :: im_width !< boundary width
140
141   ! function and subroutine
142   PUBLIC :: boundary_copy         !< copy boundary structure
143   PUBLIC :: boundary_init         !< initialise boundary structure
144   PUBLIC :: boundary_print        !< print information about boundary
145   PUBLIC :: boundary_clean        !< clean boundary structure
146   PUBLIC :: boundary_get_indices  !< get indices of each semgent for each boundary.
147   PUBLIC :: boundary_check        !< check boundary indices and corner.
148   PUBLIC :: boundary_check_corner !< check boundary corner
149   PUBLIC :: boundary_set_filename !< set boundary filename
150   PUBLIC :: boundary_swap         !< swap array for north and east boundary
151
152   PRIVATE :: boundary__clean_unit      ! clean boundary structure
153   PRIVATE :: boundary__clean_arr       ! clean array of boundary structure
154   PRIVATE :: boundary__init_wrapper    ! initialise a boundary structure
155   PRIVATE :: boundary__init            ! initialise basically a boundary structure
156   PRIVATE :: boundary__copy_unit       ! copy boundary structure in another
157   PRIVATE :: boundary__copy_arr        ! copy boundary structure in another
158   PRIVATE :: boundary__add_seg         ! add one segment structure to a boundary
159   PRIVATE :: boundary__del_seg         ! remove all segments of a boundary
160   PRIVATE :: boundary__get_info        ! get boundary information from boundary description string character.
161   PRIVATE :: boundary__get_seg_number  ! compute the number of sea segment for one boundary
162   PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary
163   PRIVATE :: boundary__print_unit      ! print information about one boundary
164   PRIVATE :: boundary__print_arr       ! print information about a array of boundary
165   
166   PRIVATE :: seg__init       ! initialise segment structure
167   PRIVATE :: seg__clean      ! clean segment structure
168   PRIVATE :: seg__clean_unit ! clean one segment structure
169   PRIVATE :: seg__clean_arr  ! clean array of segment structure
170   PRIVATE :: seg__copy       ! copy segment structure in another
171   PRIVATE :: seg__copy_unit  ! copy segment structure in another
172   PRIVATE :: seg__copy_arr   ! copy array of segment structure in another
173
174   TYPE TSEG   !< segment structure
175      INTEGER(i4) :: i_index = 0 !< segment index
176      INTEGER(i4) :: i_width = 0 !< segment width
177      INTEGER(i4) :: i_first = 0 !< segment first indice
178      INTEGER(i4) :: i_last  = 0 !< segment last indices
179   END TYPE TSEG
180
181   TYPE TBDY !< boundary structure
182      CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal
183      LOGICAL           :: l_use  = .FALSE.     !< boundary use or not
184      LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist
185      INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary
186      TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure
187   END TYPE TBDY
188
189   ! module variable
190   INTEGER(i4), PARAMETER :: im_width=10
191
192   INTERFACE boundary_init
193      MODULE PROCEDURE boundary__init_wrapper 
194   END INTERFACE boundary_init
195
196   INTERFACE boundary_print
197      MODULE PROCEDURE boundary__print_unit 
198      MODULE PROCEDURE boundary__print_arr 
199   END INTERFACE boundary_print
200
201   INTERFACE boundary_clean
202      MODULE PROCEDURE boundary__clean_unit   
203      MODULE PROCEDURE boundary__clean_arr   
204   END INTERFACE
205
206   INTERFACE seg__clean
207      MODULE PROCEDURE seg__clean_unit   
208      MODULE PROCEDURE seg__clean_arr   
209   END INTERFACE
210
211   INTERFACE boundary_copy
212      MODULE PROCEDURE boundary__copy_unit 
213      MODULE PROCEDURE boundary__copy_arr 
214   END INTERFACE   
215
216   INTERFACE seg__copy
217      MODULE PROCEDURE seg__copy_unit   ! copy segment structure
218      MODULE PROCEDURE seg__copy_arr    ! copy array of segment structure
219   END INTERFACE   
220
221CONTAINS
222   !-------------------------------------------------------------------
223   !> @brief
224   !> This subroutine copy a array of boundary structure in another one
225   !> @details
226   !>
227   !> @warning do not use on the output of a function who create or read an
228   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden).
229   !> This will create memory leaks.
230   !> @warning to avoid infinite loop, do not use any function inside
231   !> this subroutine
232   !>
233   !> @author J.Paul
234   !> @date November, 2013 - Initial Version
235   !> @date November, 2014
236   !> - use function instead of overload assignment operator
237   !> (to avoid memory leak)
238   !
239   !> @param[in] td_bdy   array of boundary structure
240   !> @return copy of input array of boundary structure
241   !-------------------------------------------------------------------
242   FUNCTION boundary__copy_arr( td_bdy )
243      IMPLICIT NONE
244      ! Argument
245      TYPE(TBDY), DIMENSION(:), INTENT(IN)  :: td_bdy
246      ! function
247      TYPE(TBDY), DIMENSION(SIZE(td_bdy(:))) :: boundary__copy_arr
248
249      ! local variable
250      ! loop indices
251      INTEGER(i4) :: jk
252      !----------------------------------------------------------------
253
254      DO jk=1,SIZE(td_bdy(:))
255         boundary__copy_arr(jk)=boundary_copy(td_bdy(jk))
256      ENDDO
257
258   END FUNCTION boundary__copy_arr
259   !-------------------------------------------------------------------
260   !> @brief
261   !> This subroutine copy boundary structure in another one
262   !> @details
263   !>
264   !> @warning do not use on the output of a function who create or read an
265   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden).
266   !> This will create memory leaks.
267   !> @warning to avoid infinite loop, do not use any function inside
268   !> this subroutine
269   !>
270   !> @author J.Paul
271   !> @date November, 2013 - Initial Version
272   !> @date November, 2014
273   !> - use function instead of overload assignment operator
274   !> (to avoid memory leak)
275   !
276   !> @param[in] td_bdy   boundary structure
277   !> @return copy of input boundary structure
278   !-------------------------------------------------------------------
279   FUNCTION boundary__copy_unit( td_bdy )
280      IMPLICIT NONE
281      ! Argument
282      TYPE(TBDY), INTENT(IN)  :: td_bdy
283      ! function
284      TYPE(TBDY) :: boundary__copy_unit
285
286      ! local variable
287      ! loop indices
288      INTEGER(i4) :: ji
289      !----------------------------------------------------------------
290
291      ! copy variable name, id, ..
292      boundary__copy_unit%c_card     = TRIM(td_bdy%c_card)
293      boundary__copy_unit%i_nseg     = td_bdy%i_nseg
294      boundary__copy_unit%l_use      = td_bdy%l_use
295
296      ! copy segment
297      IF( ASSOCIATED(boundary__copy_unit%t_seg) )THEN
298         CALL seg__clean(boundary__copy_unit%t_seg(:))
299         DEALLOCATE(boundary__copy_unit%t_seg)
300      ENDIF
301      IF( ASSOCIATED(td_bdy%t_seg) .AND. boundary__copy_unit%i_nseg > 0 )THEN
302         ALLOCATE( boundary__copy_unit%t_seg(boundary__copy_unit%i_nseg) )
303         DO ji=1,boundary__copy_unit%i_nseg
304            boundary__copy_unit%t_seg(ji)=td_bdy%t_seg(ji)
305         ENDDO
306      ENDIF
307
308   END FUNCTION boundary__copy_unit
309   !-------------------------------------------------------------------
310   !> @brief This subroutine clean boundary structure
311   !
312   !> @author J.Paul
313   !> @date November, 2013 - Initial Version
314   !
315   !> @param[inout] td_bdy boundary strucutre
316   !-------------------------------------------------------------------
317   SUBROUTINE boundary__clean_unit( td_bdy )
318      IMPLICIT NONE
319      ! Argument
320      TYPE(TBDY), INTENT(INOUT) :: td_bdy
321
322      ! local variable
323      TYPE(TBDY) :: tl_bdy ! empty boundary strucutre
324
325      ! loop indices
326      !----------------------------------------------------------------
327
328      CALL logger_info( &
329      &  " CLEAN: reset boundary "//TRIM(td_bdy%c_card) )
330
331      ! del segment
332      IF( ASSOCIATED(td_bdy%t_seg) )THEN
333         ! clean each segment
334         CALL seg__clean(td_bdy%t_seg(:) )
335         DEALLOCATE( td_bdy%t_seg )
336      ENDIF
337
338      ! replace by empty structure
339      td_bdy=boundary_copy(tl_bdy)
340
341   END SUBROUTINE boundary__clean_unit
342   !-------------------------------------------------------------------
343   !> @brief This subroutine clean array of boundary structure
344   !
345   !> @author J.Paul
346   !> @date September, 2014 - Initial Version
347   !
348   !> @param[inout] td_bdy boundary strucutre
349   !-------------------------------------------------------------------
350   SUBROUTINE boundary__clean_arr( td_bdy )
351      IMPLICIT NONE
352      ! Argument
353      TYPE(TBDY), DIMENSION(:), INTENT(INOUT) :: td_bdy
354
355      ! local variable
356      ! loop indices
357      INTEGER(i4) :: ji
358      !----------------------------------------------------------------
359
360      DO ji=SIZE(td_bdy(:)),1,-1
361         CALL boundary_clean( td_bdy(ji) )
362      ENDDO
363
364   END SUBROUTINE boundary__clean_arr
365   !-------------------------------------------------------------------
366   !> @brief This function put cardinal name and date inside file name.
367   !
368   !> @details
369   !>    Examples :
370   !>       cd_file="boundary.nc"
371   !>       cd_card="west"
372   !>       id_seg =2
373   !>       cd_date=y2015m07d16
374   !>
375   !>       function return "boundary_west_2_y2015m07d16.nc"
376   !>
377   !>       cd_file="boundary.nc"
378   !>       cd_card="west"
379   !>
380   !>       function return "boundary_west.nc"
381   !>
382   !> @author J.Paul
383   !> @date November, 2013 - Initial Version
384   !
385   !> @param[in] cd_file   file name
386   !> @param[in] cd_card   cardinal name
387   !> @param[in] id_seg    segment number
388   !> @param[in] cd_date   file date (format: y????m??d??)
389   !> @return file name with cardinal name inside
390   !-------------------------------------------------------------------
391   FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) 
392      IMPLICIT NONE 
393      ! Argument
394      CHARACTER(LEN=*), INTENT(IN) :: cd_file
395      CHARACTER(LEN=*), INTENT(IN) :: cd_card
396      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_seg
397      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date
398
399      ! function
400      CHARACTER(LEN=lc) :: boundary_set_filename
401
402      ! local variable
403      CHARACTER(LEN=lc) :: cl_dirname
404      CHARACTER(LEN=lc) :: cl_basename
405      CHARACTER(LEN=lc) :: cl_base
406      CHARACTER(LEN=lc) :: cl_suffix
407      CHARACTER(LEN=lc) :: cl_segnum
408      CHARACTER(LEN=lc) :: cl_date
409      CHARACTER(LEN=lc) :: cl_name
410
411      INTEGER(i4)       :: il_ind
412      INTEGER(i4)       :: il_indend
413
414      ! loop indices
415      !----------------------------------------------------------------
416      ! init
417      boundary_set_filename=''
418
419      IF( TRIM(cd_file) /= '' .AND. TRIM(cd_card) /= '' )THEN
420
421         cl_dirname = fct_dirname( TRIM(cd_file))
422         IF( TRIM(cl_dirname) == '' ) cl_dirname='.'
423
424         cl_basename= fct_basename(TRIM(cd_file))
425
426         cl_base  =fct_split(TRIM(cl_basename),1,'.')
427         cl_suffix=fct_split(TRIM(cl_basename),2,'.')
428         
429         ! add segment number
430         IF( PRESENT(id_seg) )THEN
431            cl_segnum="_"//TRIM(fct_str(id_seg))
432         ELSE
433            cl_segnum=""
434         ENDIF
435
436         ! add date
437         IF( PRESENT(cd_date) )THEN
438            cl_date="_"//TRIM(ADJUSTL(cd_date))
439         ELSE
440            cl_date=""
441         ENDIF
442
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
456
457         boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name)
458      ELSE
459         CALL logger_error("BOUNDARY SET FILENAME: file or cardinal name "//&
460         &  " are empty")
461      ENDIF
462 
463   END FUNCTION boundary_set_filename 
464   !-------------------------------------------------------------------
465   !> @brief This function initialise a boundary structure.
466   !
467   !> @details
468   !>  Boundaries for each cardinal will be compute with variable structure.
469   !>  It means that orthogonal index, first and last indices of each
470   !>  sea segment will be compute automatically.
471   !>  However you could specify which boundary to use or not with
472   !>  arguments ln_north, ln_south, ln_east, ln_west.
473   !>  And boundary description could be specify with argument
474   !>  cn_north, cn_south, cn_east, cn_west.
475   !>  For each cardinal you could specify orthogonal index,
476   !>  first and last indices (in this order) and boundary width (between
477   !>  parentheses).
478   !> ex : cn_north='index,first,last(width)'
479   !> You could specify more than one segment for each boundary.
480   !> However each segment will have the same width. So you do not need to
481   !> specify it for each segment.
482   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2'
483   !>
484   !> @warn 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.
486   !>
487   !> @author J.Paul
488   !> @date November, 2013 - Initial Version
489   !> @date September, 2014
490   !> - add boolean to use only one segment for each boundary
491   !> - check boundary width
492   !
493   !> @param[in] td_var    variable structure
494   !> @param[in] ld_north  use north boundary or not
495   !> @param[in] ld_south  use south boundary or not
496   !> @param[in] ld_east   use east  boundary or not
497   !> @param[in] ld_west   use west  boundary or not
498   !> @param[in] cd_north  north boundary description
499   !> @param[in] cd_south  south boundary description
500   !> @param[in] cd_east   east  boundary description
501   !> @param[in] cd_west   west  boundary description
502   !> @param[in] ld_oneseg force to use only one segment for each boundary
503   !> @return boundary structure
504   !-------------------------------------------------------------------
505   FUNCTION boundary__init_wrapper(td_var, &
506   &                               ld_north, ld_south, ld_east, ld_west, &
507   &                               cd_north, cd_south, cd_east, cd_west, &
508   &                               ld_oneseg ) 
509      IMPLICIT NONE 
510      ! Argument
511      TYPE(TVAR)       , INTENT(IN) :: td_var
512      LOGICAL          , INTENT(IN), OPTIONAL :: ld_north
513      LOGICAL          , INTENT(IN), OPTIONAL :: ld_south
514      LOGICAL          , INTENT(IN), OPTIONAL :: ld_east 
515      LOGICAL          , INTENT(IN), OPTIONAL :: ld_west 
516      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_north
517      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_south
518      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_east 
519      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_west
520      LOGICAL          , INTENT(IN), OPTIONAL :: ld_oneseg 
521
522      ! function
523      TYPE(TBDY), DIMENSION(ip_ncard) :: boundary__init_wrapper
524
525      ! local variable
526      INTEGER(i4)                            :: il_width
527      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max_width
528      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_index
529      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_min
530      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
531
532      CHARACTER(LEN=lc), DIMENSION(ip_ncard) :: cl_card
533
534      TYPE(TBDY)       , DIMENSION(ip_ncard) :: tl_bdy
535      TYPE(TBDY)                             :: tl_tmp
536
537      TYPE(TSEG)                             :: tl_seg
538
539      LOGICAL                                :: ll_oneseg
540
541      ! loop indices
542      INTEGER(i4) :: ji
543      INTEGER(i4) :: jk
544      !----------------------------------------------------------------
545      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
546         CALL logger_error("BOUNDARY INIT: no value associated to variable "//&
547         &              TRIM(td_var%c_name) )
548      ELSEIF( TRIM(td_var%c_point) /= 'T' )THEN
549         CALL logger_error("BOUNDARY INIT: can not compute boundary with "//&
550         &                 "variable "//TRIM(td_var%c_name)//&
551         &                 ". need a variable on T point." )
552      ELSE
553         ll_oneseg=.TRUE.
554         IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
555
556         ! init
557         tl_bdy(jp_north)=boundary__init('north',ld_north)
558         tl_bdy(jp_south)=boundary__init('south',ld_south)
559         tl_bdy(jp_east )=boundary__init('east ',ld_east )
560         tl_bdy(jp_west )=boundary__init('west ',ld_west )
561
562         ! if EW cyclic no east west boundary and force to use one segment
563         IF( td_var%i_ew >= 0 )THEN
564            CALL logger_info("BOUNDARY INIT: cyclic domain, "//&
565            &  "no East West boundary")
566            tl_bdy(jp_east )%l_use=.FALSE.
567            tl_bdy(jp_west )%l_use=.FALSE.
568
569            CALL logger_info("BOUNDARY INIT: force to use one segment due"//&
570            &  " to EW cyclic domain")
571            ll_oneseg=.TRUE.
572         ENDIF
573
574         il_index(jp_north)=td_var%t_dim(2)%i_len-ip_ghost
575         il_index(jp_south)=1+ip_ghost
576         il_index(jp_east )=td_var%t_dim(1)%i_len-ip_ghost
577         il_index(jp_west )=1+ip_ghost
578
579         il_min(jp_north)=1
580         il_min(jp_south)=1
581         il_min(jp_east )=1
582         il_min(jp_west )=1
583
584         il_max(jp_north)=td_var%t_dim(1)%i_len
585         il_max(jp_south)=td_var%t_dim(1)%i_len
586         il_max(jp_east )=td_var%t_dim(2)%i_len
587         il_max(jp_west )=td_var%t_dim(2)%i_len
588 
589         cl_card=(/'','','',''/)
590         IF( PRESENT(cd_north) ) cl_card(jp_north)=TRIM(cd_north)
591         IF( PRESENT(cd_south) ) cl_card(jp_south)=TRIM(cd_south)
592         IF( PRESENT(cd_east ) ) cl_card(jp_east )=TRIM(cd_east )
593         IF( PRESENT(cd_west ) ) cl_card(jp_west )=TRIM(cd_west )
594
595         il_max_width(jp_north)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost))
596         il_max_width(jp_south)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost))
597         il_max_width(jp_east )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost))
598         il_max_width(jp_west )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost))
599
600         DO jk=1,ip_ncard
601
602            ! check boundary width
603            IF( il_max_width(jk) <= im_width )THEN
604               IF( il_max_width(jk) <= 0 )THEN
605                  CALL logger_fatal("BOUNDARY INIT: domain too small to define"//&
606                  &                " boundaries.")
607               ELSE
608                  CALL logger_warn("BOUNDARY INIT: default boundary width too "//&
609                  &                "large for boundaries. force to use boundary"//&
610                  &                " on one point")
611                  il_width=1
612               ENDIF
613            ELSE
614               il_width=im_width
615            ENDIF
616
617            ! define default segment
618            tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk))
619
620            IF( tl_bdy(jk)%l_use )THEN
621
622               ! get namelist information
623               tl_tmp=boundary__get_info(cl_card(jk),jk)
624
625               ! get segments indices
626               DO ji=1,tl_tmp%i_nseg
627                  CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji))
628               ENDDO
629               ! indices from namelist or not
630               tl_bdy(jk)%l_nam=tl_tmp%l_nam
631
632               CALL boundary_clean(tl_tmp)
633
634               IF( tl_bdy(jk)%i_nseg == 0 )THEN
635                  ! add default segment
636                  CALL boundary__add_seg(tl_bdy(jk),tl_seg)
637               ELSE
638                  ! fill undefined value
639                  WHERE( tl_bdy(jk)%t_seg(:)%i_index == 0 ) 
640                     tl_bdy(jk)%t_seg(:)%i_index = tl_seg%i_index
641                  END WHERE               
642                  WHERE( tl_bdy(jk)%t_seg(:)%i_width == 0 ) 
643                     tl_bdy(jk)%t_seg(:)%i_width = tl_seg%i_width
644                  END WHERE
645                  WHERE( tl_bdy(jk)%t_seg(:)%i_first == 0 ) 
646                     tl_bdy(jk)%t_seg(:)%i_first = tl_seg%i_first
647                  END WHERE
648                  WHERE( tl_bdy(jk)%t_seg(:)%i_last == 0 ) 
649                     tl_bdy(jk)%t_seg(:)%i_last = tl_seg%i_last
650                  END WHERE
651               ENDIF
652
653            ENDIF
654            ! clean
655            CALL seg__clean(tl_seg)
656
657         ENDDO
658
659         CALL boundary_get_indices(tl_bdy(:), td_var, ll_oneseg)
660
661         CALL boundary_check(tl_bdy, td_var)
662
663         boundary__init_wrapper(:)=boundary_copy(tl_bdy(:))
664
665         ! clean
666         DO jk=1,ip_ncard
667            CALL boundary_clean(tl_bdy(jk))
668         ENDDO
669
670      ENDIF
671 
672   END FUNCTION boundary__init_wrapper 
673   !-------------------------------------------------------------------
674   !> @brief This function initialise basically a boundary structure with
675   !> cardinal name.
676   !
677   !> @details
678   !> optionnaly you could specify if this boundary is used or not,
679   !> and add one segment structure.
680   !
681   !> @author J.Paul
682   !> @date November, 2013 - Initial Version
683   !
684   !> @param[in]  cd_card  cardinal name
685   !> @param[in]  ld_use   boundary use or not
686   !> @param[in]  td_seg   segment structure
687   !> @return boundary structure
688   !-------------------------------------------------------------------
689   FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg ) 
690      IMPLICIT NONE 
691      ! Argument
692      CHARACTER(LEN=*), INTENT(IN) :: cd_card
693      LOGICAL         , INTENT(IN), OPTIONAL :: ld_use 
694      LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam 
695      TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg
696
697      ! function
698      TYPE(TBDY) :: boundary__init
699
700      ! local variable
701     
702      ! loop indices
703      !----------------------------------------------------------------
704
705      SELECT CASE(TRIM(cd_card))
706         CASE ('north','south','east','west')
707         
708            boundary__init%c_card=TRIM(cd_card)
709
710            boundary__init%l_use=.TRUE.
711            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
715
716            IF( PRESENT(td_seg) )THEN
717               CALL boundary__add_seg(boundary__init, td_seg)
718            ENDIF
719
720         CASE DEFAULT
721            CALL logger_error("BOUNDARY INIT: invalid cardinal name")
722      END SELECT
723
724   END FUNCTION boundary__init
725   !-------------------------------------------------------------------
726   !> @brief This subroutine add one segment structure to a boundary structure
727   !
728   !> @details
729   !
730   !> @author J.Paul
731   !> @date November, 2013 - Initial Version
732   !
733   !> @param[inout] td_bdy boundary structure 
734   !> @param[in] td_seg    segment structure 
735   !-------------------------------------------------------------------
736   SUBROUTINE boundary__add_seg(td_bdy, td_seg) 
737      IMPLICIT NONE 
738      ! Argument
739      TYPE(TBDY), INTENT(INOUT) :: td_bdy
740      TYPE(TSEG), INTENT(IN   ) :: td_seg
741
742      ! local variable
743      INTEGER(i4)                            :: il_status
744      TYPE(TSEG) , DIMENSION(:), ALLOCATABLE :: tl_seg
745
746      ! loop indices
747      !----------------------------------------------------------------
748
749      IF( td_bdy%i_nseg > 0 )THEN
750         ! already other segment in boundary structure
751         ALLOCATE( tl_seg(td_bdy%i_nseg), stat=il_status )
752         IF(il_status /= 0 )THEN
753            CALL logger_error( &
754            &  " BOUNDARY ADD SEG: not enough space to put segments ")
755         ELSE
756            ! save temporary segment
757            tl_seg(:)=seg__copy(td_bdy%t_seg(:))
758
759            CALL seg__clean(td_bdy%t_seg(:))
760            DEALLOCATE( td_bdy%t_seg )
761            ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
762            IF(il_status /= 0 )THEN
763               CALL logger_error( &
764               &  " BOUNDARY ADD SEG: not enough space to put segments ")
765            ENDIF
766
767            ! copy segment in boundary before
768            td_bdy%t_seg(1:td_bdy%i_nseg)=seg__copy(tl_seg(:))
769
770            ! clean
771            CALL seg__clean(tl_seg(:))
772            DEALLOCATE(tl_seg)           
773           
774         ENDIF
775      ELSE
776         ! no segment in boundary structure
777         IF( ASSOCIATED(td_bdy%t_seg) )THEN
778            CALL seg__clean(td_bdy%t_seg(:))
779            DEALLOCATE(td_bdy%t_seg)
780         ENDIF
781         ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
782         IF(il_status /= 0 )THEN
783            CALL logger_error( &
784            &  " BOUNDARY ADD SEG: not enough space to put segments ")
785         ENDIF         
786      ENDIF
787 
788      ! update number of segment
789      td_bdy%i_nseg=td_bdy%i_nseg+1
790
791      ! add new segment
792      td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg)
793
794   END SUBROUTINE boundary__add_seg 
795   !-------------------------------------------------------------------
796   !> @brief This subroutine remove all segments of a boundary structure
797   !
798   !> @details
799   !
800   !> @author J.Paul
801   !> @date November, 2013 - Initial Version
802   !
803   !> @param[inout]  td_bdy   boundary structure
804   !-------------------------------------------------------------------
805   SUBROUTINE boundary__del_seg(td_bdy) 
806      IMPLICIT NONE 
807      ! Argument
808      TYPE(TBDY), INTENT(INOUT) :: td_bdy
809
810      ! local variable
811      ! loop indices
812      !----------------------------------------------------------------
813
814      IF( ASSOCIATED(td_bdy%t_seg) )THEN
815         CALL seg__clean(td_bdy%t_seg(:))
816         DEALLOCATE(td_bdy%t_seg)
817      ENDIF
818      !update number of segment
819      td_bdy%i_nseg=0
820
821   END SUBROUTINE boundary__del_seg 
822   !-------------------------------------------------------------------
823   !> @brief This function get information about boundary from string character.
824   !
825   !> @details
826   !> This string character that will be passed through namelist could contains
827   !> orthogonal index, first and last indices, of each segment.
828   !> And also the width of all segments of this boundary.
829   !>   cn_north='index1,first1:last1(width)|index2,first2:last2'
830   !>
831   !> @author J.Paul
832   !> @date November, 2013 - Initial Version
833   !> @date february, 2015
834   !> - do not change indices read from namelist
835   !> - change format cn_north
836   !
837   !> @param[in] cd_card   boundary description
838   !> @param[in] id_jcard  boundary index
839   !> @return boundary structure
840   !-------------------------------------------------------------------
841   FUNCTION boundary__get_info(cd_card, id_jcard) 
842      IMPLICIT NONE 
843      ! Argument
844      CHARACTER(LEN=lc), INTENT(IN) :: cd_card
845      INTEGER(i4)      , INTENT(IN) :: id_jcard
846
847      ! function
848      TYPE(TBDY) :: boundary__get_info
849
850      ! local variable
851      INTEGER(i4)       :: il_width
852      INTEGER(i4)       :: il_ind1
853      INTEGER(i4)       :: il_ind2
854
855      CHARACTER(LEN=lc) :: cl_seg
856      CHARACTER(LEN=lc) :: cl_index
857      CHARACTER(LEN=lc) :: cl_width
858      CHARACTER(LEN=lc) :: cl_tmp
859      CHARACTER(LEN=lc) :: cl_first
860      CHARACTER(LEN=lc) :: cl_last 
861
862      TYPE(TSEG)        :: tl_seg
863
864      ! loop indices
865      INTEGER(i4) :: ji
866      !----------------------------------------------------------------
867 
868      ji=1
869      cl_seg=fct_split(cd_card,ji)
870
871      il_width=0
872      ! look for segment width
873      ! width should be the same for all segment of one boundary
874      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
880         il_ind1=SCAN(fct_lower(cl_seg),'(')
881         IF( il_ind1 /=0 )THEN
882            cl_width=TRIM(cl_seg(il_ind1+1:))
883
884            il_ind2=SCAN(fct_lower(cl_width),')')
885            IF( il_ind2 /=0 )THEN
886               cl_width=TRIM(cl_width(1:il_ind2-1))
887               READ(cl_width,*) il_width
888            ELSE
889               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
890               &  " check namelist. ")
891            ENDIF
892         ENDIF
893
894      ENDIF
895
896      DO WHILE( TRIM(cl_seg) /= '' )
897
898         cl_index=fct_split(cl_seg,1,',')
899         ! remove potential width information
900         il_ind1=SCAN(fct_lower(cl_index),'(')
901         IF( il_ind1 /=0 )THEN
902            il_ind2=SCAN(fct_lower(cl_index),')')
903            IF( il_ind2 /=0 )THEN
904               cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:))
905            ELSE
906               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
907               &  " check namelist. ")
908            ENDIF
909         ENDIF
910     
911         
912         cl_tmp=fct_split(cl_seg,2,',')
913
914
915         cl_first=fct_split(cl_tmp,1,':')
916         ! remove potential width information
917         il_ind1=SCAN(fct_lower(cl_first),'(')
918         IF( il_ind1 /=0 )THEN
919            il_ind2=SCAN(fct_lower(cl_first),')')
920            IF( il_ind2 /=0 )THEN
921               cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:))
922            ELSE
923               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
924               &  " check namelist. ")
925            ENDIF
926         ENDIF         
927         
928         cl_last =fct_split(cl_tmp,2,':')
929         ! remove potential width information
930         il_ind1=SCAN(fct_lower(cl_last),'(')
931         IF( il_ind1 /=0 )THEN
932            il_ind2=SCAN(fct_lower(cl_last),')')
933            IF( il_ind2 /=0 )THEN
934               cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:))
935            ELSE
936               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
937               &  " check namelist. ")
938            ENDIF
939         ENDIF
940
941         IF( il_width /= 0 ) tl_seg%i_width=il_width
942
943         IF( TRIM(cl_index) /= '' ) READ(cl_index,*) tl_seg%i_index
944         IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first
945         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
952
953         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. &
954         &   (tl_seg%i_first /= 0 .AND.  tl_seg%i_last /= 0) )THEN
955            CALL boundary__add_seg(boundary__get_info, tl_seg)
956         ELSE
957            CALL logger_error("BOUNDARY INIT: first or last segment indices "//&
958            &              "are missing . check namelist.")
959         ENDIF
960
961         ji=ji+1
962         cl_seg=fct_split(cd_card,ji)
963
964         ! clean
965         CALL seg__clean(tl_seg)
966      ENDDO 
967
968   END FUNCTION boundary__get_info 
969   !-------------------------------------------------------------------
970   !> @brief This subroutine get indices of each semgent for each boundary.
971   !
972   !> @details
973   !> indices are compute from variable value, actually variable fill value,
974   !> which is assume to be land mask.
975   !> Boundary structure should have been initialized before running
976   !> this subroutine. Segment indices will be search between first and last
977   !> indies, at this orthogonal index.
978   !>
979   !> Optionnally you could forced to use only one segment for each boundary.
980   !>
981   !> @warning number of segment (i_nseg) will be change, before the number
982   !> of segment structure
983   !
984   !> @author J.Paul
985   !> @date November, 2013 - Initial Version
986   !
987   !> @param[inout] td_bdy boundary structure 
988   !> @param[in] td_var    variable structure
989   !> @param[in] ld_onseg  use only one sgment for each boundary
990   !-------------------------------------------------------------------
991   SUBROUTINE boundary_get_indices( td_bdy, td_var, ld_oneseg) 
992      IMPLICIT NONE 
993      ! Argument
994      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
995      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
996      LOGICAL                         , INTENT(IN   ), OPTIONAL :: ld_oneseg
997
998      ! local variable
999      INTEGER(i4) :: il_index
1000      INTEGER(i4) :: il_width
1001      INTEGER(i4) :: il_first
1002      INTEGER(i4) :: il_last 
1003
1004      LOGICAL     :: ll_oneseg
1005
1006      TYPE(TSEG)  :: tl_seg
1007
1008      ! loop indices
1009      INTEGER(i4) :: jk
1010      !----------------------------------------------------------------
1011 
1012      ll_oneseg=.TRUE.
1013      IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
1014
1015      DO jk=1,ip_ncard
1016         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN
1017            ! nothing to be done
1018         ELSE
1019
1020            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
1021               CALL logger_error("BOUNDARY GET INDICES: no segment "//&
1022               &  " associated to "//TRIM(td_bdy(jk)%c_card)//&
1023               &  " boundary. you should have run boundary_init before"//&
1024               &  " running boundary_get_indices" )
1025            ELSE
1026               il_index=td_bdy(jk)%t_seg(1)%i_index
1027               il_width=td_bdy(jk)%t_seg(1)%i_width
1028               il_first=td_bdy(jk)%t_seg(1)%i_first
1029               il_last =td_bdy(jk)%t_seg(1)%i_last
1030 
1031               CALL boundary__get_seg_number( td_bdy(jk), td_var)
1032
1033               CALL boundary__get_seg_indices( td_bdy(jk), td_var, &
1034               &                               il_index, il_width, &
1035               &                               il_first, il_last )
1036
1037               IF( ll_oneseg .AND. td_bdy(jk)%l_use )THEN
1038                  tl_seg=seg__copy(td_bdy(jk)%t_seg(1))
1039                  ! use last indice of last segment
1040                  tl_seg%i_last=td_bdy(jk)%t_seg(td_bdy(jk)%i_nseg)%i_last
1041
1042                  ! remove all segment from boundary
1043                  CALL boundary__del_seg(td_bdy(jk))
1044
1045                  ! add one segment
1046                  CALL boundary__add_seg(td_bdy(jk),tl_seg)
1047
1048                  ! clean
1049                  CALL seg__clean(tl_seg)
1050               ENDIF
1051
1052            ENDIF
1053
1054         ENDIF
1055
1056      ENDDO
1057
1058   END SUBROUTINE boundary_get_indices 
1059   !-------------------------------------------------------------------
1060   !> @brief This subroutine compute the number of sea segment.
1061   !
1062   !> @details
1063   !> It use variable value, actually variable fill value
1064   !> (which is assume to be land mask), to compute the number of segment between
1065   !> first and last indices at boundary orthogonal index.
1066   !> @warning number of segment (i_nseg) will be change, before the number
1067   !> of segment structure
1068   !
1069   !> @author J.Paul
1070   !> @date November, 2013 - Initial Version
1071   !
1072   !> @param[inout] td_bdy boundary structure
1073   !> @param[in] td_var    variable structure
1074   !-------------------------------------------------------------------
1075   SUBROUTINE boundary__get_seg_number( td_bdy, td_var) 
1076      IMPLICIT NONE 
1077      ! Argument
1078      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
1079      TYPE(TVAR) , INTENT(IN   ) :: td_var
1080
1081      ! local variable
1082      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
1083      LOGICAL                                        :: ll_sea
1084      INTEGER(i4)                                    :: il_index
1085
1086      ! loop indices
1087      INTEGER(i4) :: ji
1088      !----------------------------------------------------------------
1089 
1090      IF( td_bdy%l_use .AND. td_bdy%i_nseg == 1 )THEN
1091
1092         il_index=td_bdy%t_seg(1)%i_index
1093
1094         SELECT CASE(TRIM(td_bdy%c_card))
1095            CASE('north','south')
1096
1097               ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
1098               dl_value(:)=td_var%d_value(:,il_index,1,1)
1099
1100               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
1101                 
1102                  td_bdy%l_use=.TRUE.
1103                  td_bdy%i_nseg=0
1104
1105                  ll_sea=.FALSE.
1106                  DO ji=1,td_var%t_dim(1)%i_len
1107                     IF( dl_value(ji)/= td_var%d_fill )THEN
1108                        IF( .NOT. ll_sea )THEN
1109                           td_bdy%i_nseg=td_bdy%i_nseg+1
1110                        ENDIF
1111                        ll_sea=.TRUE.
1112                     ELSE
1113                        ll_sea=.FALSE.
1114                     ENDIF
1115                  ENDDO
1116
1117               ELSE
1118                  td_bdy%l_use=.FALSE.
1119                  td_bdy%i_nseg=0
1120               ENDIF
1121
1122               DEALLOCATE( dl_value )
1123
1124            CASE('east','west')
1125
1126               ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
1127               dl_value(:)=td_var%d_value(il_index,:,1,1)
1128
1129               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
1130                 
1131                  td_bdy%l_use=.TRUE.
1132                  td_bdy%i_nseg=0
1133
1134                  ll_sea=.FALSE.
1135                  DO ji=1,td_var%t_dim(2)%i_len
1136                     IF( dl_value(ji)/= td_var%d_fill )THEN
1137                        IF( .NOT. ll_sea )THEN
1138                           td_bdy%i_nseg=td_bdy%i_nseg+1
1139                        ENDIF
1140                        ll_sea=.TRUE.
1141                     ELSE
1142                        ll_sea=.FALSE.
1143                     ENDIF
1144                  ENDDO
1145
1146               ELSE
1147                  td_bdy%l_use=.FALSE.
1148                  td_bdy%i_nseg=0
1149               ENDIF
1150
1151               DEALLOCATE( dl_value )
1152
1153         END SELECT
1154      ENDIF
1155 
1156   END SUBROUTINE boundary__get_seg_number 
1157   !-------------------------------------------------------------------
1158   !> @brief This subroutine get segment indices for one boundary.
1159   !
1160   !> @details
1161   !
1162   !> @author J.Paul
1163   !> @date November, 2013 - Initial Version
1164   !
1165   !> @param[inout] td_bdy boundary structure 
1166   !> @param[in] td_var    variable structure 
1167   !> @param[in] id_index  boundary orthogonal index 
1168   !> @param[in] id_width  bounary width
1169   !> @param[in] id_first  boundary first indice
1170   !> @param[in] id_last   boundary last  indice
1171   !-------------------------------------------------------------------
1172   SUBROUTINE boundary__get_seg_indices( td_bdy, td_var, &
1173   &                                     id_index, id_width, id_first, id_last) 
1174      IMPLICIT NONE 
1175      ! Argument
1176      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
1177      TYPE(TVAR) , INTENT(IN   ) :: td_var
1178      INTEGER(i4), INTENT(IN   ) :: id_index
1179      INTEGER(i4), INTENT(IN   ) :: id_width
1180      INTEGER(i4), INTENT(IN   ) :: id_first
1181      INTEGER(i4), INTENT(IN   ) :: id_last
1182
1183      ! local variable
1184      INTEGER(i4)                                    :: il_nseg
1185      INTEGER(i4), DIMENSION(ip_ncard)               :: il_max
1186      INTEGER(i4), DIMENSION(ip_ncard)               :: il_min
1187
1188      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
1189
1190      LOGICAL                                        :: ll_sea
1191      LOGICAL                                        :: ll_first
1192      LOGICAL                                        :: ll_last
1193
1194      TYPE(TSEG)                                     :: tl_seg
1195
1196      ! loop indices
1197      INTEGER(i4) :: ji
1198      INTEGER(i4) :: jk
1199      INTEGER(i4) :: jl
1200      !----------------------------------------------------------------
1201 
1202      SELECT CASE(TRIM(td_bdy%c_card))
1203         CASE('north')
1204            jk=jp_north
1205           
1206            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
1207            dl_value(:)=td_var%d_value(:,id_index,1,1)
1208
1209         CASE('south')
1210            jk=jp_south
1211
1212            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
1213            dl_value(:)=td_var%d_value(:,id_index,1,1)
1214
1215         CASE('east ')
1216            jk=jp_east 
1217
1218            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
1219            dl_value(:)=td_var%d_value(id_index,:,1,1)
1220
1221         CASE('west ')
1222            jk=jp_west 
1223
1224            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
1225            dl_value(:)=td_var%d_value(id_index,:,1,1)
1226
1227      END SELECT
1228
1229      il_max(jp_north)=td_var%t_dim(1)%i_len-ip_ghost
1230      il_max(jp_south)=td_var%t_dim(1)%i_len-ip_ghost
1231      il_max(jp_east )=td_var%t_dim(2)%i_len-ip_ghost
1232      il_max(jp_west )=td_var%t_dim(2)%i_len-ip_ghost
1233
1234      il_min(jp_north)=1+ip_ghost
1235      il_min(jp_south)=1+ip_ghost
1236      il_min(jp_east )=1+ip_ghost
1237      il_min(jp_west )=1+ip_ghost
1238         
1239      ! special case for EW cyclic
1240      IF( td_var%i_ew >= 0 )THEN
1241         il_min(jp_north)=1
1242         il_min(jp_south)=1
1243
1244         il_max(jp_north)=td_var%t_dim(1)%i_len
1245         il_max(jp_south)=td_var%t_dim(1)%i_len
1246      ENDIF
1247     
1248      il_nseg=td_bdy%i_nseg
1249      ! remove all segment from boundary
1250      CALL boundary__del_seg(td_bdy)
1251
1252      ll_first=.FALSE.
1253      ll_last =.FALSE.
1254      DO jl=1,il_nseg
1255
1256         ! init
1257         tl_seg=seg__init(id_index,id_width,id_first,id_last)
1258
1259         IF( .NOT. (ll_first .AND. ll_last) )THEN
1260            ! first loop
1261            tl_seg%i_first=MAX(id_first,il_min(jk))
1262            tl_seg%i_last =MIN(id_last ,il_max(jk))
1263         ELSE
1264            ! load new min and max
1265            tl_seg%i_first=MAX(td_bdy%t_seg(jl-1)%i_last,il_min(jk))
1266            tl_seg%i_last =MIN(id_last                  ,il_max(jk))
1267         ENDIF
1268
1269         ll_first=.FALSE.
1270         ll_last =.FALSE.
1271         ll_sea  =.FALSE.
1272
1273         DO ji=tl_seg%i_first,tl_seg%i_last
1274
1275            IF( ll_first .AND. ll_last )THEN
1276               ! first and last point already loaded
1277               ! look for next segment
1278               EXIT
1279            ENDIF
1280
1281            IF( dl_value(ji)/= td_var%d_fill )THEN
1282               IF( .NOT. ll_sea )THEN
1283                  tl_seg%i_first=MAX(tl_seg%i_first,ji-1)
1284                  ll_first=.true.
1285               ENDIF
1286               ll_sea=.TRUE.
1287            ELSE
1288               IF( ll_sea )THEN
1289                  tl_seg%i_last=ji
1290                  ll_last=.TRUE.
1291               ENDIF
1292               ll_sea=.FALSE.
1293            ENDIF
1294           
1295         ENDDO
1296
1297         CALL boundary__add_seg(td_bdy,tl_seg)
1298
1299         ! clean
1300         CALL seg__clean(tl_seg)
1301         
1302      ENDDO
1303
1304      DEALLOCATE(dl_value)
1305     
1306   END SUBROUTINE boundary__get_seg_indices 
1307   !-------------------------------------------------------------------
1308   !> @brief This subroutine check if there is boundary at corner, and
1309   !> adjust boundary indices if necessary.
1310   !
1311   !> @details
1312   !> If there is a north west corner, first indices of north boundary
1313   !> should be the same as the west boundary indices.
1314   !> And the last indices of the west boundary should be the same as
1315   !> the north indices.
1316   !> More over the width of west and north boundary should be the same.
1317   !
1318   !> @author J.Paul
1319   !> @date November, 2013 - Initial Version
1320   !
1321   !> @param[inout] td_bdy boundary structure
1322   !> @param[in] td_var    variable structure
1323   !-------------------------------------------------------------------
1324   SUBROUTINE boundary_check_corner( td_bdy, td_var )
1325      IMPLICIT NONE 
1326      ! Argument
1327      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
1328      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
1329
1330      ! local variable
1331      TYPE(TSEG)  :: tl_north
1332      TYPE(TSEG)  :: tl_south
1333      TYPE(TSEG)  :: tl_east 
1334      TYPE(TSEG)  :: tl_west
1335
1336      INTEGER(i4) :: il_width
1337
1338      ! loop indices
1339      !----------------------------------------------------------------
1340 
1341      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
1342         CALL logger_error("BOUNDARY CHEKC CORNER: no value associated "//&
1343         &              "to variable "//TRIM(td_var%c_name))
1344      ENDIF
1345
1346      ! check north west corner
1347      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_west)%l_use )THEN
1348         tl_west =seg__copy(td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg))
1349         tl_north=seg__copy(td_bdy(jp_north)%t_seg(1))
1350
1351         IF( tl_west%i_last  >= tl_north%i_index .AND. &
1352         &   tl_west%i_index >= tl_north%i_first ) THEN
1353            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1354            &                 "a north west corner")
1355
1356            tl_west%i_last   = tl_north%i_index
1357            tl_north%i_first = tl_west%i_index
1358
1359            IF( tl_west%i_width /= tl_north%i_width )THEN
1360               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1361               &  " width between north and west boundary ")
1362
1363               il_width=MIN(tl_west%i_width,tl_north%i_width)
1364               
1365               tl_west%i_width =il_width
1366               tl_north%i_width=il_width
1367
1368            ENDIF
1369
1370            td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)=seg__copy(tl_west)
1371            td_bdy(jp_north)%t_seg(1)                     =seg__copy(tl_north)
1372
1373         ELSE
1374
1375            IF( td_var%d_value(tl_north%i_first,tl_north%i_index,1,1) /= &
1376            &   td_var%d_fill )THEN
1377               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1378               &              "north boundary first indice ")
1379            ENDIF
1380
1381            IF( td_var%d_value(tl_west%i_index,tl_west%i_last,1,1) /= &
1382            &   td_var%d_fill )THEN
1383               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1384               &              "west boundary last indice")
1385            ENDIF
1386         ENDIF
1387      ENDIF
1388
1389      ! check north east corner
1390      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_east)%l_use )THEN
1391         tl_east =seg__copy(td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg))
1392         tl_north=seg__copy(td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg))
1393
1394         IF( tl_east%i_last  >= tl_north%i_index .AND. &
1395         &   tl_east%i_index <= tl_north%i_last ) THEN
1396            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1397            &              "a north east corner")
1398
1399            tl_east%i_last  = tl_north%i_index
1400            tl_north%i_last = tl_east%i_index
1401
1402            IF( tl_east%i_width /= tl_north%i_width )THEN
1403               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1404               &  " width between north and east boundary ")
1405
1406               il_width=MIN(tl_east%i_width,tl_north%i_width)
1407               
1408               tl_east%i_width =il_width
1409               tl_north%i_width=il_width
1410
1411            ENDIF
1412
1413            td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)=seg__copy(tl_east)
1414            td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)=seg__copy(tl_north)
1415         ELSE
1416
1417            IF( td_var%d_value(tl_north%i_last,tl_north%i_index,1,1) /= &
1418            &   td_var%d_fill )THEN
1419               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1420               &              "north boundary last indice ")
1421            ENDIF
1422
1423            IF( td_var%d_value(tl_east%i_index,tl_east%i_last,1,1) /= &
1424            &   td_var%d_fill )THEN
1425               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1426               &              "east boundary last indice")
1427            ENDIF
1428         ENDIF
1429      ENDIF
1430
1431      ! check south east corner
1432      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_east)%l_use )THEN
1433         tl_east =seg__copy(td_bdy(jp_east )%t_seg(1))
1434         tl_south=seg__copy(td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg))
1435
1436         IF( tl_east%i_first <= tl_south%i_index .AND. &
1437         &   tl_east%i_index <= tl_south%i_last ) THEN
1438            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1439            &              "a south east corner")
1440
1441            tl_east%i_first = tl_south%i_index
1442            tl_south%i_last = tl_east%i_index
1443
1444            IF( tl_east%i_width /= tl_south%i_width )THEN
1445               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1446               &  " width between south and east boundary ")
1447
1448               il_width=MIN(tl_east%i_width,tl_south%i_width)
1449               
1450               tl_east%i_width =il_width
1451               tl_south%i_width=il_width
1452
1453            ENDIF
1454
1455            td_bdy(jp_east )%t_seg(1)                      =seg__copy(tl_east)
1456            td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)=seg__copy(tl_south)
1457         ELSE
1458
1459            IF( td_var%d_value(tl_south%i_last,tl_south%i_index,1,1) /= &
1460            &   td_var%d_fill )THEN
1461               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1462               &              "south boundary last indice ")
1463            ENDIF
1464
1465            IF( td_var%d_value(tl_east%i_index,tl_east%i_first,1,1) /= &
1466            &   td_var%d_fill )THEN
1467               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1468               &              "east boundary first indice")
1469            ENDIF
1470         ENDIF
1471      ENDIF
1472
1473      ! check south west corner
1474      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_west)%l_use )THEN
1475         tl_west =seg__copy(td_bdy(jp_west )%t_seg(1))
1476         tl_south=seg__copy(td_bdy(jp_south)%t_seg(1))
1477
1478         IF( tl_west%i_first <= tl_south%i_index .AND. &
1479         &   tl_west%i_index >= tl_south%i_first ) THEN
1480            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1481            &              "a south west corner")
1482
1483            tl_west%i_first = tl_south%i_index
1484            tl_south%i_first= tl_west%i_index
1485
1486            IF( tl_west%i_width /= tl_south%i_width )THEN
1487               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1488               &  " width between south and west boundary ")
1489
1490               il_width=MIN(tl_west%i_width,tl_south%i_width)
1491               
1492               tl_west%i_width =il_width
1493               tl_south%i_width=il_width
1494
1495            ENDIF
1496
1497            td_bdy(jp_west )%t_seg(1) = seg__copy(tl_west)
1498            td_bdy(jp_south)%t_seg(1) = seg__copy(tl_south)
1499         ELSE
1500
1501            IF( td_var%d_value(tl_south%i_first,tl_south%i_index,1,1) /= &
1502            &   td_var%d_fill )THEN
1503               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1504               &              "south boundary first indice ")
1505            ENDIF
1506
1507            IF( td_var%d_value(tl_west%i_index,tl_west%i_first,1,1) /= &
1508            &   td_var%d_fill )THEN
1509               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1510               &              "west boundary first indice")
1511            ENDIF
1512         ENDIF
1513      ENDIF
1514
1515      ! clean
1516      CALL seg__clean(tl_north)
1517      CALL seg__clean(tl_south)
1518      CALL seg__clean(tl_east )
1519      CALL seg__clean(tl_west )
1520
1521   END SUBROUTINE boundary_check_corner 
1522   !-------------------------------------------------------------------
1523   !> @brief This subroutine check boundary.
1524   !
1525   !> @details
1526   !> It checks that first and last indices as well as orthogonal index are
1527   !> inside domain, and check corner (see boundary_check_corner).
1528   !
1529   !> @author J.Paul
1530   !> @date November, 2013 - Initial Version
1531   !> @date June, 2016
1532   !> - Bug fix: take into account that boundaries are compute on T point,
1533   !>   but expressed on U,V point
1534   !>
1535   !> @param[inout] td_bdy boundary structure
1536   !> @param[in] td_var    variable structure
1537   !-------------------------------------------------------------------
1538   SUBROUTINE boundary_check(td_bdy, td_var) 
1539      IMPLICIT NONE 
1540      ! Argument
1541      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
1542      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
1543
1544      ! local variable
1545      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
1546      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_maxindex
1547
1548      ! loop indices
1549      INTEGER(i4) :: jk
1550      !----------------------------------------------------------------
1551 
1552      il_max(jp_north)=td_var%t_dim(1)%i_len
1553      il_max(jp_south)=td_var%t_dim(1)%i_len
1554      il_max(jp_east )=td_var%t_dim(2)%i_len
1555      il_max(jp_west )=td_var%t_dim(2)%i_len
1556 
1557      ! index expressed on U,V point, move on T point.
1558      il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost+1
1559      il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost
1560      il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ip_ghost+1
1561      il_maxindex(jp_west )=td_var%t_dim(1)%i_len-ip_ghost
1562
1563      DO jk=1,ip_ncard
1564         IF( td_bdy(jk)%l_use )THEN
1565            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
1566               CALL logger_error("BOUNDARY CHECK: no segment associted "//&
1567               &                 "to "//TRIM(td_bdy(jk)%c_card)//" boundary")
1568            ELSE
1569               ! check indices
1570               IF( ANY(td_bdy(jk)%t_seg(:)%i_first < 1         ) .OR. &
1571               &   ANY(td_bdy(jk)%t_seg(:)%i_first > il_max(jk)) .OR. &
1572               &   ANY(td_bdy(jk)%t_seg(:)%i_last  < 1         ) .OR. &
1573               &   ANY(td_bdy(jk)%t_seg(:)%i_last  > il_max(jk)) .OR. &
1574               &   ANY(td_bdy(jk)%t_seg(:)%i_first > td_bdy(jk)%t_seg(:)%i_last)&
1575               & )THEN
1576                  CALL logger_error("BOUNDARY CHECK: invalid segment "//&
1577                  &              "first and/or last indice for "//&
1578                  &              TRIM(td_bdy(jk)%c_card)//&
1579                  &              " boundary. check namelist")
1580               ENDIF
1581
1582               IF( ANY(td_bdy(jk)%t_seg(:)%i_index < 1         ) .OR. &
1583               &   ANY(td_bdy(jk)%t_seg(:)%i_index > il_maxindex(jk)) &
1584               & )THEN
1585                  CALL logger_error("BOUNDARY CHECK: invalid index "//&
1586                  &              "for "//TRIM(td_bdy(jk)%c_card)//&
1587                  &              " boundary. check namelist")
1588               ENDIF
1589            ENDIF
1590         ENDIF
1591      ENDDO
1592 
1593      CALL boundary_check_corner(td_bdy, td_var)
1594
1595   END SUBROUTINE boundary_check
1596   !-------------------------------------------------------------------
1597   !> @brief This subroutine swap array for east and north boundary.
1598   !
1599   !> @detail
1600   !>
1601   !> @author J.Paul
1602   !> @date November, 2013 - Initial Version
1603   !
1604   !> @param[inout] td_var variable strucutre
1605   !> @param[in   ] td_bdy boundary strucutre
1606   !-------------------------------------------------------------------
1607   SUBROUTINE boundary_swap( td_var, td_bdy )
1608      IMPLICIT NONE
1609      ! Argument
1610      TYPE(TVAR), INTENT(INOUT) :: td_var
1611      TYPE(TBDY), INTENT(IN   ) :: td_bdy
1612
1613      ! local variable
1614      REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
1615
1616      ! loop indices
1617      INTEGER(i4) :: ji
1618      INTEGER(i4) :: jj
1619      !----------------------------------------------------------------
1620
1621      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
1622         CALL logger_error("BOUNDARY SWAP: no array of value "//&
1623         &  "associted to variable "//TRIM(td_var%c_name) )
1624      ELSE     
1625
1626         SELECT CASE(TRIM(td_bdy%c_card))
1627         CASE('north')
1628            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
1629            &                  td_var%t_dim(2)%i_len, &
1630            &                  td_var%t_dim(3)%i_len, &
1631            &                  td_var%t_dim(4)%i_len) )
1632
1633            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
1634
1635            DO jj=1, td_var%t_dim(2)%i_len
1636               td_var%d_value(:,jj,:,:) = &
1637               &  dl_value(:,td_var%t_dim(2)%i_len-jj+1,:,:)
1638            ENDDO
1639
1640            DEALLOCATE( dl_value )         
1641         CASE('east')
1642            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
1643            &                  td_var%t_dim(2)%i_len, &
1644            &                  td_var%t_dim(3)%i_len, &
1645            &                  td_var%t_dim(4)%i_len) )
1646
1647            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
1648
1649            DO ji=1, td_var%t_dim(1)%i_len
1650               td_var%d_value(ji,:,:,:) = &
1651               &  dl_value(td_var%t_dim(1)%i_len-ji+1,:,:,:)
1652            ENDDO
1653
1654            DEALLOCATE( dl_value )
1655         CASE DEFAULT
1656         ! nothing to be done
1657         END SELECT
1658
1659      ENDIF
1660   END SUBROUTINE boundary_swap
1661   !-------------------------------------------------------------------
1662   !> @brief This subroutine print information about one boundary.
1663   !
1664   !> @author J.Paul
1665   !> @date November, 2013 - Initial Version
1666   !
1667   !> @param[in] td_bdy boundary structure
1668   !-------------------------------------------------------------------
1669   SUBROUTINE boundary__print_unit( td_bdy ) 
1670      IMPLICIT NONE 
1671      ! Argument
1672      TYPE(TBDY), INTENT(IN) :: td_bdy
1673      ! local variable
1674      ! loop indices
1675      INTEGER(i4) :: ji
1676      !----------------------------------------------------------------
1677
1678      WRITE(*,'(a,/1x,a,/1x,a)') "Boundary "//TRIM(td_bdy%c_card), &
1679      &  " use  "//TRIM(fct_str(td_bdy%l_use)), &
1680      &  " nseg "//TRIM(fct_str(td_bdy%i_nseg))
1681      DO ji=1,td_bdy%i_nseg
1682         WRITE(*,'(4(/1x,a))') &
1683         &  " index "//TRIM(fct_str(td_bdy%t_seg(ji)%i_index)), &
1684         &  " width "//TRIM(fct_str(td_bdy%t_seg(ji)%i_width)), &
1685         &  " first "//TRIM(fct_str(td_bdy%t_seg(ji)%i_first)), &
1686         &  " last  "//TRIM(fct_str(td_bdy%t_seg(ji)%i_last))
1687      ENDDO
1688 
1689   END SUBROUTINE boundary__print_unit
1690   !-------------------------------------------------------------------
1691   !> @brief This subroutine print information about a array of boundary
1692   !
1693   !> @details
1694   !
1695   !> @author J.Paul
1696   !> @date November, 2013 - Initial Version
1697   !
1698   !> @param[in] td_bdy boundary structure
1699   !-------------------------------------------------------------------
1700   SUBROUTINE boundary__print_arr( td_bdy ) 
1701      IMPLICIT NONE 
1702      ! Argument
1703      TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy
1704      ! local variable
1705      ! loop indices
1706      INTEGER(i4) :: ji
1707      !----------------------------------------------------------------
1708
1709      DO ji=1,SIZE(td_bdy(:))
1710         CALL boundary_print(td_bdy(ji))
1711      ENDDO
1712 
1713   END SUBROUTINE boundary__print_arr
1714   !-------------------------------------------------------------------
1715   !> @brief
1716   !> This subroutine copy segment structure in another one.
1717   !>
1718   !> @warning do not use on the output of a function who create or read a
1719   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
1720   !> This will create memory leaks.
1721   !> @warning to avoid infinite loop, do not use any function inside
1722   !> this subroutine
1723   !>
1724   !> @author J.Paul
1725   !> @date November, 2013 - Initial Version
1726   !> @date November, 2014
1727   !> - use function instead of overload assignment operator
1728   !> (to avoid memory leak)
1729   !
1730   !> @param[in] td_seg   segment structure
1731   !> @return copy of input segment structure
1732   !-------------------------------------------------------------------
1733   FUNCTION seg__copy_unit( td_seg )
1734      IMPLICIT NONE
1735      ! Argument
1736      TYPE(TSEG), INTENT(IN)  :: td_seg
1737      ! function
1738      TYPE(TSEG) :: seg__copy_unit
1739
1740      ! local variable
1741      ! loop indices
1742      !----------------------------------------------------------------
1743
1744      ! copy segment index, width, ..
1745      seg__copy_unit%i_index    = td_seg%i_index
1746      seg__copy_unit%i_width    = td_seg%i_width
1747      seg__copy_unit%i_first    = td_seg%i_first
1748      seg__copy_unit%i_last     = td_seg%i_last 
1749
1750   END FUNCTION seg__copy_unit
1751   !-------------------------------------------------------------------
1752   !> @brief
1753   !> This subroutine copy segment structure in another one.
1754   !>
1755   !> @warning do not use on the output of a function who create or read a
1756   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
1757   !> This will create memory leaks.   
1758   !> @warning to avoid infinite loop, do not use any function inside
1759   !> this subroutine
1760   !>
1761   !> @author J.Paul
1762   !> @date November, 2013 - Initial Version
1763   !> @date November, 2014
1764   !> - use function instead of overload assignment operator
1765   !> (to avoid memory leak)
1766   !
1767   !> @param[in] td_seg   segment structure
1768   !> @return copy of input array of segment structure
1769   !-------------------------------------------------------------------
1770   FUNCTION seg__copy_arr( td_seg )
1771      IMPLICIT NONE
1772      ! Argument
1773      TYPE(TSEG), DIMENSION(:), INTENT(IN)  :: td_seg
1774      ! function
1775      TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: seg__copy_arr
1776
1777      ! local variable
1778      ! loop indices
1779      INTEGER(i4) :: ji
1780      !----------------------------------------------------------------
1781
1782      DO ji=1,SIZE(td_seg(:))
1783         seg__copy_arr(ji)=seg__copy(td_seg(ji))
1784      ENDDO
1785
1786   END FUNCTION seg__copy_arr
1787   !-------------------------------------------------------------------
1788   !> @brief This function  initialise segment structure.
1789   !
1790   !> @details
1791   !> It simply add orthogonal index, and optionnaly width, first
1792   !> and last indices of the segment.
1793   !
1794   !> @author J.Paul
1795   !> @date November, 2013 - Initial Version
1796   !
1797   !> @param[in] id_index  orthogonal index
1798   !> @param[in] id_width  width of the segment
1799   !> @param[in] id_first  first indices
1800   !> @param[in] id_last   last  indices
1801   !> @return segment structure
1802   !-------------------------------------------------------------------
1803   FUNCTION seg__init( id_index, id_width, id_first, id_last ) 
1804      IMPLICIT NONE 
1805      ! Argument
1806      INTEGER(i4), INTENT(IN) :: id_index
1807      INTEGER(i4), INTENT(IN), OPTIONAL :: id_width
1808      INTEGER(i4), INTENT(IN), OPTIONAL :: id_first
1809      INTEGER(i4), INTENT(IN), OPTIONAL :: id_last 
1810
1811      ! function
1812      TYPE(TSEG) :: seg__init
1813
1814      ! local variable
1815     
1816      ! loop indices
1817      !----------------------------------------------------------------
1818
1819      seg__init%i_index=id_index
1820
1821      IF( PRESENT(id_width) ) seg__init%i_width=id_width
1822      IF( PRESENT(id_first) ) seg__init%i_first=id_first
1823      IF( PRESENT(id_last ) ) seg__init%i_last =id_last
1824
1825   END FUNCTION seg__init 
1826   !-------------------------------------------------------------------
1827   !> @brief This subroutine clean segment structure.
1828   !
1829   !> @author J.Paul
1830   !> @date November, 2013 - Initial Version
1831   !
1832   !> @param[inout] td_seg segment structure
1833   !-------------------------------------------------------------------
1834   SUBROUTINE seg__clean_unit(td_seg) 
1835      IMPLICIT NONE 
1836      ! Argument       
1837      TYPE(TSEG), INTENT(INOUT) :: td_seg
1838      ! local variable
1839      TYPE(TSEG) :: tl_seg
1840      ! loop indices
1841      !----------------------------------------------------------------
1842
1843      td_seg=seg__copy(tl_seg)
1844 
1845   END SUBROUTINE seg__clean_unit
1846   !-------------------------------------------------------------------
1847   !> @brief This subroutine clean segment structure.
1848   !
1849   !> @author J.Paul
1850   !> @date November, 2013 - Initial Version
1851   !
1852   !> @param[inout] td_seg array of segment structure
1853   !-------------------------------------------------------------------
1854   SUBROUTINE seg__clean_arr(td_seg) 
1855      IMPLICIT NONE 
1856      ! Argument       
1857      TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg
1858      ! local variable
1859      ! loop indices
1860      INTEGER(i4) :: ji
1861      !----------------------------------------------------------------
1862
1863      DO ji=SIZE(td_seg(:)),1,-1
1864         CALL seg__clean(td_seg(ji))
1865      ENDDO
1866 
1867   END SUBROUTINE seg__clean_arr 
1868END MODULE boundary
Note: See TracBrowser for help on using the repository browser.