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

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

source: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/boundary.f90 @ 10251

Last change on this file since 10251 was 10251, checked in by kingr, 5 years ago

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

File size: 63.1 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 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]
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 get the number of segment in boundary:<br/>
40!>    - tl_bdy\%i_nseg
41!>
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
105! REVISION HISTORY:
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
111!>
112!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
113!----------------------------------------------------------------------
114MODULE boundary
115   USE netcdf                          ! nf90 library                           
116   USE global                          ! global parameter
117   USE phycst                          ! physical constant
118   USE kind                            ! F90 kind parameter
119   USE logger                          ! log file manager
120   USE fct                             ! basic useful function
121   USE var                             ! variable manager
122
123   IMPLICIT NONE
124   ! NOTE_avoid_public_variables_if_possible
125
126   ! type and variable
127   PUBLIC :: TBDY     !< boundary structure
128   PUBLIC :: TSEG     !< segment structure
129
130   PRIVATE :: im_width !< boundary width
131
132   ! function and subroutine
133   PUBLIC :: boundary_copy         !< copy boundary structure
134   PUBLIC :: boundary_init         !< initialise boundary structure
135   PUBLIC :: boundary_print        !< print information about boundary
136   PUBLIC :: boundary_clean        !< clean boundary structure
137   PUBLIC :: boundary_get_indices  !< get indices of each semgent for each boundary.
138   PUBLIC :: boundary_check        !< check boundary indices and corner.
139   PUBLIC :: boundary_check_corner !< check boundary corner
140   PUBLIC :: boundary_set_filename !< set boundary filename
141   PUBLIC :: boundary_swap         !< swap array for north and east boundary
142
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
156   
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
166      INTEGER(i4) :: i_index = 0 !< segment index
167      INTEGER(i4) :: i_width = 0 !< segment width
168      INTEGER(i4) :: i_first = 0 !< segment first indice
169      INTEGER(i4) :: i_last  = 0 !< segment last indices
170   END TYPE TSEG
171
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
177   END TYPE TBDY
178
179   INTEGER(i4), PARAMETER :: im_width=10
180
181   INTERFACE boundary_init
182      MODULE PROCEDURE boundary__init_wrapper 
183   END INTERFACE boundary_init
184
185   INTERFACE boundary_print
186      MODULE PROCEDURE boundary__print_unit 
187      MODULE PROCEDURE boundary__print_arr 
188   END INTERFACE boundary_print
189
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
201      MODULE PROCEDURE boundary__copy_unit 
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
208   END INTERFACE   
209
210CONTAINS
211   !-------------------------------------------------------------------
212   !> @brief
213   !> This subroutine copy a array of boundary structure in another one
214   !> @details
215   !>
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.
219   !> @warning to avoid infinite loop, do not use any function inside
220   !> this subroutine
221   !>
222   !> @author J.Paul
223   !> @date November, 2013 - Initial Version
224   !> @date November, 2014
225   !>    - use function instead of overload assignment operator
226   !> (to avoid memory leak)
227   !
228   !> @param[in] td_bdy   array of boundary structure
229   !> @return copy of input array of boundary structure
230   !-------------------------------------------------------------------
231   FUNCTION boundary__copy_arr( td_bdy )
232      IMPLICIT NONE
233      ! Argument
234      TYPE(TBDY), DIMENSION(:), INTENT(IN)  :: td_bdy
235      ! function
236      TYPE(TBDY), DIMENSION(SIZE(td_bdy(:))) :: boundary__copy_arr
237
238      ! local variable
239      ! loop indices
240      INTEGER(i4) :: jk
241      !----------------------------------------------------------------
242
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
248   !-------------------------------------------------------------------
249   !> @brief
250   !> This subroutine copy boundary structure in another one
251   !> @details
252   !>
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.
256   !> @warning to avoid infinite loop, do not use any function inside
257   !> this subroutine
258   !>
259   !> @author J.Paul
260   !> @date November, 2013 - Initial Version
261   !> @date November, 2014
262   !>    - use function instead of overload assignment operator
263   !> (to avoid memory leak)
264   !
265   !> @param[in] td_bdy   boundary structure
266   !> @return copy of input boundary structure
267   !-------------------------------------------------------------------
268   FUNCTION boundary__copy_unit( td_bdy )
269      IMPLICIT NONE
270      ! Argument
271      TYPE(TBDY), INTENT(IN)  :: td_bdy
272      ! function
273      TYPE(TBDY) :: boundary__copy_unit
274
275      ! local variable
276      ! loop indices
277      INTEGER(i4) :: ji
278      !----------------------------------------------------------------
279
280      ! copy variable name, id, ..
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
284
285      ! copy segment
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)
294         ENDDO
295      ENDIF
296
297   END FUNCTION boundary__copy_unit
298   !-------------------------------------------------------------------
299   !> @brief This subroutine clean boundary structure
300   !
301   !> @author J.Paul
302   !> @date November, 2013 - Initial Version
303   !
304   !> @param[inout] td_bdy boundary strucutre
305   !-------------------------------------------------------------------
306   SUBROUTINE boundary__clean_unit( td_bdy )
307      IMPLICIT NONE
308      ! Argument
309      TYPE(TBDY), INTENT(INOUT) :: td_bdy
310
311      ! local variable
312      TYPE(TBDY) :: tl_bdy ! empty boundary strucutre
313
314      ! 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
346      INTEGER(i4) :: ji
347      !----------------------------------------------------------------
348
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.
356   !
357   !> @details
358   !
359   !> @author J.Paul
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??)
366   !> @return file name with cardinal name inside
367   !-------------------------------------------------------------------
368   FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) 
369      IMPLICIT NONE 
370      ! Argument
371      CHARACTER(LEN=*), INTENT(IN) :: cd_file
372      CHARACTER(LEN=*), INTENT(IN) :: cd_card
373      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_seg
374      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date
375
376      ! function
377      CHARACTER(LEN=lc) :: boundary_set_filename
378
379      ! local variable
380      CHARACTER(LEN=lc) :: cl_dirname
381      CHARACTER(LEN=lc) :: cl_basename
382      CHARACTER(LEN=lc) :: cl_base
383      CHARACTER(LEN=lc) :: cl_suffix
384      CHARACTER(LEN=lc) :: cl_segnum
385      CHARACTER(LEN=lc) :: cl_date
386      CHARACTER(LEN=lc) :: cl_name
387      ! loop indices
388      !----------------------------------------------------------------
389      ! init
390      boundary_set_filename=''
391
392      IF( TRIM(cd_file) /= '' .AND. TRIM(cd_card) /= '' )THEN
393
394         cl_dirname = fct_dirname( TRIM(cd_file))
395         IF( TRIM(cl_dirname) == '' ) cl_dirname='.'
396
397         cl_basename= fct_basename(TRIM(cd_file))
398
399         cl_base  =fct_split(TRIM(cl_basename),1,'.')
400         cl_suffix=fct_split(TRIM(cl_basename),2,'.')
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)
416
417         boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name)
418      ELSE
419         CALL logger_error("BOUNDARY SET FILENAME: file or cardinal name "//&
420         &  " are empty")
421      ENDIF
422 
423   END FUNCTION boundary_set_filename 
424   !-------------------------------------------------------------------
425   !> @brief This function initialise a boundary structure.
426   !
427   !> @details
428   !>  Boundaries for each cardinal will be compute with variable structure.
429   !>  It means that orthogonal index, first and last indices of each
430   !>  sea segment will be compute automatically.
431   !>  However you could specify which boundary to use or not with
432   !>  arguments ln_north, ln_south, ln_east, ln_west.
433   !>  And boundary description could be specify with argument
434   !>  cn_north, cn_south, cn_east, cn_west.
435   !>  For each cardinal you could specify orthogonal index,
436   !>  first and last indices (in this order) and boundary width (between
437   !>  parentheses).
438   !> ex : cn_north='index,first,last(width)'
439   !> You could specify more than one segment for each boundary.
440   !> However each segment will have the same width. So you do not need to
441   !> specify it for each segment.
442   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2'
443   !>
444   !> @note boundaries are compute on T point. change will be done to get data
445   !> on other point when need be.
446   !>
447   !> @author J.Paul
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
463   !> @return boundary structure
464   !-------------------------------------------------------------------
465   FUNCTION boundary__init_wrapper(td_var, &
466   &                               ld_north, ld_south, ld_east, ld_west, &
467   &                               cd_north, cd_south, cd_east, cd_west, &
468   &                               ld_oneseg ) 
469      IMPLICIT NONE 
470      ! Argument
471      TYPE(TVAR)       , INTENT(IN) :: td_var
472      LOGICAL          , INTENT(IN), OPTIONAL :: ld_north
473      LOGICAL          , INTENT(IN), OPTIONAL :: ld_south
474      LOGICAL          , INTENT(IN), OPTIONAL :: ld_east 
475      LOGICAL          , INTENT(IN), OPTIONAL :: ld_west 
476      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_north
477      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_south
478      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_east 
479      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_west
480      LOGICAL          , INTENT(IN), OPTIONAL :: ld_oneseg 
481
482      ! function
483      TYPE(TBDY), DIMENSION(ip_ncard) :: boundary__init_wrapper
484
485      ! local variable
486      INTEGER(i4)                            :: il_width
487      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max_width
488      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_index
489      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_min
490      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
491
492      CHARACTER(LEN=lc), DIMENSION(ip_ncard) :: cl_card
493
494      TYPE(TBDY)       , DIMENSION(ip_ncard) :: tl_bdy
495      TYPE(TBDY)                             :: tl_tmp
496
497      TYPE(TSEG)                             :: tl_seg
498
499      LOGICAL                                :: ll_oneseg
500
501      ! loop indices
502      INTEGER(i4) :: ji
503      INTEGER(i4) :: jk
504      !----------------------------------------------------------------
505      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
506         CALL logger_error("BOUNDARY INIT: no value associated to variable "//&
507         &              TRIM(td_var%c_name) )
508      ELSEIF( TRIM(td_var%c_point) /= 'T' )THEN
509         CALL logger_error("BOUNDARY INIT: can not compute boundary with "//&
510         &                 "variable "//TRIM(td_var%c_name)//&
511         &                 ". need a variable on T point." )
512      ELSE
513         ll_oneseg=.TRUE.
514         IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
515
516         ! init
517         tl_bdy(jp_north)=boundary__init('north',ld_north)
518         tl_bdy(jp_south)=boundary__init('south',ld_south)
519         tl_bdy(jp_east )=boundary__init('east ',ld_east )
520         tl_bdy(jp_west )=boundary__init('west ',ld_west )
521
522         ! if EW cyclic no east west boundary and force to use one segment
523         IF( td_var%i_ew >= 0 )THEN
524            CALL logger_info("BOUNDARY INIT: cyclic domain, "//&
525            &  "no East West boundary")
526            tl_bdy(jp_east )%l_use=.FALSE.
527            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.
532         ENDIF
533
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
538
539         il_min(jp_north)=1
540         il_min(jp_south)=1
541         il_min(jp_east )=1
542         il_min(jp_west )=1
543
544         il_max(jp_north)=td_var%t_dim(1)%i_len
545         il_max(jp_south)=td_var%t_dim(1)%i_len
546         il_max(jp_east )=td_var%t_dim(2)%i_len
547         il_max(jp_west )=td_var%t_dim(2)%i_len
548 
549         cl_card=(/'','','',''/)
550         IF( PRESENT(cd_north) ) cl_card(jp_north)=TRIM(cd_north)
551         IF( PRESENT(cd_south) ) cl_card(jp_south)=TRIM(cd_south)
552         IF( PRESENT(cd_east ) ) cl_card(jp_east )=TRIM(cd_east )
553         IF( PRESENT(cd_west ) ) cl_card(jp_west )=TRIM(cd_west )
554
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
560         DO jk=1,ip_ncard
561
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
577            ! define default segment
578            tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk))
579
580            IF( tl_bdy(jk)%l_use )THEN
581
582               ! get namelist information
583               tl_tmp=boundary__get_info(cl_card(jk))
584               DO ji=1,tl_tmp%i_nseg
585                  CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji))
586               ENDDO
587               CALL boundary_clean(tl_tmp)
588
589               IF( tl_bdy(jk)%i_nseg == 0 )THEN
590                  ! add default segment
591                  CALL boundary__add_seg(tl_bdy(jk),tl_seg)
592               ELSE
593                  ! fill undefined value
594                  WHERE( tl_bdy(jk)%t_seg(:)%i_index == 0 ) 
595                     tl_bdy(jk)%t_seg(:)%i_index = tl_seg%i_index
596                  END WHERE               
597                  WHERE( tl_bdy(jk)%t_seg(:)%i_width == 0 ) 
598                     tl_bdy(jk)%t_seg(:)%i_width = tl_seg%i_width
599                  END WHERE
600                  WHERE( tl_bdy(jk)%t_seg(:)%i_first == 0 ) 
601                     tl_bdy(jk)%t_seg(:)%i_first = tl_seg%i_first
602                  END WHERE
603                  WHERE( tl_bdy(jk)%t_seg(:)%i_last == 0 ) 
604                     tl_bdy(jk)%t_seg(:)%i_last = tl_seg%i_last
605                  END WHERE
606               ENDIF
607
608            ENDIF
609            ! clean
610            CALL seg__clean(tl_seg)
611
612         ENDDO
613
614         CALL boundary_get_indices(tl_bdy(:), td_var, ll_oneseg)
615
616         CALL boundary_check(tl_bdy, td_var)
617
618         boundary__init_wrapper(:)=boundary_copy(tl_bdy(:))
619
620         ! clean
621         DO jk=1,ip_ncard
622            CALL boundary_clean(tl_bdy(jk))
623         ENDDO
624
625      ENDIF
626 
627   END FUNCTION boundary__init_wrapper 
628   !-------------------------------------------------------------------
629   !> @brief This function initialise basically a boundary structure with
630   !> cardinal name.
631   !
632   !> @details
633   !> optionnaly you could specify if this boundary is used or not,
634   !> and add one segment structure.
635   !
636   !> @author J.Paul
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
642   !> @return boundary structure
643   !-------------------------------------------------------------------
644   FUNCTION boundary__init( cd_card, ld_use, td_seg ) 
645      IMPLICIT NONE 
646      ! Argument
647      CHARACTER(LEN=*), INTENT(IN) :: cd_card
648      LOGICAL         , INTENT(IN), OPTIONAL :: ld_use 
649      TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg
650
651      ! function
652      TYPE(TBDY) :: boundary__init
653
654      ! local variable
655     
656      ! loop indices
657      !----------------------------------------------------------------
658
659      SELECT CASE(TRIM(cd_card))
660         CASE ('north','south','east','west')
661         
662            boundary__init%c_card=TRIM(cd_card)
663
664            boundary__init%l_use=.TRUE.
665            IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use
666
667            IF( PRESENT(td_seg) )THEN
668               CALL boundary__add_seg(boundary__init, td_seg)
669            ENDIF
670
671         CASE DEFAULT
672            CALL logger_error("BOUNDARY INIT: invalid cardinal name")
673      END SELECT
674
675   END FUNCTION boundary__init
676   !-------------------------------------------------------------------
677   !> @brief This subroutine add one segment structure to a boundary structure
678   !
679   !> @details
680   !
681   !> @author J.Paul
682   !> @date November, 2013 - Initial Version
683   !
684   !> @param[inout] td_bdy boundary structure 
685   !> @param[in] td_seg    segment structure 
686   !-------------------------------------------------------------------
687   SUBROUTINE boundary__add_seg(td_bdy, td_seg) 
688      IMPLICIT NONE 
689      ! Argument
690      TYPE(TBDY), INTENT(INOUT) :: td_bdy
691      TYPE(TSEG), INTENT(IN   ) :: td_seg
692
693      ! local variable
694      INTEGER(i4)                            :: il_status
695      TYPE(TSEG) , DIMENSION(:), ALLOCATABLE :: tl_seg
696
697      ! loop indices
698      !----------------------------------------------------------------
699
700      IF( td_bdy%i_nseg > 0 )THEN
701         ! already other segment in boundary structure
702         ALLOCATE( tl_seg(td_bdy%i_nseg), stat=il_status )
703         IF(il_status /= 0 )THEN
704            CALL logger_error( &
705            &  " BOUNDARY ADD SEG: not enough space to put segments ")
706         ELSE
707            ! save temporary segment
708            tl_seg(:)=seg__copy(td_bdy%t_seg(:))
709
710            CALL seg__clean(td_bdy%t_seg(:))
711            DEALLOCATE( td_bdy%t_seg )
712            ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
713            IF(il_status /= 0 )THEN
714               CALL logger_error( &
715               &  " BOUNDARY ADD SEG: not enough space to put segments ")
716            ENDIF
717
718            ! copy segment in boundary before
719            td_bdy%t_seg(1:td_bdy%i_nseg)=seg__copy(tl_seg(:))
720
721            ! clean
722            CALL seg__clean(tl_seg(:))
723            DEALLOCATE(tl_seg)           
724           
725         ENDIF
726      ELSE
727         ! no segment in boundary structure
728         IF( ASSOCIATED(td_bdy%t_seg) )THEN
729            CALL seg__clean(td_bdy%t_seg(:))
730            DEALLOCATE(td_bdy%t_seg)
731         ENDIF
732         ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
733         IF(il_status /= 0 )THEN
734            CALL logger_error( &
735            &  " BOUNDARY ADD SEG: not enough space to put segments ")
736         ENDIF         
737      ENDIF
738 
739      ! update number of segment
740      td_bdy%i_nseg=td_bdy%i_nseg+1
741
742      ! add new segment
743      td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg)
744
745   END SUBROUTINE boundary__add_seg 
746   !-------------------------------------------------------------------
747   !> @brief This subroutine remove all segments of a boundary structure
748   !
749   !> @details
750   !
751   !> @author J.Paul
752   !> @date November, 2013 - Initial Version
753   !
754   !> @param[inout]  td_bdy   boundary structure
755   !-------------------------------------------------------------------
756   SUBROUTINE boundary__del_seg(td_bdy) 
757      IMPLICIT NONE 
758      ! Argument
759      TYPE(TBDY), INTENT(INOUT) :: td_bdy
760
761      ! local variable
762      ! loop indices
763      !----------------------------------------------------------------
764
765      IF( ASSOCIATED(td_bdy%t_seg) )THEN
766         CALL seg__clean(td_bdy%t_seg(:))
767         DEALLOCATE(td_bdy%t_seg)
768      ENDIF
769      !update number of segment
770      td_bdy%i_nseg=0
771
772   END SUBROUTINE boundary__del_seg 
773   !-------------------------------------------------------------------
774   !> @brief This function get information about boundary from string character.
775   !
776   !> @details
777   !> This string character that will be passed through namelist could contains
778   !> orthogonal index, first and last indices, of each segment.
779   !> And also the width of all segments of this boundary.
780   !>   cn_north='index1,first1,last1(width)|index2,first2,last2'
781   !>
782   !> @author J.Paul
783   !> @date November, 2013 - Initial Version
784   !
785   !> @param[in] cd_card   boundary description
786   !> @return boundary structure
787   !-------------------------------------------------------------------
788   FUNCTION boundary__get_info(cd_card) 
789      IMPLICIT NONE 
790      ! Argument
791      CHARACTER(LEN=lc), INTENT(IN) :: cd_card
792
793      ! function
794      TYPE(TBDY) :: boundary__get_info
795
796      ! local variable
797      INTEGER(i4)       :: il_width
798      INTEGER(i4)       :: il_ind1
799      INTEGER(i4)       :: il_ind2
800
801      CHARACTER(LEN=lc) :: cl_seg
802      CHARACTER(LEN=lc) :: cl_index
803      CHARACTER(LEN=lc) :: cl_width
804      CHARACTER(LEN=lc) :: cl_first
805      CHARACTER(LEN=lc) :: cl_last 
806
807      TYPE(TSEG)        :: tl_seg
808
809      ! loop indices
810      INTEGER(i4) :: ji
811      !----------------------------------------------------------------
812 
813      ji=1
814      cl_seg=fct_split(cd_card,ji)
815
816      il_width=0
817      ! look for segment width
818      ! width should be the same for all segment of one boundary
819      IF( TRIM(cl_seg)   /= '' )THEN
820         il_ind1=SCAN(fct_lower(cl_seg),'(')
821         IF( il_ind1 /=0 )THEN
822            cl_width=TRIM(cl_seg(il_ind1+1:))
823
824            il_ind2=SCAN(fct_lower(cl_width),')')
825            IF( il_ind2 /=0 )THEN
826               cl_width=TRIM(cl_width(1:il_ind2-1))
827               READ(cl_width,*) il_width
828            ELSE
829               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
830               &  " check namelist. ")
831            ENDIF
832         ENDIF
833      ENDIF
834
835      DO WHILE( TRIM(cl_seg) /= '' )
836
837         cl_index=fct_split(cl_seg,1,',')
838         ! remove potential width information
839         il_ind1=SCAN(fct_lower(cl_index),'(')
840         IF( il_ind1 /=0 )THEN
841            il_ind2=SCAN(fct_lower(cl_index),'(')
842            IF( il_ind2 /=0 )THEN
843               cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:))
844            ELSE
845               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
846               &  " check namelist. ")
847            ENDIF
848         ENDIF
849     
850         cl_first=fct_split(cl_seg,2,',')
851         ! remove potential width information
852         il_ind1=SCAN(fct_lower(cl_first),'(')
853         IF( il_ind1 /=0 )THEN
854            il_ind2=SCAN(fct_lower(cl_first),'(')
855            IF( il_ind2 /=0 )THEN
856               cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:))
857            ELSE
858               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
859               &  " check namelist. ")
860            ENDIF
861         ENDIF         
862         
863         cl_last =fct_split(cl_seg,3,',')
864         ! remove potential width information
865         il_ind1=SCAN(fct_lower(cl_last),'(')
866         IF( il_ind1 /=0 )THEN
867            il_ind2=SCAN(fct_lower(cl_last),'(')
868            IF( il_ind2 /=0 )THEN
869               cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:))
870            ELSE
871               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
872               &  " check namelist. ")
873            ENDIF
874         ENDIF
875
876         IF( il_width /= 0 ) tl_seg%i_width=il_width
877
878         IF( TRIM(cl_index) /= '' ) READ(cl_index,*) tl_seg%i_index
879         IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first
880         IF( TRIM(cl_last)  /= '' ) READ(cl_last ,*) tl_seg%i_last
881
882         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. &
883         &   (tl_seg%i_first /= 0 .AND.  tl_seg%i_last /= 0) )THEN
884            CALL boundary__add_seg(boundary__get_info, tl_seg)
885         ELSE
886            CALL logger_error("BOUNDARY INIT: first or last segment indices "//&
887            &              "are missing . check namelist.")
888         ENDIF
889
890         ji=ji+1
891         cl_seg=fct_split(cd_card,ji)
892
893         ! clean
894         CALL seg__clean(tl_seg)
895      ENDDO 
896
897   END FUNCTION boundary__get_info 
898   !-------------------------------------------------------------------
899   !> @brief This subroutine get indices of each semgent for each boundary.
900   !
901   !> @details
902   !> indices are compute from variable value, actually variable fill value,
903   !> which is assume to be land mask.
904   !> Boundary structure should have been initialized before running
905   !> this subroutine. Segment indices will be search between first and last
906   !> indies, at this orthogonal index.
907   !>
908   !> Optionnally you could forced to use only one segment for each boundary.
909   !>
910   !> @warning number of segment (i_nseg) will be change, before the number
911   !> of segment structure
912   !
913   !> @author J.Paul
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   !-------------------------------------------------------------------
920   SUBROUTINE boundary_get_indices( td_bdy, td_var, ld_oneseg) 
921      IMPLICIT NONE 
922      ! Argument
923      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
924      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
925      LOGICAL                         , INTENT(IN   ), OPTIONAL :: ld_oneseg
926
927      ! local variable
928      INTEGER(i4) :: il_index
929      INTEGER(i4) :: il_width
930      INTEGER(i4) :: il_first
931      INTEGER(i4) :: il_last 
932
933      LOGICAL     :: ll_oneseg
934
935      TYPE(TSEG)  :: tl_seg
936
937      ! loop indices
938      INTEGER(i4) :: jk
939      !----------------------------------------------------------------
940 
941      ll_oneseg=.TRUE.
942      IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
943
944      DO jk=1,ip_ncard
945         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%i_nseg > 1 )THEN
946            ! nothing to be done
947         ELSE
948
949            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
950               CALL logger_error("BOUNDARY GET INDICES: no segment "//&
951               &  " associated to "//TRIM(td_bdy(jk)%c_card)//&
952               &  " boundary. you should have run boundary_init before"//&
953               &  " running boundary_get_indices" )
954            ELSE
955               il_index=td_bdy(jk)%t_seg(1)%i_index
956               il_width=td_bdy(jk)%t_seg(1)%i_width
957               il_first=td_bdy(jk)%t_seg(1)%i_first
958               il_last =td_bdy(jk)%t_seg(1)%i_last
959 
960               CALL boundary__get_seg_number( td_bdy(jk), td_var)
961
962               CALL boundary__get_seg_indices( td_bdy(jk), td_var, &
963               &                               il_index, il_width, &
964               &                               il_first, il_last )
965
966               IF( ll_oneseg .AND. td_bdy(jk)%l_use )THEN
967                  tl_seg=seg__copy(td_bdy(jk)%t_seg(1))
968                  ! use last indice of last segment
969                  tl_seg%i_last=td_bdy(jk)%t_seg(td_bdy(jk)%i_nseg)%i_last
970
971                  ! remove all segment from boundary
972                  CALL boundary__del_seg(td_bdy(jk))
973
974                  ! add one segment
975                  CALL boundary__add_seg(td_bdy(jk),tl_seg)
976
977                  ! clean
978                  CALL seg__clean(tl_seg)
979               ENDIF
980
981            ENDIF
982
983         ENDIF
984
985      ENDDO
986
987   END SUBROUTINE boundary_get_indices 
988   !-------------------------------------------------------------------
989   !> @brief This subroutine compute the number of sea segment.
990   !
991   !> @details
992   !> It use variable value, actually variable fill value
993   !> (which is assume to be land mask), to compute the number of segment between
994   !> first and last indices at boundary orthogonal index.
995   !> @warning number of segment (i_nseg) will be change, before the number
996   !> of segment structure
997   !
998   !> @author J.Paul
999   !> @date November, 2013 - Initial Version
1000   !
1001   !> @param[inout] td_bdy boundary structure
1002   !> @param[in] td_var    variable structure
1003   !-------------------------------------------------------------------
1004   SUBROUTINE boundary__get_seg_number( td_bdy, td_var) 
1005      IMPLICIT NONE 
1006      ! Argument
1007      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
1008      TYPE(TVAR) , INTENT(IN   ) :: td_var
1009
1010      ! local variable
1011      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
1012      LOGICAL                                        :: ll_sea
1013      INTEGER(i4)                                    :: il_index
1014
1015      ! loop indices
1016      INTEGER(i4) :: ji
1017      !----------------------------------------------------------------
1018 
1019      IF( td_bdy%l_use .AND. td_bdy%i_nseg == 1 )THEN
1020
1021         il_index=td_bdy%t_seg(1)%i_index
1022
1023         SELECT CASE(TRIM(td_bdy%c_card))
1024            CASE('north','south')
1025
1026               ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
1027               dl_value(:)=td_var%d_value(:,il_index,1,1)
1028
1029               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
1030                 
1031                  td_bdy%l_use=.TRUE.
1032                  td_bdy%i_nseg=0
1033
1034                  ll_sea=.FALSE.
1035                  DO ji=1,td_var%t_dim(1)%i_len
1036                     IF( dl_value(ji)/= td_var%d_fill )THEN
1037                        IF( .NOT. ll_sea )THEN
1038                           td_bdy%i_nseg=td_bdy%i_nseg+1
1039                        ENDIF
1040                        ll_sea=.TRUE.
1041                     ELSE
1042                        ll_sea=.FALSE.
1043                     ENDIF
1044                  ENDDO
1045
1046               ELSE
1047                  td_bdy%l_use=.FALSE.
1048                  td_bdy%i_nseg=0
1049               ENDIF
1050
1051               DEALLOCATE( dl_value )
1052
1053            CASE('east','west')
1054
1055               ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
1056               dl_value(:)=td_var%d_value(il_index,:,1,1)
1057
1058               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
1059                 
1060                  td_bdy%l_use=.TRUE.
1061                  td_bdy%i_nseg=0
1062
1063                  ll_sea=.FALSE.
1064                  DO ji=1,td_var%t_dim(2)%i_len
1065                     IF( dl_value(ji)/= td_var%d_fill )THEN
1066                        IF( .NOT. ll_sea )THEN
1067                           td_bdy%i_nseg=td_bdy%i_nseg+1
1068                        ENDIF
1069                        ll_sea=.TRUE.
1070                     ELSE
1071                        ll_sea=.FALSE.
1072                     ENDIF
1073                  ENDDO
1074
1075               ELSE
1076                  td_bdy%l_use=.FALSE.
1077                  td_bdy%i_nseg=0
1078               ENDIF
1079
1080               DEALLOCATE( dl_value )
1081
1082         END SELECT
1083      ENDIF
1084 
1085   END SUBROUTINE boundary__get_seg_number 
1086   !-------------------------------------------------------------------
1087   !> @brief This subroutine get segment indices for one boundary.
1088   !
1089   !> @details
1090   !
1091   !> @author J.Paul
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   !-------------------------------------------------------------------
1101   SUBROUTINE boundary__get_seg_indices( td_bdy, td_var, &
1102   &                                     id_index, id_width, id_first, id_last) 
1103      IMPLICIT NONE 
1104      ! Argument
1105      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
1106      TYPE(TVAR) , INTENT(IN   ) :: td_var
1107      INTEGER(i4), INTENT(IN   ) :: id_index
1108      INTEGER(i4), INTENT(IN   ) :: id_width
1109      INTEGER(i4), INTENT(IN   ) :: id_first
1110      INTEGER(i4), INTENT(IN   ) :: id_last
1111
1112      ! local variable
1113      INTEGER(i4)                                    :: il_nseg
1114      INTEGER(i4), DIMENSION(ip_ncard)               :: il_max
1115      INTEGER(i4), DIMENSION(ip_ncard)               :: il_min
1116
1117      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
1118
1119      LOGICAL                                        :: ll_sea
1120      LOGICAL                                        :: ll_first
1121      LOGICAL                                        :: ll_last
1122
1123      TYPE(TSEG)                                     :: tl_seg
1124
1125      ! loop indices
1126      INTEGER(i4) :: ji
1127      INTEGER(i4) :: jk
1128      INTEGER(i4) :: jl
1129      !----------------------------------------------------------------
1130 
1131      SELECT CASE(TRIM(td_bdy%c_card))
1132         CASE('north')
1133            jk=jp_north
1134           
1135            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
1136            dl_value(:)=td_var%d_value(:,id_index,1,1)
1137
1138         CASE('south')
1139            jk=jp_south
1140
1141            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
1142            dl_value(:)=td_var%d_value(:,id_index,1,1)
1143
1144         CASE('east ')
1145            jk=jp_east 
1146
1147            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
1148            dl_value(:)=td_var%d_value(id_index,:,1,1)
1149
1150         CASE('west ')
1151            jk=jp_west 
1152
1153            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
1154            dl_value(:)=td_var%d_value(id_index,:,1,1)
1155
1156      END SELECT
1157
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
1167         
1168      ! special case for EW cyclic
1169      IF( td_var%i_ew >= 0 )THEN
1170         il_min(jp_north)=1
1171         il_min(jp_south)=1
1172
1173         il_max(jp_north)=td_var%t_dim(1)%i_len
1174         il_max(jp_south)=td_var%t_dim(1)%i_len
1175      ENDIF
1176     
1177      il_nseg=td_bdy%i_nseg
1178      ! remove all segment from boundary
1179      CALL boundary__del_seg(td_bdy)
1180
1181      ll_first=.FALSE.
1182      ll_last =.FALSE.
1183      DO jl=1,il_nseg
1184
1185         ! init
1186         tl_seg=seg__init(id_index,id_width,id_first,id_last)
1187
1188         IF( .NOT. (ll_first .AND. ll_last) )THEN
1189            ! first loop
1190            tl_seg%i_first=MAX(id_first,il_min(jk))
1191            tl_seg%i_last =MIN(id_last ,il_max(jk))
1192         ELSE
1193            ! load new min and max
1194            tl_seg%i_first=MAX(td_bdy%t_seg(jl-1)%i_last,il_min(jk))
1195            tl_seg%i_last =MIN(id_last                  ,il_max(jk))
1196         ENDIF
1197
1198         ll_first=.FALSE.
1199         ll_last =.FALSE.
1200         ll_sea  =.FALSE.
1201
1202         DO ji=tl_seg%i_first,tl_seg%i_last
1203
1204            IF( ll_first .AND. ll_last )THEN
1205               ! first and last point already loaded
1206               ! look for next segment
1207               EXIT
1208            ENDIF
1209
1210            IF( dl_value(ji)/= td_var%d_fill )THEN
1211               IF( .NOT. ll_sea )THEN
1212                  tl_seg%i_first=MAX(tl_seg%i_first,ji-1)
1213                  ll_first=.true.
1214               ENDIF
1215               ll_sea=.TRUE.
1216            ELSE
1217               IF( ll_sea )THEN
1218                  tl_seg%i_last=ji
1219                  ll_last=.TRUE.
1220               ENDIF
1221               ll_sea=.FALSE.
1222            ENDIF
1223           
1224         ENDDO
1225
1226         CALL boundary__add_seg(td_bdy,tl_seg)
1227
1228         ! clean
1229         CALL seg__clean(tl_seg)
1230         
1231      ENDDO
1232
1233      DEALLOCATE(dl_value)
1234     
1235   END SUBROUTINE boundary__get_seg_indices 
1236   !-------------------------------------------------------------------
1237   !> @brief This subroutine check if there is boundary at corner, and
1238   !> adjust boundary indices if necessary.
1239   !
1240   !> @details
1241   !> If there is a north west corner, first indices of north boundary
1242   !> should be the same as the west boundary indices.
1243   !> And the last indices of the west boundary should be the same as
1244   !> the north indices.
1245   !> More over the width of west and north boundary should be the same.
1246   !
1247   !> @author J.Paul
1248   !> @date November, 2013 - Initial Version
1249   !
1250   !> @param[inout] td_bdy boundary structure
1251   !> @param[in] td_var    variable structure
1252   !-------------------------------------------------------------------
1253   SUBROUTINE boundary_check_corner( td_bdy, td_var )
1254      IMPLICIT NONE 
1255      ! Argument
1256      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
1257      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
1258
1259      ! local variable
1260      TYPE(TSEG)  :: tl_north
1261      TYPE(TSEG)  :: tl_south
1262      TYPE(TSEG)  :: tl_east 
1263      TYPE(TSEG)  :: tl_west
1264
1265      INTEGER(i4) :: il_width
1266
1267      ! loop indices
1268      !----------------------------------------------------------------
1269 
1270      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
1271         CALL logger_error("BOUNDARY CHEKC CORNER: no value associated "//&
1272         &              "to variable "//TRIM(td_var%c_name))
1273      ENDIF
1274
1275      ! check north west corner
1276      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_west)%l_use )THEN
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))
1279
1280         IF( tl_west%i_last  >= tl_north%i_index .AND. &
1281         &   tl_west%i_index >= tl_north%i_first ) THEN
1282            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1283            &                 "a north west corner")
1284
1285            tl_west%i_last   = tl_north%i_index
1286            tl_north%i_first = tl_west%i_index
1287
1288            IF( tl_west%i_width /= tl_north%i_width )THEN
1289               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1290               &  " width between north and west boundary ")
1291
1292               il_width=MIN(tl_west%i_width,tl_north%i_width)
1293               
1294               tl_west%i_width =il_width
1295               tl_north%i_width=il_width
1296
1297            ENDIF
1298
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)
1301
1302         ELSE
1303
1304            IF( td_var%d_value(tl_north%i_first,tl_north%i_index,1,1) /= &
1305            &   td_var%d_fill )THEN
1306               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1307               &              "north boundary first indice ")
1308            ENDIF
1309
1310            IF( td_var%d_value(tl_west%i_index,tl_west%i_last,1,1) /= &
1311            &   td_var%d_fill )THEN
1312               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1313               &              "west boundary last indice")
1314            ENDIF
1315         ENDIF
1316      ENDIF
1317
1318      ! check north east corner
1319      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_east)%l_use )THEN
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))
1322
1323         IF( tl_east%i_last  >= tl_north%i_index .AND. &
1324         &   tl_east%i_index <= tl_north%i_last ) THEN
1325            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1326            &              "a north east corner")
1327
1328            tl_east%i_last  = tl_north%i_index
1329            tl_north%i_last = tl_east%i_index
1330
1331            IF( tl_east%i_width /= tl_north%i_width )THEN
1332               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1333               &  " width between north and east boundary ")
1334
1335               il_width=MIN(tl_east%i_width,tl_north%i_width)
1336               
1337               tl_east%i_width =il_width
1338               tl_north%i_width=il_width
1339
1340            ENDIF
1341
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)
1344         ELSE
1345
1346            IF( td_var%d_value(tl_north%i_last,tl_north%i_index,1,1) /= &
1347            &   td_var%d_fill )THEN
1348               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1349               &              "north boundary last indice ")
1350            ENDIF
1351
1352            IF( td_var%d_value(tl_east%i_index,tl_east%i_last,1,1) /= &
1353            &   td_var%d_fill )THEN
1354               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1355               &              "east boundary last indice")
1356            ENDIF
1357         ENDIF
1358      ENDIF
1359
1360      ! check south east corner
1361      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_east)%l_use )THEN
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))
1364
1365         IF( tl_east%i_first <= tl_south%i_index .AND. &
1366         &   tl_east%i_index <= tl_south%i_last ) THEN
1367            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1368            &              "a south east corner")
1369
1370            tl_east%i_first = tl_south%i_index
1371            tl_south%i_last = tl_east%i_index
1372
1373            IF( tl_east%i_width /= tl_south%i_width )THEN
1374               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1375               &  " width between south and east boundary ")
1376
1377               il_width=MIN(tl_east%i_width,tl_south%i_width)
1378               
1379               tl_east%i_width =il_width
1380               tl_south%i_width=il_width
1381
1382            ENDIF
1383
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)
1386         ELSE
1387
1388            IF( td_var%d_value(tl_south%i_last,tl_south%i_index,1,1) /= &
1389            &   td_var%d_fill )THEN
1390               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1391               &              "south boundary last indice ")
1392            ENDIF
1393
1394            IF( td_var%d_value(tl_east%i_index,tl_east%i_first,1,1) /= &
1395            &   td_var%d_fill )THEN
1396               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1397               &              "east boundary first indice")
1398            ENDIF
1399         ENDIF
1400      ENDIF
1401
1402      ! check south west corner
1403      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_west)%l_use )THEN
1404         tl_west =seg__copy(td_bdy(jp_west )%t_seg(1))
1405         tl_south=seg__copy(td_bdy(jp_south)%t_seg(1))
1406
1407         IF( tl_west%i_first <= tl_south%i_index .AND. &
1408         &   tl_west%i_index >= tl_south%i_first ) THEN
1409            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
1410            &              "a south west corner")
1411
1412            tl_west%i_first = tl_south%i_index
1413            tl_south%i_first= tl_west%i_index
1414
1415            IF( tl_west%i_width /= tl_south%i_width )THEN
1416               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
1417               &  " width between south and west boundary ")
1418
1419               il_width=MIN(tl_west%i_width,tl_south%i_width)
1420               
1421               tl_west%i_width =il_width
1422               tl_south%i_width=il_width
1423
1424            ENDIF
1425
1426            td_bdy(jp_west )%t_seg(1) = seg__copy(tl_west)
1427            td_bdy(jp_south)%t_seg(1) = seg__copy(tl_south)
1428         ELSE
1429
1430            IF( td_var%d_value(tl_south%i_first,tl_south%i_index,1,1) /= &
1431            &   td_var%d_fill )THEN
1432               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1433               &              "south boundary first indice ")
1434            ENDIF
1435
1436            IF( td_var%d_value(tl_west%i_index,tl_west%i_first,1,1) /= &
1437            &   td_var%d_fill )THEN
1438               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
1439               &              "west boundary first indice")
1440            ENDIF
1441         ENDIF
1442      ENDIF
1443
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
1450   END SUBROUTINE boundary_check_corner 
1451   !-------------------------------------------------------------------
1452   !> @brief This subroutine check boundary.
1453   !
1454   !> @details
1455   !> It checks that first and last indices as well as orthogonal index are
1456   !> inside domain, and check corner (see boundary_check_corner).
1457   !
1458   !> @author J.Paul
1459   !> @date November, 2013 - Initial Version
1460   !
1461   !> @param[inout] td_bdy boundary structure
1462   !> @param[in] td_var    variable structure
1463   !-------------------------------------------------------------------
1464   SUBROUTINE boundary_check(td_bdy, td_var) 
1465      IMPLICIT NONE 
1466      ! Argument
1467      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
1468      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
1469
1470      ! local variable
1471      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
1472      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_maxindex
1473
1474      ! loop indices
1475      INTEGER(i4) :: jk
1476      !----------------------------------------------------------------
1477 
1478      il_max(jp_north)=td_var%t_dim(1)%i_len
1479      il_max(jp_south)=td_var%t_dim(1)%i_len
1480      il_max(jp_east )=td_var%t_dim(2)%i_len
1481      il_max(jp_west )=td_var%t_dim(2)%i_len
1482     
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
1487
1488      DO jk=1,ip_ncard
1489         IF( td_bdy(jk)%l_use )THEN
1490            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
1491               CALL logger_error("BOUNDARY CHECK: no segment associted "//&
1492               &                 "to "//TRIM(td_bdy(jk)%c_card)//" boundary")
1493            ELSE
1494               ! check indices
1495               IF( ANY(td_bdy(jk)%t_seg(:)%i_first < 1         ) .OR. &
1496               &   ANY(td_bdy(jk)%t_seg(:)%i_first > il_max(jk)) .OR. &
1497               &   ANY(td_bdy(jk)%t_seg(:)%i_last  < 1         ) .OR. &
1498               &   ANY(td_bdy(jk)%t_seg(:)%i_last  > il_max(jk)) .OR. &
1499               &   ANY(td_bdy(jk)%t_seg(:)%i_first > td_bdy(jk)%t_seg(:)%i_last)&
1500               & )THEN
1501                  CALL logger_error("BOUNDARY CHECK: invalid segment "//&
1502                  &              "first and/or last indice for "//&
1503                  &              TRIM(td_bdy(jk)%c_card)//&
1504                  &              " boundary. check namelist")
1505               ENDIF
1506
1507               IF( ANY(td_bdy(jk)%t_seg(:)%i_index < 1         ) .OR. &
1508               &   ANY(td_bdy(jk)%t_seg(:)%i_index > il_maxindex(jk)) &
1509               & )THEN
1510                  CALL logger_error("BOUNDARY CHECK: invalid index "//&
1511                  &              "for "//TRIM(td_bdy(jk)%c_card)//&
1512                  &              " boundary. check namelist")
1513               ENDIF
1514            ENDIF
1515         ENDIF
1516      ENDDO
1517     
1518      CALL boundary_check_corner(td_bdy, td_var)
1519
1520   END SUBROUTINE boundary_check
1521   !-------------------------------------------------------------------
1522   !> @brief This subroutine swap array for east and north boundary.
1523   !
1524   !> @detail
1525   !>
1526   !> @author J.Paul
1527   !> @date November, 2013 - Initial Version
1528   !
1529   !> @param[inout] td_var variable strucutre
1530   !> @param[in   ] td_bdy boundary strucutre
1531   !-------------------------------------------------------------------
1532   SUBROUTINE boundary_swap( td_var, td_bdy )
1533      IMPLICIT NONE
1534      ! Argument
1535      TYPE(TVAR), INTENT(INOUT) :: td_var
1536      TYPE(TBDY), INTENT(IN   ) :: td_bdy
1537
1538      ! local variable
1539      REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
1540
1541      ! loop indices
1542      INTEGER(i4) :: ji
1543      INTEGER(i4) :: jj
1544      !----------------------------------------------------------------
1545
1546      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
1547         CALL logger_error("BOUNDARY SWAP: no array of value "//&
1548         &  "associted to variable "//TRIM(td_var%c_name) )
1549      ELSE     
1550
1551         SELECT CASE(TRIM(td_bdy%c_card))
1552         CASE('north')
1553            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
1554            &                  td_var%t_dim(2)%i_len, &
1555            &                  td_var%t_dim(3)%i_len, &
1556            &                  td_var%t_dim(4)%i_len) )
1557
1558            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
1559
1560            DO jj=1, td_var%t_dim(2)%i_len
1561               td_var%d_value(:,jj,:,:) = &
1562               &  dl_value(:,td_var%t_dim(2)%i_len-jj+1,:,:)
1563            ENDDO
1564
1565            DEALLOCATE( dl_value )         
1566         CASE('east')
1567            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
1568            &                  td_var%t_dim(2)%i_len, &
1569            &                  td_var%t_dim(3)%i_len, &
1570            &                  td_var%t_dim(4)%i_len) )
1571
1572            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
1573
1574            DO ji=1, td_var%t_dim(1)%i_len
1575               td_var%d_value(ji,:,:,:) = &
1576               &  dl_value(td_var%t_dim(1)%i_len-ji+1,:,:,:)
1577            ENDDO
1578
1579            DEALLOCATE( dl_value )
1580         CASE DEFAULT
1581         ! nothing to be done
1582         END SELECT
1583
1584      ENDIF
1585   END SUBROUTINE boundary_swap
1586   !-------------------------------------------------------------------
1587   !> @brief This subroutine print information about one boundary.
1588   !
1589   !> @author J.Paul
1590   !> @date November, 2013 - Initial Version
1591   !
1592   !> @param[in] td_bdy boundary structure
1593   !-------------------------------------------------------------------
1594   SUBROUTINE boundary__print_unit( td_bdy ) 
1595      IMPLICIT NONE 
1596      ! Argument
1597      TYPE(TBDY), INTENT(IN) :: td_bdy
1598      ! local variable
1599      ! loop indices
1600      INTEGER(i4) :: ji
1601      !----------------------------------------------------------------
1602
1603      WRITE(*,'(a,/1x,a,/1x,a)') "Boundary "//TRIM(td_bdy%c_card), &
1604      &  " use  "//TRIM(fct_str(td_bdy%l_use)), &
1605      &  " nseg "//TRIM(fct_str(td_bdy%i_nseg))
1606      DO ji=1,td_bdy%i_nseg
1607         WRITE(*,'(4(/1x,a))') &
1608         &  " index "//TRIM(fct_str(td_bdy%t_seg(ji)%i_index)), &
1609         &  " width "//TRIM(fct_str(td_bdy%t_seg(ji)%i_width)), &
1610         &  " first "//TRIM(fct_str(td_bdy%t_seg(ji)%i_first)), &
1611         &  " last  "//TRIM(fct_str(td_bdy%t_seg(ji)%i_last))
1612      ENDDO
1613 
1614   END SUBROUTINE boundary__print_unit
1615   !-------------------------------------------------------------------
1616   !> @brief This subroutine print information about a array of boundary
1617   !
1618   !> @details
1619   !
1620   !> @author J.Paul
1621   !> @date November, 2013 - Initial Version
1622   !
1623   !> @param[in] td_bdy boundary structure
1624   !-------------------------------------------------------------------
1625   SUBROUTINE boundary__print_arr( td_bdy ) 
1626      IMPLICIT NONE 
1627      ! Argument
1628      TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy
1629      ! local variable
1630      ! loop indices
1631      INTEGER(i4) :: ji
1632      !----------------------------------------------------------------
1633
1634      DO ji=1,SIZE(td_bdy(:))
1635         CALL boundary_print(td_bdy(ji))
1636      ENDDO
1637 
1638   END SUBROUTINE boundary__print_arr
1639   !-------------------------------------------------------------------
1640   !> @brief
1641   !> This subroutine copy segment structure in another one.
1642   !>
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.
1646   !> @warning to avoid infinite loop, do not use any function inside
1647   !> this subroutine
1648   !>
1649   !> @author J.Paul
1650   !> @date November, 2013 - Initial Version
1651   !> @date November, 2014
1652   !>    - use function instead of overload assignment operator
1653   !> (to avoid memory leak)
1654   !
1655   !> @param[in] td_seg   segment structure
1656   !> @return copy of input segment structure
1657   !-------------------------------------------------------------------
1658   FUNCTION seg__copy_unit( td_seg )
1659      IMPLICIT NONE
1660      ! Argument
1661      TYPE(TSEG), INTENT(IN)  :: td_seg
1662      ! function
1663      TYPE(TSEG) :: seg__copy_unit
1664
1665      ! local variable
1666      ! loop indices
1667      !----------------------------------------------------------------
1668
1669      ! copy segment index, width, ..
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
1712   !-------------------------------------------------------------------
1713   !> @brief This function  initialise segment structure.
1714   !
1715   !> @details
1716   !> It simply add orthogonal index, and optionnaly width, first
1717   !> and last indices of the segment.
1718   !
1719   !> @author J.Paul
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
1726   !> @return segment structure
1727   !-------------------------------------------------------------------
1728   FUNCTION seg__init( id_index, id_width, id_first, id_last ) 
1729      IMPLICIT NONE 
1730      ! Argument
1731      INTEGER(i4), INTENT(IN) :: id_index
1732      INTEGER(i4), INTENT(IN), OPTIONAL :: id_width
1733      INTEGER(i4), INTENT(IN), OPTIONAL :: id_first
1734      INTEGER(i4), INTENT(IN), OPTIONAL :: id_last 
1735
1736      ! function
1737      TYPE(TSEG) :: seg__init
1738
1739      ! local variable
1740     
1741      ! loop indices
1742      !----------------------------------------------------------------
1743
1744      seg__init%i_index=id_index
1745
1746      IF( PRESENT(id_width) ) seg__init%i_width=id_width
1747      IF( PRESENT(id_first) ) seg__init%i_first=id_first
1748      IF( PRESENT(id_last ) ) seg__init%i_last =id_last
1749
1750   END FUNCTION seg__init 
1751   !-------------------------------------------------------------------
1752   !> @brief This subroutine clean segment structure.
1753   !
1754   !> @author J.Paul
1755   !> @date November, 2013 - Initial Version
1756   !
1757   !> @param[inout] td_seg segment structure
1758   !-------------------------------------------------------------------
1759   SUBROUTINE seg__clean_unit(td_seg) 
1760      IMPLICIT NONE 
1761      ! Argument       
1762      TYPE(TSEG), INTENT(INOUT) :: td_seg
1763      ! local variable
1764      TYPE(TSEG) :: tl_seg
1765      ! loop indices
1766      !----------------------------------------------------------------
1767
1768      td_seg=seg__copy(tl_seg)
1769 
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 
1793END MODULE boundary
Note: See TracBrowser for help on using the repository browser.