Changeset 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src/boundary.f90
- Timestamp:
- 2015-05-12T12:37:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src/boundary.f90
r4213 r5260 8 8 !> @brief 9 9 !> This module manage boundary. 10 ! 10 !> 11 11 !> @details 12 !> define type TBDY:<br/> 13 !> @code 14 !> TYPE(TBDY) :: tl_bdy<br/> 15 !> @endcode 12 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] 13 32 !> 33 !> to get boundary cardinal:<br/> 34 !> - tl_bdy\%c_card 14 35 !> 36 !> to know if boundary is use:<br/> 37 !> - tl_bdy\%l_use 15 38 !> 39 !> to get the number of segment in boundary:<br/> 40 !> - tl_bdy\%i_nseg 16 41 !> 17 !> @author 18 !> J.Paul 42 !> to get array of segment in boundary:<br/> 43 !> - tl_bdy\%t_seg(:) 44 !> 45 !> to get orthogonal segment index of north boundary:<br/> 46 !> - tl_bdy\%t_seg(jp_north)%\i_index 47 !> 48 !> to get segment width of south boundary:<br/> 49 !> - tl_bdy\%t_seg(jp_south)%\i_width 50 !> 51 !> to get segment first indice of east boundary:<br/> 52 !> - tl_bdy\%t_seg(jp_east)%\i_first 53 !> 54 !> to get segment last indice of west boundary:<br/> 55 !> - tl_bdy\%t_seg(jp_west)%\i_last 56 !> 57 !> to print information about boundary:<br/> 58 !> @code 59 !> CALL boundary_print(td_bdy) 60 !> @endcode 61 !> - td_bdy is boundary structure or a array of boundary structure 62 !> 63 !> to clean boundary structure:<br/> 64 !> @code 65 !> CALL boundary_clean(td_bdy) 66 !> @endcode 67 !> 68 !> to get indices of each semgent for each boundary:<br/> 69 !> @code 70 !> CALL boundary_get_indices( td_bdy, td_var, ld_oneseg) 71 !> @endcode 72 !> - td_bdy is boundary structure 73 !> - td_var is variable structure 74 !> - ld_oneseg is logical to force to use only one segment for each boundary [optional] 75 !> 76 !> to check boundary indices and corner:<br/> 77 !> @code 78 !> CALL boundary_check(td_bdy, td_var) 79 !> @endcode 80 !> - td_bdy is boundary structure 81 !> - td_var is variable structure 82 !> 83 !> to check boundary corner:<br/> 84 !> @code 85 !> CALL boundary_check_corner(td_bdy, td_var) 86 !> @endcode 87 !> - td_bdy is boundary structure 88 !> - td_var is variable structure 89 !> 90 !> to create filename with cardinal name inside:<br/> 91 !> @code 92 !> cl_filename=boundary_set_filename(cd_file, cd_card) 93 !> @endcode 94 !> - cd_file = original file name 95 !> - cd_card = cardinal name 96 !> 97 !> to swap array for east and north boundary:<br/> 98 !> @code 99 !> CALL boundary_swap( td_var, td_bdy ) 100 !> @endcode 101 !> - td_var is variable strucutre 102 !> - td_bdy is boundary strucutre 103 !> 104 !> @author J.Paul 19 105 ! REVISION HISTORY: 20 !> @date Nov, 2013 - Initial Version 21 !> @todo 22 !> - add description generique de l'objet boundary 106 !> @date November, 2013 - Initial Version 107 !> @date September, 2014 - add boundary description 108 !> @date November, 2014 - Fix memory leaks bug 109 !> 110 !> @todo add schematic to boundary structure description 23 111 !> 24 112 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 29 117 USE phycst ! physical constant 30 118 USE kind ! F90 kind parameter 31 USE logger 119 USE logger ! log file manager 32 120 USE fct ! basic useful function 33 ! USE date ! date manager34 ! USE att ! attribute manager35 ! USE dim ! dimension manager36 121 USE var ! variable manager 37 ! USE file ! file manager38 ! USE iom ! I/O manager39 ! USE dom ! domain manager40 ! USE grid ! grid manager41 ! USE extrap ! extrapolation manager42 ! USE interp ! interpolation manager43 ! USE filter ! filter manager44 ! USE mpp ! MPP manager45 ! USE iom_mpp ! MPP I/O manager46 122 47 123 IMPLICIT NONE 48 PRIVATE49 124 ! NOTE_avoid_public_variables_if_possible 50 125 51 126 ! type and variable 52 PUBLIC :: ip_ncard !< number of cardinal point53 PUBLIC :: ip_card !< table of cardinal point54 127 PUBLIC :: TBDY !< boundary structure 55 128 PUBLIC :: TSEG !< segment structure 56 129 130 PRIVATE :: im_width !< boundary width 131 57 132 ! function and subroutine 133 PUBLIC :: boundary_copy !< copy boundary structure 58 134 PUBLIC :: boundary_init !< initialise boundary structure 59 135 PUBLIC :: boundary_print !< print information about boundary … … 63 139 PUBLIC :: boundary_check_corner !< check boundary corner 64 140 PUBLIC :: boundary_set_filename !< set boundary filename 65 PUBLIC :: boundary_clean_interp !< clean interpolated boundary66 141 PUBLIC :: boundary_swap !< swap array for north and east boundary 67 142 68 PRIVATE :: boundary__init_wrapper !< initialise a boundary structure 69 PRIVATE :: boundary__init !< initialise basically a boundary structure 70 ! PRIVATE :: boundary__copy !< copy boundary structure in another 71 PRIVATE :: boundary__copy_unit !< copy boundary structure in another 72 PRIVATE :: boundary__copy_tab !< copy boundary structure in another 73 PRIVATE :: boundary__add_seg !< add one segment structure to a boundary 74 PRIVATE :: boundary__del_seg !< remove all segments of a boundary 75 PRIVATE :: boundary__get_info !< get boundary information from boundary description string character. 76 PRIVATE :: boundary__get_seg_number !< compute the number of sea segment for one boundary 77 PRIVATE :: boundary__get_seg_indices !< get segment indices for one boundary 78 PRIVATE :: boundary__print_unit !< print information about one boundary 79 PRIVATE :: boundary__print_tab !< print information about a table of boundary 143 PRIVATE :: boundary__clean_unit ! clean boundary structure 144 PRIVATE :: boundary__clean_arr ! clean array of boundary structure 145 PRIVATE :: boundary__init_wrapper ! initialise a boundary structure 146 PRIVATE :: boundary__init ! initialise basically a boundary structure 147 PRIVATE :: boundary__copy_unit ! copy boundary structure in another 148 PRIVATE :: boundary__copy_arr ! copy boundary structure in another 149 PRIVATE :: boundary__add_seg ! add one segment structure to a boundary 150 PRIVATE :: boundary__del_seg ! remove all segments of a boundary 151 PRIVATE :: boundary__get_info ! get boundary information from boundary description string character. 152 PRIVATE :: boundary__get_seg_number ! compute the number of sea segment for one boundary 153 PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary 154 PRIVATE :: boundary__print_unit ! print information about one boundary 155 PRIVATE :: boundary__print_arr ! print information about a array of boundary 80 156 81 PRIVATE :: seg__init !< initialise segment structure 82 PRIVATE :: seg__clean !< clean segment structure 83 PRIVATE :: seg__copy !< copy segment structure in another 84 85 !> @struct 86 TYPE TSEG 157 PRIVATE :: seg__init ! initialise segment structure 158 PRIVATE :: seg__clean ! clean segment structure 159 PRIVATE :: seg__clean_unit ! clean segment structure 160 PRIVATE :: seg__clean_arr ! clean array of segment structure 161 PRIVATE :: seg__copy ! copy segment structure in another 162 PRIVATE :: seg__copy_unit ! copy segment structure in another 163 PRIVATE :: seg__copy_arr ! copy array of segment structure in another 164 165 TYPE TSEG !< segment structure 87 166 INTEGER(i4) :: i_index = 0 !< segment index 88 167 INTEGER(i4) :: i_width = 0 !< segment width … … 91 170 END TYPE TSEG 92 171 93 !> @struct 94 TYPE TBDY 95 CHARACTER(LEN=lc) :: c_card = '' 96 LOGICAL :: l_use = .FALSE. 97 INTEGER(i4) :: i_nseg = 0 98 TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() 172 TYPE TBDY !< boundary structure 173 CHARACTER(LEN=lc) :: c_card = '' !< boundary cardinal 174 LOGICAL :: l_use = .FALSE. !< boundary use or not 175 INTEGER(i4) :: i_nseg = 0 !< number of segment in boundary 176 TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !< array of segment structure 99 177 END TYPE TBDY 100 101 INTEGER(i4), PARAMETER :: ip_ncard=4102 CHARACTER(LEN=lc), DIMENSION(ip_ncard), PARAMETER :: ip_card = &103 & (/ 'north', &104 & 'south', &105 & 'east ', &106 & 'west ' /)107 108 INTEGER(i4), PARAMETER :: jp_north=1109 INTEGER(i4), PARAMETER :: jp_south=2110 INTEGER(i4), PARAMETER :: jp_east =3111 INTEGER(i4), PARAMETER :: jp_west =4112 178 113 179 INTEGER(i4), PARAMETER :: im_width=10 … … 119 185 INTERFACE boundary_print 120 186 MODULE PROCEDURE boundary__print_unit 121 MODULE PROCEDURE boundary__print_ tab187 MODULE PROCEDURE boundary__print_arr 122 188 END INTERFACE boundary_print 123 189 124 INTERFACE ASSIGNMENT(=) 190 INTERFACE boundary_clean 191 MODULE PROCEDURE boundary__clean_unit 192 MODULE PROCEDURE boundary__clean_arr 193 END INTERFACE 194 195 INTERFACE seg__clean 196 MODULE PROCEDURE seg__clean_unit 197 MODULE PROCEDURE seg__clean_arr 198 END INTERFACE 199 200 INTERFACE boundary_copy 125 201 MODULE PROCEDURE boundary__copy_unit 126 MODULE PROCEDURE boundary__copy_tab 127 MODULE PROCEDURE seg__copy ! copy segment structure 202 MODULE PROCEDURE boundary__copy_arr 203 END INTERFACE 204 205 INTERFACE seg__copy 206 MODULE PROCEDURE seg__copy_unit ! copy segment structure 207 MODULE PROCEDURE seg__copy_arr ! copy array of segment structure 128 208 END INTERFACE 129 209 … … 131 211 !------------------------------------------------------------------- 132 212 !> @brief 133 !> This subroutine copy boundary structure in another boundary 134 !> structure 213 !> This subroutine copy a array of boundary structure in another one 135 214 !> @details 136 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. 137 219 !> @warning to avoid infinite loop, do not use any function inside 138 220 !> this subroutine 139 221 !> 140 222 !> @author J.Paul 141 !> - Nov, 2013- Initial Version 223 !> @date November, 2013 - Initial Version 224 !> @date November, 2014 225 !> - use function instead of overload assignment operator 226 !> (to avoid memory leak) 142 227 ! 143 !> @param[ out] td_bdy1 :boundary structure144 !> @ param[in] td_bdy2 : boundary structure228 !> @param[in] td_bdy array of boundary structure 229 !> @return copy of input array of boundary structure 145 230 !------------------------------------------------------------------- 146 !> @code 147 SUBROUTINE boundary__copy_tab( td_bdy1, td_bdy2 ) 231 FUNCTION boundary__copy_arr( td_bdy ) 148 232 IMPLICIT NONE 149 233 ! Argument 150 TYPE(TBDY), DIMENSION(:), INTENT(OUT) :: td_bdy1 151 TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy2 234 TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy 235 ! function 236 TYPE(TBDY), DIMENSION(SIZE(td_bdy(:))) :: boundary__copy_arr 152 237 153 238 ! local variable … … 156 241 !---------------------------------------------------------------- 157 242 158 IF( SIZE(td_bdy1(:)) /= SIZE(td_bdy2(:)) )THEN 159 CALL logger_error("BOUNDARY COPY: dimension of table of boundary differ") 160 ELSE 161 DO jk=1,SIZE(td_bdy1(:)) 162 td_bdy1(jk)=td_bdy2(jk) 163 ENDDO 164 ENDIF 165 END SUBROUTINE boundary__copy_tab 166 !> @endcode 243 DO jk=1,SIZE(td_bdy(:)) 244 boundary__copy_arr(jk)=boundary_copy(td_bdy(jk)) 245 ENDDO 246 247 END FUNCTION boundary__copy_arr 167 248 !------------------------------------------------------------------- 168 249 !> @brief 169 !> This subroutine copy boundary structure in another boundary 170 !> structure 250 !> This subroutine copy boundary structure in another one 171 251 !> @details 172 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. 173 256 !> @warning to avoid infinite loop, do not use any function inside 174 257 !> this subroutine 175 258 !> 176 259 !> @author J.Paul 177 !> - Nov, 2013- Initial Version 260 !> @date November, 2013 - Initial Version 261 !> @date November, 2014 262 !> - use function instead of overload assignment operator 263 !> (to avoid memory leak) 178 264 ! 179 !> @param[ out] td_bdy1 :boundary structure180 !> @ param[in] td_bdy2 :boundary structure265 !> @param[in] td_bdy boundary structure 266 !> @return copy of input boundary structure 181 267 !------------------------------------------------------------------- 182 !> @code 183 SUBROUTINE boundary__copy_unit( td_bdy1, td_bdy2 ) 268 FUNCTION boundary__copy_unit( td_bdy ) 184 269 IMPLICIT NONE 185 270 ! Argument 186 TYPE(TBDY), INTENT(OUT) :: td_bdy1 187 TYPE(TBDY), INTENT(IN) :: td_bdy2 271 TYPE(TBDY), INTENT(IN) :: td_bdy 272 ! function 273 TYPE(TBDY) :: boundary__copy_unit 188 274 189 275 ! local variable … … 193 279 194 280 ! copy variable name, id, .. 195 td_bdy1%c_card = TRIM(td_bdy2%c_card)196 td_bdy1%i_nseg = td_bdy2%i_nseg197 td_bdy1%l_use = td_bdy2%l_use281 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 198 284 199 285 ! copy segment 200 IF( ASSOCIATED(td_bdy1%t_seg) ) DEALLOCATE(td_bdy1%t_seg) 201 IF( ASSOCIATED(td_bdy2%t_seg) .AND. td_bdy1%i_nseg > 0 )THEN 202 ALLOCATE( td_bdy1%t_seg(td_bdy1%i_nseg) ) 203 DO ji=1,td_bdy1%i_nseg 204 td_bdy1%t_seg(ji)=td_bdy2%t_seg(ji) 286 IF( ASSOCIATED(boundary__copy_unit%t_seg) )THEN 287 CALL seg__clean(boundary__copy_unit%t_seg(:)) 288 DEALLOCATE(boundary__copy_unit%t_seg) 289 ENDIF 290 IF( ASSOCIATED(td_bdy%t_seg) .AND. boundary__copy_unit%i_nseg > 0 )THEN 291 ALLOCATE( boundary__copy_unit%t_seg(boundary__copy_unit%i_nseg) ) 292 DO ji=1,boundary__copy_unit%i_nseg 293 boundary__copy_unit%t_seg(ji)=td_bdy%t_seg(ji) 205 294 ENDDO 206 295 ENDIF 207 296 208 END SUBROUTINE boundary__copy_unit 209 !> @endcode 297 END FUNCTION boundary__copy_unit 210 298 !------------------------------------------------------------------- 211 299 !> @brief This subroutine clean boundary structure 212 300 ! 213 301 !> @author J.Paul 214 !> - Nov, 2013- Initial Version302 !> @date November, 2013 - Initial Version 215 303 ! 216 !> @param[inout] td_bdy :boundary strucutre304 !> @param[inout] td_bdy boundary strucutre 217 305 !------------------------------------------------------------------- 218 !> @code 219 SUBROUTINE boundary_clean( td_bdy ) 306 SUBROUTINE boundary__clean_unit( td_bdy ) 220 307 IMPLICIT NONE 221 308 ! Argument … … 226 313 227 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 228 346 INTEGER(i4) :: ji 229 347 !---------------------------------------------------------------- 230 348 231 CALL logger_info( & 232 & " CLEAN: reset boundary "//TRIM(td_bdy%c_card) ) 233 234 ! del segment 235 IF( ASSOCIATED(td_bdy%t_seg) )THEN 236 ! clean each attribute 237 DO ji=td_bdy%i_nseg,1,-1 238 CALL seg__clean(td_bdy%t_seg(ji) ) 239 ENDDO 240 DEALLOCATE( td_bdy%t_seg ) 241 ENDIF 242 243 ! replace by empty structure 244 td_bdy=tl_bdy 245 246 END SUBROUTINE boundary_clean 247 !> @endcode 248 !------------------------------------------------------------------- 249 !> @brief This function put cardinal name inside file name 349 DO ji=SIZE(td_bdy(:)),1,-1 350 CALL boundary_clean( td_bdy(ji) ) 351 ENDDO 352 353 END SUBROUTINE boundary__clean_arr 354 !------------------------------------------------------------------- 355 !> @brief This function put cardinal name inside file name. 250 356 ! 251 357 !> @details 252 358 ! 253 359 !> @author J.Paul 254 !> - Nov, 2013- Initial Version 255 ! 256 !> @param[in] cd_file : file name 257 !> @param[in] cd_card : cardinal name 360 !> @date November, 2013 - Initial Version 361 ! 362 !> @param[in] cd_file file name 363 !> @param[in] cd_card cardinal name 364 !> @param[in] id_seg segment number 365 !> @param[in] cd_date file date (format: y????m??d??) 258 366 !> @return file name with cardinal name inside 259 367 !------------------------------------------------------------------- 260 !> @code 261 FUNCTION boundary_set_filename(cd_file, cd_card) 368 FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) 262 369 IMPLICIT NONE 263 370 ! Argument 264 371 CHARACTER(LEN=*), INTENT(IN) :: cd_file 265 372 CHARACTER(LEN=*), INTENT(IN) :: cd_card 373 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_seg 374 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date 266 375 267 376 ! function … … 273 382 CHARACTER(LEN=lc) :: cl_base 274 383 CHARACTER(LEN=lc) :: cl_suffix 384 CHARACTER(LEN=lc) :: cl_segnum 385 CHARACTER(LEN=lc) :: cl_date 275 386 CHARACTER(LEN=lc) :: cl_name 276 387 ! loop indices … … 288 399 cl_base =fct_split(TRIM(cl_basename),1,'.') 289 400 cl_suffix=fct_split(TRIM(cl_basename),2,'.') 290 291 cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//"."//TRIM(cl_suffix) 401 402 IF( PRESENT(id_seg) )THEN 403 cl_segnum="_"//TRIM(fct_str(id_seg))//"_" 404 ELSE 405 cl_segnum="" 406 ENDIF 407 408 IF( PRESENT(cd_date) )THEN 409 cl_date=TRIM(ADJUSTL(cd_date)) 410 ELSE 411 cl_date="" 412 ENDIF 413 414 cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 415 & TRIM(cl_date)//"."//TRIM(cl_suffix) 292 416 293 417 boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) … … 298 422 299 423 END FUNCTION boundary_set_filename 300 !> @endcode 301 !------------------------------------------------------------------- 302 !> @brief This function initialise a boundary structure 424 !------------------------------------------------------------------- 425 !> @brief This function initialise a boundary structure. 303 426 ! 304 427 !> @details … … 318 441 !> specify it for each segment. 319 442 !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 320 ! 443 !> 444 !> @note boundaries are compute on T point. change will be done to get data 445 !> on other point when need be. 446 !> 321 447 !> @author J.Paul 322 !> - Nov, 2013- Initial Version 323 ! 324 !> @param[in] td_var : variable structure 325 !> @param[in] ld_north : use north boundary or not 326 !> @param[in] ld_south : use south boundary or not 327 !> @param[in] ld_east : use east boundary or not 328 !> @param[in] ld_west : use west boundary or not 329 !> @param[in] cd_north : north boundary description 330 !> @param[in] cd_south : south boundary description 331 !> @param[in] cd_east : east boundary description 332 !> @param[in] cd_west : west boundary description 448 !> @date November, 2013 - Initial Version 449 !> @date September, 2014 450 !> - add boolean to use only one segment for each boundary 451 !> - check boundary width 452 ! 453 !> @param[in] td_var variable structure 454 !> @param[in] ld_north use north boundary or not 455 !> @param[in] ld_south use south boundary or not 456 !> @param[in] ld_east use east boundary or not 457 !> @param[in] ld_west use west boundary or not 458 !> @param[in] cd_north north boundary description 459 !> @param[in] cd_south south boundary description 460 !> @param[in] cd_east east boundary description 461 !> @param[in] cd_west west boundary description 462 !> @param[in] ld_oneseg force to use only one segment for each boundary 333 463 !> @return boundary structure 334 !> @todo use bondary_get_indices !!!! 335 !------------------------------------------------------------------- 336 !> @code 464 !------------------------------------------------------------------- 337 465 FUNCTION boundary__init_wrapper(td_var, & 338 466 & ld_north, ld_south, ld_east, ld_west, & … … 356 484 357 485 ! local variable 486 INTEGER(i4) :: il_width 487 INTEGER(i4) , DIMENSION(ip_ncard) :: il_max_width 358 488 INTEGER(i4) , DIMENSION(ip_ncard) :: il_index 359 489 INTEGER(i4) , DIMENSION(ip_ncard) :: il_min … … 390 520 tl_bdy(jp_west )=boundary__init('west ',ld_west ) 391 521 392 ! if EW cyclic no east west boundary 522 ! if EW cyclic no east west boundary and force to use one segment 393 523 IF( td_var%i_ew >= 0 )THEN 394 CALL logger_debug("BOUNDARY INIT: cyclic no East West boundary") 524 CALL logger_info("BOUNDARY INIT: cyclic domain, "//& 525 & "no East West boundary") 395 526 tl_bdy(jp_east )%l_use=.FALSE. 396 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. 397 532 ENDIF 398 533 399 ! attention cas U /= T ??? 400 il_index(jp_north)=td_var%t_dim(2)%i_len-ig_ghost 401 il_index(jp_south)=1+ig_ghost 402 il_index(jp_east )=td_var%t_dim(1)%i_len-ig_ghost 403 il_index(jp_west )=1+ig_ghost 534 il_index(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 535 il_index(jp_south)=1+ip_ghost 536 il_index(jp_east )=td_var%t_dim(1)%i_len-ip_ghost 537 il_index(jp_west )=1+ip_ghost 404 538 405 539 il_min(jp_north)=1 … … 419 553 IF( PRESENT(cd_west ) ) cl_card(jp_west )=TRIM(cd_west ) 420 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 421 560 DO jk=1,ip_ncard 422 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 423 577 ! define default segment 424 tl_seg=seg__init(il_index(jk),i m_width,il_min(jk),il_max(jk))578 tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk)) 425 579 426 580 IF( tl_bdy(jk)%l_use )THEN … … 453 607 454 608 ENDIF 609 ! clean 610 CALL seg__clean(tl_seg) 455 611 456 612 ENDDO … … 460 616 CALL boundary_check(tl_bdy, td_var) 461 617 462 boundary__init_wrapper(:)= tl_bdy(:)618 boundary__init_wrapper(:)=boundary_copy(tl_bdy(:)) 463 619 464 620 ! clean … … 470 626 471 627 END FUNCTION boundary__init_wrapper 472 !> @endcode473 628 !------------------------------------------------------------------- 474 629 !> @brief This function initialise basically a boundary structure with … … 480 635 ! 481 636 !> @author J.Paul 482 !> - Nov, 2013- Initial Version483 ! 484 !> @param[in] cd_card :cardinal name485 !> @param[in] ld_use :boundary use or not486 !> @param[in] td_seg :segment structure637 !> @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 487 642 !> @return boundary structure 488 643 !------------------------------------------------------------------- 489 !> @code490 644 FUNCTION boundary__init( cd_card, ld_use, td_seg ) 491 645 IMPLICIT NONE … … 520 674 521 675 END FUNCTION boundary__init 522 !> @endcode523 676 !------------------------------------------------------------------- 524 677 !> @brief This subroutine add one segment structure to a boundary structure … … 527 680 ! 528 681 !> @author J.Paul 529 !> - Nov, 2013- Initial Version 530 ! 531 !> @param[inout] td_bdy : boundary structure 532 !> @param[in] td_seg : segment structure 533 !------------------------------------------------------------------- 534 !> @code 682 !> @date November, 2013 - Initial Version 683 ! 684 !> @param[inout] td_bdy boundary structure 685 !> @param[in] td_seg segment structure 686 !------------------------------------------------------------------- 535 687 SUBROUTINE boundary__add_seg(td_bdy, td_seg) 536 688 IMPLICIT NONE … … 554 706 ELSE 555 707 ! save temporary segment 556 tl_seg(:)=td_bdy%t_seg(:) 557 708 tl_seg(:)=seg__copy(td_bdy%t_seg(:)) 709 710 CALL seg__clean(td_bdy%t_seg(:)) 558 711 DEALLOCATE( td_bdy%t_seg ) 559 712 ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status ) … … 564 717 565 718 ! copy segment in boundary before 566 td_bdy%t_seg(1:td_bdy%i_nseg)=tl_seg(:) 567 719 td_bdy%t_seg(1:td_bdy%i_nseg)=seg__copy(tl_seg(:)) 720 721 ! clean 722 CALL seg__clean(tl_seg(:)) 568 723 DEALLOCATE(tl_seg) 569 724 … … 572 727 ! no segment in boundary structure 573 728 IF( ASSOCIATED(td_bdy%t_seg) )THEN 729 CALL seg__clean(td_bdy%t_seg(:)) 574 730 DEALLOCATE(td_bdy%t_seg) 575 731 ENDIF … … 585 741 586 742 ! add new segment 587 td_bdy%t_seg(td_bdy%i_nseg)= td_seg743 td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg) 588 744 589 745 END SUBROUTINE boundary__add_seg 590 !> @endcode591 746 !------------------------------------------------------------------- 592 747 !> @brief This subroutine remove all segments of a boundary structure … … 595 750 ! 596 751 !> @author J.Paul 597 !> - Nov, 2013- Initial Version 598 ! 599 !> @param[inout] td_bdy : boundary structure 600 !------------------------------------------------------------------- 601 !> @code 752 !> @date November, 2013 - Initial Version 753 ! 754 !> @param[inout] td_bdy boundary structure 755 !------------------------------------------------------------------- 602 756 SUBROUTINE boundary__del_seg(td_bdy) 603 757 IMPLICIT NONE … … 610 764 611 765 IF( ASSOCIATED(td_bdy%t_seg) )THEN 766 CALL seg__clean(td_bdy%t_seg(:)) 612 767 DEALLOCATE(td_bdy%t_seg) 613 768 ENDIF … … 616 771 617 772 END SUBROUTINE boundary__del_seg 618 !> @endcode619 773 !------------------------------------------------------------------- 620 774 !> @brief This function get information about boundary from string character. … … 627 781 !> 628 782 !> @author J.Paul 629 !> - Nov, 2013- Initial Version630 ! 631 !> @param[in] cd_card :boundary description783 !> @date November, 2013 - Initial Version 784 ! 785 !> @param[in] cd_card boundary description 632 786 !> @return boundary structure 633 787 !------------------------------------------------------------------- 634 !> @code635 788 FUNCTION boundary__get_info(cd_card) 636 789 IMPLICIT NONE … … 737 890 ji=ji+1 738 891 cl_seg=fct_split(cd_card,ji) 892 893 ! clean 894 CALL seg__clean(tl_seg) 739 895 ENDDO 740 896 741 897 END FUNCTION boundary__get_info 742 !> @endcode743 898 !------------------------------------------------------------------- 744 899 !> @brief This subroutine get indices of each semgent for each boundary. … … 757 912 ! 758 913 !> @author J.Paul 759 !> - Nov, 2013- Initial Version 760 ! 761 !> @param[inout] td_bdy : boundary structure 762 !> @param[in] td_var : variable structure 763 !> @param[in] ld_onseg : use only one sgment for each boundary 764 !------------------------------------------------------------------- 765 !> @code 914 !> @date November, 2013 - Initial Version 915 ! 916 !> @param[inout] td_bdy boundary structure 917 !> @param[in] td_var variable structure 918 !> @param[in] ld_onseg use only one sgment for each boundary 919 !------------------------------------------------------------------- 766 920 SUBROUTINE boundary_get_indices( td_bdy, td_var, ld_oneseg) 767 921 IMPLICIT NONE … … 811 965 812 966 IF( ll_oneseg .AND. td_bdy(jk)%l_use )THEN 813 tl_seg= td_bdy(jk)%t_seg(1)967 tl_seg=seg__copy(td_bdy(jk)%t_seg(1)) 814 968 ! use last indice of last segment 815 969 tl_seg%i_last=td_bdy(jk)%t_seg(td_bdy(jk)%i_nseg)%i_last … … 820 974 ! add one segment 821 975 CALL boundary__add_seg(td_bdy(jk),tl_seg) 976 977 ! clean 978 CALL seg__clean(tl_seg) 822 979 ENDIF 823 980 … … 829 986 830 987 END SUBROUTINE boundary_get_indices 831 !> @endcode832 988 !------------------------------------------------------------------- 833 989 !> @brief This subroutine compute the number of sea segment. … … 841 997 ! 842 998 !> @author J.Paul 843 !> - Nov, 2013- Initial Version 844 ! 845 !> @param[inout] td_bdy : boundary structure 846 !> @param[in] td_var : variable structure 847 !------------------------------------------------------------------- 848 !> @code 999 !> @date November, 2013 - Initial Version 1000 ! 1001 !> @param[inout] td_bdy boundary structure 1002 !> @param[in] td_var variable structure 1003 !------------------------------------------------------------------- 849 1004 SUBROUTINE boundary__get_seg_number( td_bdy, td_var) 850 1005 IMPLICIT NONE … … 927 1082 END SELECT 928 1083 ENDIF 929 930 1084 931 1085 END SUBROUTINE boundary__get_seg_number 932 !> @endcode933 1086 !------------------------------------------------------------------- 934 1087 !> @brief This subroutine get segment indices for one boundary. … … 937 1090 ! 938 1091 !> @author J.Paul 939 !> - Nov, 2013- Initial Version 940 ! 941 !> @param[inout] td_bdy : boundary structure 942 !> @param[in] td_var : variable structure 943 !> @param[in] id_index : boundary orthogonal index 944 !> @param[in] id_width : bounary width 945 !> @param[in] id_first : boundary first indice 946 !> @param[in] id_last : boundary last indice 947 !------------------------------------------------------------------- 948 !> @code 1092 !> @date November, 2013 - Initial Version 1093 ! 1094 !> @param[inout] td_bdy boundary structure 1095 !> @param[in] td_var variable structure 1096 !> @param[in] id_index boundary orthogonal index 1097 !> @param[in] id_width bounary width 1098 !> @param[in] id_first boundary first indice 1099 !> @param[in] id_last boundary last indice 1100 !------------------------------------------------------------------- 949 1101 SUBROUTINE boundary__get_seg_indices( td_bdy, td_var, & 950 1102 & id_index, id_width, id_first, id_last) … … 1004 1156 END SELECT 1005 1157 1006 il_max(jp_north)=td_var%t_dim(1)%i_len-i g_ghost1007 il_max(jp_south)=td_var%t_dim(1)%i_len-i g_ghost1008 il_max(jp_east )=td_var%t_dim(2)%i_len-i g_ghost1009 il_max(jp_west )=td_var%t_dim(2)%i_len-i g_ghost1010 1011 il_min(jp_north)=1+i g_ghost1012 il_min(jp_south)=1+i g_ghost1013 il_min(jp_east )=1+i g_ghost1014 il_min(jp_west )=1+i g_ghost1158 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 1015 1167 1016 1168 ! special case for EW cyclic … … 1074 1226 CALL boundary__add_seg(td_bdy,tl_seg) 1075 1227 1228 ! clean 1076 1229 CALL seg__clean(tl_seg) 1077 1230 … … 1081 1234 1082 1235 END SUBROUTINE boundary__get_seg_indices 1083 !> @endcode1084 1236 !------------------------------------------------------------------- 1085 1237 !> @brief This subroutine check if there is boundary at corner, and … … 1094 1246 ! 1095 1247 !> @author J.Paul 1096 !> - Nov, 2013- Initial Version 1097 ! 1098 !> @param[inout] td_bdy : boundary structure 1099 !> @param[in] td_var : variable structure 1100 !> 1101 !> @todo add schematic to description 1102 !------------------------------------------------------------------- 1103 !> @code 1248 !> @date November, 2013 - Initial Version 1249 ! 1250 !> @param[inout] td_bdy boundary structure 1251 !> @param[in] td_var variable structure 1252 !------------------------------------------------------------------- 1104 1253 SUBROUTINE boundary_check_corner( td_bdy, td_var ) 1105 1254 IMPLICIT NONE … … 1126 1275 ! check north west corner 1127 1276 IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_west)%l_use )THEN 1128 tl_west = td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)1129 tl_north= td_bdy(jp_north)%t_seg(1)1277 tl_west =seg__copy(td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)) 1278 tl_north=seg__copy(td_bdy(jp_north)%t_seg(1)) 1130 1279 1131 1280 IF( tl_west%i_last >= tl_north%i_index .AND. & … … 1148 1297 ENDIF 1149 1298 1150 td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)= tl_west1151 td_bdy(jp_north)%t_seg(1) = tl_north1299 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) 1152 1301 1153 1302 ELSE … … 1169 1318 ! check north east corner 1170 1319 IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_east)%l_use )THEN 1171 tl_east = td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)1172 tl_north= td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)1320 tl_east =seg__copy(td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)) 1321 tl_north=seg__copy(td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)) 1173 1322 1174 1323 IF( tl_east%i_last >= tl_north%i_index .AND. & … … 1191 1340 ENDIF 1192 1341 1193 td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)= tl_east1194 td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)= tl_north1342 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) 1195 1344 ELSE 1196 1345 … … 1211 1360 ! check south east corner 1212 1361 IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_east)%l_use )THEN 1213 tl_east = td_bdy(jp_east )%t_seg(1)1214 tl_south= td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)1362 tl_east =seg__copy(td_bdy(jp_east )%t_seg(1)) 1363 tl_south=seg__copy(td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)) 1215 1364 1216 1365 IF( tl_east%i_first <= tl_south%i_index .AND. & … … 1233 1382 ENDIF 1234 1383 1235 td_bdy(jp_east )%t_seg(1) = tl_east1236 td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)= tl_south1384 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) 1237 1386 ELSE 1238 1387 … … 1253 1402 ! check south west corner 1254 1403 IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_west)%l_use )THEN 1255 tl_west = td_bdy(jp_west )%t_seg(1)1256 tl_south= td_bdy(jp_south)%t_seg(1)1404 tl_west =seg__copy(td_bdy(jp_west )%t_seg(1)) 1405 tl_south=seg__copy(td_bdy(jp_south)%t_seg(1)) 1257 1406 1258 1407 IF( tl_west%i_first <= tl_south%i_index .AND. & … … 1275 1424 ENDIF 1276 1425 1277 td_bdy(jp_west )%t_seg(1) = tl_west1278 td_bdy(jp_south)%t_seg(1) = tl_south1426 td_bdy(jp_west )%t_seg(1) = seg__copy(tl_west) 1427 td_bdy(jp_south)%t_seg(1) = seg__copy(tl_south) 1279 1428 ELSE 1280 1429 … … 1293 1442 ENDIF 1294 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 1295 1450 END SUBROUTINE boundary_check_corner 1296 !> @endcode1297 1451 !------------------------------------------------------------------- 1298 1452 !> @brief This subroutine check boundary. … … 1303 1457 ! 1304 1458 !> @author J.Paul 1305 !> - Nov, 2013- Initial Version 1306 ! 1307 !> @param[inout] td_bdy : boundary structure 1308 !> @param[in] td_var : variable structure 1309 !------------------------------------------------------------------- 1310 !> @code 1459 !> @date November, 2013 - Initial Version 1460 ! 1461 !> @param[inout] td_bdy boundary structure 1462 !> @param[in] td_var variable structure 1463 !------------------------------------------------------------------- 1311 1464 SUBROUTINE boundary_check(td_bdy, td_var) 1312 1465 IMPLICIT NONE … … 1328 1481 il_max(jp_west )=td_var%t_dim(2)%i_len 1329 1482 1330 il_maxindex(jp_north)=td_var%t_dim(2)%i_len-i g_ghost1331 il_maxindex(jp_south)=td_var%t_dim(2)%i_len-i g_ghost1332 il_maxindex(jp_east )=td_var%t_dim(1)%i_len-i g_ghost1333 il_maxindex(jp_west )=td_var%t_dim(1)%i_len-i g_ghost1483 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 1334 1487 1335 1488 DO jk=1,ip_ncard … … 1366 1519 1367 1520 END SUBROUTINE boundary_check 1368 !> @endcode1369 !-------------------------------------------------------------------1370 !> @brief This subroutine clean interpolated boundary in variable structure.1371 !1372 !> @detail1373 !> interpolation could create more point than needed for boundary (depending1374 !> on refinement factor). This subroutine keep only useful point on variable1375 !>1376 !> @note we use width define in first segment, cause every segment of a1377 !> boundary should have the same width1378 !>1379 !> @author J.Paul1380 !> - Nov, 2013- Initial Version1381 !1382 !> @param[inout] td_var : variable strucutre1383 !> @param[in ] td_bdy : boundary strucutre1384 !-------------------------------------------------------------------1385 !> @code1386 SUBROUTINE boundary_clean_interp( td_var, td_bdy )1387 IMPLICIT NONE1388 ! Argument1389 TYPE(TVAR), INTENT(INOUT) :: td_var1390 TYPE(TBDY), INTENT(IN ) :: td_bdy1391 1392 ! local variable1393 TYPE(TVAR) :: tl_var1394 1395 INTEGER(i4) :: il_imin1396 INTEGER(i4) :: il_imax1397 INTEGER(i4) :: il_jmin1398 INTEGER(i4) :: il_jmax1399 1400 ! loop indices1401 !----------------------------------------------------------------1402 1403 ! copy input variable1404 tl_var=td_var1405 1406 DEALLOCATE(td_var%d_value)1407 1408 SELECT CASE(TRIM(td_bdy%c_card))1409 CASE('north')1410 1411 il_imin=11412 il_imax=tl_var%t_dim(1)%i_len1413 SELECT CASE(td_var%c_point)1414 CASE('V','F')1415 il_jmin=td_bdy%t_seg(1)%i_width+11416 il_jmax=21417 CASE DEFAULT ! 'T','U'1418 il_jmin=td_bdy%t_seg(1)%i_width1419 il_jmax=11420 END SELECT1421 1422 ! use width as dimension length1423 td_var%t_dim(2)%i_len=td_bdy%t_seg(1)%i_width1424 1425 CASE('south')1426 1427 il_imin=11428 il_imax=tl_var%t_dim(1)%i_len1429 1430 il_jmin=11431 il_jmax=td_bdy%t_seg(1)%i_width1432 1433 ! use width as dimension length1434 td_var%t_dim(2)%i_len=td_bdy%t_seg(1)%i_width1435 1436 CASE('east')1437 1438 SELECT CASE(td_var%c_point)1439 CASE('U','F')1440 il_imin=td_bdy%t_seg(1)%i_width+11441 il_imax=21442 CASE DEFAULT ! 'T','V'1443 il_imin=td_bdy%t_seg(1)%i_width1444 il_imax=11445 END SELECT1446 1447 il_jmin=11448 il_jmax=tl_var%t_dim(2)%i_len1449 1450 ! use width as dimension length1451 td_var%t_dim(1)%i_len=td_bdy%t_seg(1)%i_width1452 1453 CASE('west')1454 1455 il_imin=11456 il_imax=td_bdy%t_seg(1)%i_width1457 1458 il_jmin=11459 il_jmax=tl_var%t_dim(2)%i_len1460 1461 ! use width as dimension length1462 td_var%t_dim(1)%i_len=td_bdy%t_seg(1)%i_width1463 1464 END SELECT1465 1466 1467 ALLOCATE( td_var%d_value(td_var%t_dim(1)%i_len, &1468 & td_var%t_dim(2)%i_len, &1469 & td_var%t_dim(3)%i_len, &1470 & td_var%t_dim(4)%i_len) )1471 1472 IF( il_imin > il_imax )THEN1473 il_imin=tl_var%t_dim(1)%i_len-il_imin+11474 il_imax=tl_var%t_dim(1)%i_len-il_imax+11475 ENDIF1476 1477 IF( il_jmin > il_jmax )THEN1478 il_jmin=tl_var%t_dim(2)%i_len-il_jmin+11479 il_jmax=tl_var%t_dim(2)%i_len-il_jmax+11480 ENDIF1481 1482 td_var%d_value(:,:,:,:)=tl_var%d_value( il_imin:il_imax, &1483 & il_jmin:il_jmax, &1484 & :,: )1485 1486 CALL var_clean(tl_var)1487 1488 1489 END SUBROUTINE boundary_clean_interp1490 !> @endcode1491 1521 !------------------------------------------------------------------- 1492 1522 !> @brief This subroutine swap array for east and north boundary. … … 1495 1525 !> 1496 1526 !> @author J.Paul 1497 !> - Nov, 2013- Initial Version1527 !> @date November, 2013 - Initial Version 1498 1528 ! 1499 !> @param[inout] td_var :variable strucutre1500 !> @param[in ] td_bdy :boundary strucutre1529 !> @param[inout] td_var variable strucutre 1530 !> @param[in ] td_bdy boundary strucutre 1501 1531 !------------------------------------------------------------------- 1502 !> @code1503 1532 SUBROUTINE boundary_swap( td_var, td_bdy ) 1504 1533 IMPLICIT NONE … … 1516 1545 1517 1546 IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 1518 CALL logger_error("BOUNDARY SWAP: no tableof value "//&1547 CALL logger_error("BOUNDARY SWAP: no array of value "//& 1519 1548 & "associted to variable "//TRIM(td_var%c_name) ) 1520 1549 ELSE … … 1555 1584 ENDIF 1556 1585 END SUBROUTINE boundary_swap 1557 !> @endcode 1558 !------------------------------------------------------------------- 1559 !> @brief This subroutine print information about one boundary 1560 ! 1561 !> @details 1586 !------------------------------------------------------------------- 1587 !> @brief This subroutine print information about one boundary. 1562 1588 ! 1563 1589 !> @author J.Paul 1564 !> - Nov, 2013- Initial Version 1565 ! 1566 !> @param[in] td_bdy : boundary structure 1567 !------------------------------------------------------------------- 1568 !> @code 1590 !> @date November, 2013 - Initial Version 1591 ! 1592 !> @param[in] td_bdy boundary structure 1593 !------------------------------------------------------------------- 1569 1594 SUBROUTINE boundary__print_unit( td_bdy ) 1570 1595 IMPLICIT NONE … … 1588 1613 1589 1614 END SUBROUTINE boundary__print_unit 1590 !> @endcode 1591 !------------------------------------------------------------------- 1592 !> @brief This subroutine print information about a table of boundary 1615 !------------------------------------------------------------------- 1616 !> @brief This subroutine print information about a array of boundary 1593 1617 ! 1594 1618 !> @details 1595 1619 ! 1596 1620 !> @author J.Paul 1597 !> - Nov, 2013- Initial Version 1598 ! 1599 !> @param[in] td_bdy : boundary structure 1600 !------------------------------------------------------------------- 1601 !> @code 1602 SUBROUTINE boundary__print_tab( td_bdy ) 1621 !> @date November, 2013 - Initial Version 1622 ! 1623 !> @param[in] td_bdy boundary structure 1624 !------------------------------------------------------------------- 1625 SUBROUTINE boundary__print_arr( td_bdy ) 1603 1626 IMPLICIT NONE 1604 1627 ! Argument … … 1613 1636 ENDDO 1614 1637 1615 END SUBROUTINE boundary__print_tab 1616 !> @endcode 1638 END SUBROUTINE boundary__print_arr 1617 1639 !------------------------------------------------------------------- 1618 1640 !> @brief 1619 !> This subroutine copy segment structure in another segment 1620 !> structure 1621 !> @details 1641 !> This subroutine copy segment structure in another one. 1622 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. 1623 1646 !> @warning to avoid infinite loop, do not use any function inside 1624 1647 !> this subroutine 1625 1648 !> 1626 1649 !> @author J.Paul 1627 !> - Nov, 2013- Initial Version 1650 !> @date November, 2013 - Initial Version 1651 !> @date November, 2014 1652 !> - use function instead of overload assignment operator 1653 !> (to avoid memory leak) 1628 1654 ! 1629 !> @param[ out] td_seg1 :segment structure1630 !> @ param[in] td_seg2 :segment structure1655 !> @param[in] td_seg segment structure 1656 !> @return copy of input segment structure 1631 1657 !------------------------------------------------------------------- 1632 !> @code 1633 SUBROUTINE seg__copy( td_seg1, td_seg2 ) 1658 FUNCTION seg__copy_unit( td_seg ) 1634 1659 IMPLICIT NONE 1635 1660 ! Argument 1636 TYPE(TSEG), INTENT(OUT) :: td_seg1 1637 TYPE(TSEG), INTENT(IN) :: td_seg2 1661 TYPE(TSEG), INTENT(IN) :: td_seg 1662 ! function 1663 TYPE(TSEG) :: seg__copy_unit 1638 1664 1639 1665 ! local variable … … 1642 1668 1643 1669 ! copy segment index, width, .. 1644 td_seg1%i_index = td_seg2%i_index 1645 td_seg1%i_width = td_seg2%i_width 1646 td_seg1%i_first = td_seg2%i_first 1647 td_seg1%i_last = td_seg2%i_last 1648 1649 END SUBROUTINE seg__copy 1650 !> @endcode 1670 seg__copy_unit%i_index = td_seg%i_index 1671 seg__copy_unit%i_width = td_seg%i_width 1672 seg__copy_unit%i_first = td_seg%i_first 1673 seg__copy_unit%i_last = td_seg%i_last 1674 1675 END FUNCTION seg__copy_unit 1676 !------------------------------------------------------------------- 1677 !> @brief 1678 !> This subroutine copy segment structure in another one. 1679 !> 1680 !> @warning do not use on the output of a function who create or read a 1681 !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 1682 !> This will create memory leaks. 1683 !> @warning to avoid infinite loop, do not use any function inside 1684 !> this subroutine 1685 !> 1686 !> @author J.Paul 1687 !> @date November, 2013 - Initial Version 1688 !> @date November, 2014 1689 !> - use function instead of overload assignment operator 1690 !> (to avoid memory leak) 1691 ! 1692 !> @param[in] td_seg segment structure 1693 !> @return copy of input array of segment structure 1694 !------------------------------------------------------------------- 1695 FUNCTION seg__copy_arr( td_seg ) 1696 IMPLICIT NONE 1697 ! Argument 1698 TYPE(TSEG), DIMENSION(:), INTENT(IN) :: td_seg 1699 ! function 1700 TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: seg__copy_arr 1701 1702 ! local variable 1703 ! loop indices 1704 INTEGER(i4) :: ji 1705 !---------------------------------------------------------------- 1706 1707 DO ji=1,SIZE(td_seg(:)) 1708 seg__copy_arr(ji)=seg__copy(td_seg(ji)) 1709 ENDDO 1710 1711 END FUNCTION seg__copy_arr 1651 1712 !------------------------------------------------------------------- 1652 1713 !> @brief This function initialise segment structure. … … 1657 1718 ! 1658 1719 !> @author J.Paul 1659 !> - Nov, 2013- Initial Version1660 ! 1661 !> @param[in] id_index :orthogonal index1662 !> @param[in] id_width :width of the segment1663 !> @param[in] id_first :first indices1664 !> @param[in] id_last :last indices1720 !> @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 1665 1726 !> @return segment structure 1666 1727 !------------------------------------------------------------------- 1667 !> @code1668 1728 FUNCTION seg__init( id_index, id_width, id_first, id_last ) 1669 1729 IMPLICIT NONE … … 1689 1749 1690 1750 END FUNCTION seg__init 1691 !> @endcode1692 1751 !------------------------------------------------------------------- 1693 1752 !> @brief This subroutine clean segment structure. 1694 1753 ! 1695 !> @details1696 !1697 1754 !> @author J.Paul 1698 !> - Nov, 2013- Initial Version 1699 ! 1700 !> @param[inout] td_seg : segment structure 1701 !------------------------------------------------------------------- 1702 !> @code 1703 SUBROUTINE seg__clean(td_seg) 1755 !> @date November, 2013 - Initial Version 1756 ! 1757 !> @param[inout] td_seg segment structure 1758 !------------------------------------------------------------------- 1759 SUBROUTINE seg__clean_unit(td_seg) 1704 1760 IMPLICIT NONE 1705 1761 ! Argument … … 1710 1766 !---------------------------------------------------------------- 1711 1767 1712 td_seg= tl_seg1768 td_seg=seg__copy(tl_seg) 1713 1769 1714 END SUBROUTINE seg__clean 1715 !> @endcode 1716 ! !------------------------------------------------------------------- 1717 ! !> @brief This function 1718 ! ! 1719 ! !> @details 1720 ! ! 1721 ! !> @author J.Paul 1722 ! !> - Nov, 2013- Initial Version 1723 ! ! 1724 ! !> @param[in] 1725 ! !------------------------------------------------------------------- 1726 ! !> @code 1727 ! FUNCTION boundary_() 1728 ! IMPLICIT NONE 1729 ! ! Argument 1730 ! ! function 1731 ! ! local variable 1732 ! ! loop indices 1733 ! !---------------------------------------------------------------- 1734 ! 1735 ! END FUNCTION boundary_ 1736 ! !> @endcode 1737 ! !------------------------------------------------------------------- 1738 ! !> @brief This subroutine 1739 ! ! 1740 ! !> @details 1741 ! ! 1742 ! !> @author J.Paul 1743 ! !> - Nov, 2013- Initial Version 1744 ! ! 1745 ! !> @param[in] 1746 ! !------------------------------------------------------------------- 1747 ! !> @code 1748 ! SUBROUTINE boundary_() 1749 ! IMPLICIT NONE 1750 ! ! Argument 1751 ! ! local variable 1752 ! ! loop indices 1753 ! !---------------------------------------------------------------- 1754 ! 1755 ! END SUBROUTINE boundary_ 1756 ! !> @endcode 1770 END SUBROUTINE seg__clean_unit 1771 !------------------------------------------------------------------- 1772 !> @brief This subroutine clean segment structure. 1773 ! 1774 !> @author J.Paul 1775 !> @date November, 2013 - Initial Version 1776 ! 1777 !> @param[inout] td_seg array of segment structure 1778 !------------------------------------------------------------------- 1779 SUBROUTINE seg__clean_arr(td_seg) 1780 IMPLICIT NONE 1781 ! Argument 1782 TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg 1783 ! local variable 1784 ! loop indices 1785 INTEGER(i4) :: ji 1786 !---------------------------------------------------------------- 1787 1788 DO ji=SIZE(td_seg(:)),1,-1 1789 CALL seg__clean(td_seg(ji)) 1790 ENDDO 1791 1792 END SUBROUTINE seg__clean_arr 1757 1793 END MODULE boundary
Note: See TracChangeset
for help on using the changeset viewer.
