- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/boundary.f90
r4213 r6225 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 south boundary [optional] 29 !> - cd_east is string character description of east boundary [optional] 30 !> - cd_west is string character description of west boundary [optional] 31 !> - ld_oneseg is logical to force to use only one segment for each boundary [optional] 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 know if boundary come from namelist (cn_north,..):<br/> 40 !> - tl_bdy\%l_nam 16 41 !> 17 !> @author 18 !> J.Paul 42 !> to get the number of segment in boundary:<br/> 43 !> - tl_bdy\%i_nseg 44 !> 45 !> to get array of segment in boundary:<br/> 46 !> - tl_bdy\%t_seg(:) 47 !> 48 !> to get orthogonal segment index of north boundary:<br/> 49 !> - tl_bdy\%t_seg(jp_north)%\i_index 50 !> 51 !> to get segment width of south boundary:<br/> 52 !> - tl_bdy\%t_seg(jp_south)%\i_width 53 !> 54 !> to get segment first indice of east boundary:<br/> 55 !> - tl_bdy\%t_seg(jp_east)%\i_first 56 !> 57 !> to get segment last indice of west boundary:<br/> 58 !> - tl_bdy\%t_seg(jp_west)%\i_last 59 !> 60 !> to print information about boundary:<br/> 61 !> @code 62 !> CALL boundary_print(td_bdy) 63 !> @endcode 64 !> - td_bdy is boundary structure or a array of boundary structure 65 !> 66 !> to clean boundary structure:<br/> 67 !> @code 68 !> CALL boundary_clean(td_bdy) 69 !> @endcode 70 !> 71 !> to get indices of each semgent for each boundary:<br/> 72 !> @code 73 !> CALL boundary_get_indices( td_bdy, td_var, ld_oneseg) 74 !> @endcode 75 !> - td_bdy is boundary structure 76 !> - td_var is variable structure 77 !> - ld_oneseg is logical to force to use only one segment for each boundary [optional] 78 !> 79 !> to check boundary indices and corner:<br/> 80 !> @code 81 !> CALL boundary_check(td_bdy, td_var) 82 !> @endcode 83 !> - td_bdy is boundary structure 84 !> - td_var is variable structure 85 !> 86 !> to check boundary corner:<br/> 87 !> @code 88 !> CALL boundary_check_corner(td_bdy, td_var) 89 !> @endcode 90 !> - td_bdy is boundary structure 91 !> - td_var is variable structure 92 !> 93 !> to create filename with cardinal name inside:<br/> 94 !> @code 95 !> cl_filename=boundary_set_filename(cd_file, cd_card) 96 !> @endcode 97 !> - cd_file = original file name 98 !> - cd_card = cardinal name 99 !> 100 !> to swap array for east and north boundary:<br/> 101 !> @code 102 !> CALL boundary_swap( td_var, td_bdy ) 103 !> @endcode 104 !> - td_var is variable strucutre 105 !> - td_bdy is boundary strucutre 106 !> 107 !> @author J.Paul 19 108 ! REVISION HISTORY: 20 !> @date Nov, 2013 - Initial Version 21 !> @todo 22 !> - add description generique de l'objet boundary 109 !> @date November, 2013 - Initial Version 110 !> @date September, 2014 111 !> - add boundary description 112 !> @date November, 2014 113 !> - Fix memory leaks bug 114 !> @date February, 2015 115 !> - Do not change indices read from namelist 116 !> - Change string character format of boundary read from namelist, 117 !> see boundary__get_info 118 !> 119 !> @todo add schematic to boundary structure description 23 120 !> 24 121 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 29 126 USE phycst ! physical constant 30 127 USE kind ! F90 kind parameter 31 USE logger 128 USE logger ! log file manager 32 129 USE fct ! basic useful function 33 ! USE date ! date manager34 ! USE att ! attribute manager35 ! USE dim ! dimension manager36 130 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 131 47 132 IMPLICIT NONE 48 PRIVATE49 133 ! NOTE_avoid_public_variables_if_possible 50 134 51 135 ! type and variable 52 PUBLIC :: ip_ncard !< number of cardinal point53 PUBLIC :: ip_card !< table of cardinal point54 136 PUBLIC :: TBDY !< boundary structure 55 137 PUBLIC :: TSEG !< segment structure 56 138 139 PRIVATE :: im_width !< boundary width 140 57 141 ! function and subroutine 142 PUBLIC :: boundary_copy !< copy boundary structure 58 143 PUBLIC :: boundary_init !< initialise boundary structure 59 144 PUBLIC :: boundary_print !< print information about boundary … … 63 148 PUBLIC :: boundary_check_corner !< check boundary corner 64 149 PUBLIC :: boundary_set_filename !< set boundary filename 65 PUBLIC :: boundary_clean_interp !< clean interpolated boundary66 150 PUBLIC :: boundary_swap !< swap array for north and east boundary 67 151 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 152 PRIVATE :: boundary__clean_unit ! clean boundary structure 153 PRIVATE :: boundary__clean_arr ! clean array of boundary structure 154 PRIVATE :: boundary__init_wrapper ! initialise a boundary structure 155 PRIVATE :: boundary__init ! initialise basically a boundary structure 156 PRIVATE :: boundary__copy_unit ! copy boundary structure in another 157 PRIVATE :: boundary__copy_arr ! copy boundary structure in another 158 PRIVATE :: boundary__add_seg ! add one segment structure to a boundary 159 PRIVATE :: boundary__del_seg ! remove all segments of a boundary 160 PRIVATE :: boundary__get_info ! get boundary information from boundary description string character. 161 PRIVATE :: boundary__get_seg_number ! compute the number of sea segment for one boundary 162 PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary 163 PRIVATE :: boundary__print_unit ! print information about one boundary 164 PRIVATE :: boundary__print_arr ! print information about a array of boundary 80 165 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 166 PRIVATE :: seg__init ! initialise segment structure 167 PRIVATE :: seg__clean ! clean segment structure 168 PRIVATE :: seg__clean_unit ! clean one segment structure 169 PRIVATE :: seg__clean_arr ! clean array of segment structure 170 PRIVATE :: seg__copy ! copy segment structure in another 171 PRIVATE :: seg__copy_unit ! copy segment structure in another 172 PRIVATE :: seg__copy_arr ! copy array of segment structure in another 173 174 TYPE TSEG !< segment structure 87 175 INTEGER(i4) :: i_index = 0 !< segment index 88 176 INTEGER(i4) :: i_width = 0 !< segment width … … 91 179 END TYPE TSEG 92 180 93 !> @struct94 TYPE TBDY95 CHARACTER(LEN=lc) :: c_card = ''96 LOGICAL :: l_ use = .FALSE.97 INTEGER(i4) :: i_nseg = 0 98 TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() 181 TYPE TBDY !< boundary structure 182 CHARACTER(LEN=lc) :: c_card = '' !< boundary cardinal 183 LOGICAL :: l_use = .FALSE. !< boundary use or not 184 LOGICAL :: l_nam = .FALSE. !< boundary get from namelist 185 INTEGER(i4) :: i_nseg = 0 !< number of segment in boundary 186 TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !< array of segment structure 99 187 END TYPE TBDY 100 188 101 INTEGER(i4), PARAMETER :: ip_ncard=4 102 CHARACTER(LEN=lc), DIMENSION(ip_ncard), PARAMETER :: ip_card = & 103 & (/ 'north', & 104 & 'south', & 105 & 'east ', & 106 & 'west ' /) 107 108 INTEGER(i4), PARAMETER :: jp_north=1 109 INTEGER(i4), PARAMETER :: jp_south=2 110 INTEGER(i4), PARAMETER :: jp_east =3 111 INTEGER(i4), PARAMETER :: jp_west =4 112 189 ! module variable 113 190 INTEGER(i4), PARAMETER :: im_width=10 114 191 … … 119 196 INTERFACE boundary_print 120 197 MODULE PROCEDURE boundary__print_unit 121 MODULE PROCEDURE boundary__print_ tab198 MODULE PROCEDURE boundary__print_arr 122 199 END INTERFACE boundary_print 123 200 124 INTERFACE ASSIGNMENT(=) 201 INTERFACE boundary_clean 202 MODULE PROCEDURE boundary__clean_unit 203 MODULE PROCEDURE boundary__clean_arr 204 END INTERFACE 205 206 INTERFACE seg__clean 207 MODULE PROCEDURE seg__clean_unit 208 MODULE PROCEDURE seg__clean_arr 209 END INTERFACE 210 211 INTERFACE boundary_copy 125 212 MODULE PROCEDURE boundary__copy_unit 126 MODULE PROCEDURE boundary__copy_tab 127 MODULE PROCEDURE seg__copy ! copy segment structure 213 MODULE PROCEDURE boundary__copy_arr 214 END INTERFACE 215 216 INTERFACE seg__copy 217 MODULE PROCEDURE seg__copy_unit ! copy segment structure 218 MODULE PROCEDURE seg__copy_arr ! copy array of segment structure 128 219 END INTERFACE 129 220 … … 131 222 !------------------------------------------------------------------- 132 223 !> @brief 133 !> This subroutine copy boundary structure in another boundary 134 !> structure 224 !> This subroutine copy a array of boundary structure in another one 135 225 !> @details 136 226 !> 227 !> @warning do not use on the output of a function who create or read an 228 !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden). 229 !> This will create memory leaks. 137 230 !> @warning to avoid infinite loop, do not use any function inside 138 231 !> this subroutine 139 232 !> 140 233 !> @author J.Paul 141 !> - Nov, 2013- Initial Version 234 !> @date November, 2013 - Initial Version 235 !> @date November, 2014 236 !> - use function instead of overload assignment operator 237 !> (to avoid memory leak) 142 238 ! 143 !> @param[ out] td_bdy1 :boundary structure144 !> @ param[in] td_bdy2 : boundary structure239 !> @param[in] td_bdy array of boundary structure 240 !> @return copy of input array of boundary structure 145 241 !------------------------------------------------------------------- 146 !> @code 147 SUBROUTINE boundary__copy_tab( td_bdy1, td_bdy2 ) 242 FUNCTION boundary__copy_arr( td_bdy ) 148 243 IMPLICIT NONE 149 244 ! Argument 150 TYPE(TBDY), DIMENSION(:), INTENT(OUT) :: td_bdy1 151 TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy2 245 TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy 246 ! function 247 TYPE(TBDY), DIMENSION(SIZE(td_bdy(:))) :: boundary__copy_arr 152 248 153 249 ! local variable … … 156 252 !---------------------------------------------------------------- 157 253 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 254 DO jk=1,SIZE(td_bdy(:)) 255 boundary__copy_arr(jk)=boundary_copy(td_bdy(jk)) 256 ENDDO 257 258 END FUNCTION boundary__copy_arr 167 259 !------------------------------------------------------------------- 168 260 !> @brief 169 !> This subroutine copy boundary structure in another boundary 170 !> structure 261 !> This subroutine copy boundary structure in another one 171 262 !> @details 172 263 !> 264 !> @warning do not use on the output of a function who create or read an 265 !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden). 266 !> This will create memory leaks. 173 267 !> @warning to avoid infinite loop, do not use any function inside 174 268 !> this subroutine 175 269 !> 176 270 !> @author J.Paul 177 !> - Nov, 2013- Initial Version 271 !> @date November, 2013 - Initial Version 272 !> @date November, 2014 273 !> - use function instead of overload assignment operator 274 !> (to avoid memory leak) 178 275 ! 179 !> @param[ out] td_bdy1 :boundary structure180 !> @ param[in] td_bdy2 :boundary structure276 !> @param[in] td_bdy boundary structure 277 !> @return copy of input boundary structure 181 278 !------------------------------------------------------------------- 182 !> @code 183 SUBROUTINE boundary__copy_unit( td_bdy1, td_bdy2 ) 279 FUNCTION boundary__copy_unit( td_bdy ) 184 280 IMPLICIT NONE 185 281 ! Argument 186 TYPE(TBDY), INTENT(OUT) :: td_bdy1 187 TYPE(TBDY), INTENT(IN) :: td_bdy2 282 TYPE(TBDY), INTENT(IN) :: td_bdy 283 ! function 284 TYPE(TBDY) :: boundary__copy_unit 188 285 189 286 ! local variable … … 193 290 194 291 ! 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_use292 boundary__copy_unit%c_card = TRIM(td_bdy%c_card) 293 boundary__copy_unit%i_nseg = td_bdy%i_nseg 294 boundary__copy_unit%l_use = td_bdy%l_use 198 295 199 296 ! 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) 297 IF( ASSOCIATED(boundary__copy_unit%t_seg) )THEN 298 CALL seg__clean(boundary__copy_unit%t_seg(:)) 299 DEALLOCATE(boundary__copy_unit%t_seg) 300 ENDIF 301 IF( ASSOCIATED(td_bdy%t_seg) .AND. boundary__copy_unit%i_nseg > 0 )THEN 302 ALLOCATE( boundary__copy_unit%t_seg(boundary__copy_unit%i_nseg) ) 303 DO ji=1,boundary__copy_unit%i_nseg 304 boundary__copy_unit%t_seg(ji)=td_bdy%t_seg(ji) 205 305 ENDDO 206 306 ENDIF 207 307 208 END SUBROUTINE boundary__copy_unit 209 !> @endcode 308 END FUNCTION boundary__copy_unit 210 309 !------------------------------------------------------------------- 211 310 !> @brief This subroutine clean boundary structure 212 311 ! 213 312 !> @author J.Paul 214 !> - Nov, 2013- Initial Version313 !> @date November, 2013 - Initial Version 215 314 ! 216 !> @param[inout] td_bdy :boundary strucutre315 !> @param[inout] td_bdy boundary strucutre 217 316 !------------------------------------------------------------------- 218 !> @code 219 SUBROUTINE boundary_clean( td_bdy ) 317 SUBROUTINE boundary__clean_unit( td_bdy ) 220 318 IMPLICIT NONE 221 319 ! Argument … … 226 324 227 325 ! loop indices 326 !---------------------------------------------------------------- 327 328 CALL logger_info( & 329 & " CLEAN: reset boundary "//TRIM(td_bdy%c_card) ) 330 331 ! del segment 332 IF( ASSOCIATED(td_bdy%t_seg) )THEN 333 ! clean each segment 334 CALL seg__clean(td_bdy%t_seg(:) ) 335 DEALLOCATE( td_bdy%t_seg ) 336 ENDIF 337 338 ! replace by empty structure 339 td_bdy=boundary_copy(tl_bdy) 340 341 END SUBROUTINE boundary__clean_unit 342 !------------------------------------------------------------------- 343 !> @brief This subroutine clean array of boundary structure 344 ! 345 !> @author J.Paul 346 !> @date September, 2014 - Initial Version 347 ! 348 !> @param[inout] td_bdy boundary strucutre 349 !------------------------------------------------------------------- 350 SUBROUTINE boundary__clean_arr( td_bdy ) 351 IMPLICIT NONE 352 ! Argument 353 TYPE(TBDY), DIMENSION(:), INTENT(INOUT) :: td_bdy 354 355 ! local variable 356 ! loop indices 228 357 INTEGER(i4) :: ji 229 358 !---------------------------------------------------------------- 230 359 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 360 DO ji=SIZE(td_bdy(:)),1,-1 361 CALL boundary_clean( td_bdy(ji) ) 362 ENDDO 363 364 END SUBROUTINE boundary__clean_arr 365 !------------------------------------------------------------------- 366 !> @brief This function put cardinal name and date inside file name. 250 367 ! 251 368 !> @details 252 ! 369 !> Examples : 370 !> cd_file="boundary.nc" 371 !> cd_card="west" 372 !> id_seg =2 373 !> cd_date=y2015m07d16 374 !> 375 !> function return "boundary_west_2_y2015m07d16.nc" 376 !> 377 !> cd_file="boundary.nc" 378 !> cd_card="west" 379 !> 380 !> function return "boundary_west.nc" 381 !> 253 382 !> @author J.Paul 254 !> - Nov, 2013- Initial Version 255 ! 256 !> @param[in] cd_file : file name 257 !> @param[in] cd_card : cardinal name 383 !> @date November, 2013 - Initial Version 384 ! 385 !> @param[in] cd_file file name 386 !> @param[in] cd_card cardinal name 387 !> @param[in] id_seg segment number 388 !> @param[in] cd_date file date (format: y????m??d??) 258 389 !> @return file name with cardinal name inside 259 390 !------------------------------------------------------------------- 260 !> @code 261 FUNCTION boundary_set_filename(cd_file, cd_card) 391 FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) 262 392 IMPLICIT NONE 263 393 ! Argument 264 394 CHARACTER(LEN=*), INTENT(IN) :: cd_file 265 395 CHARACTER(LEN=*), INTENT(IN) :: cd_card 396 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_seg 397 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date 266 398 267 399 ! function … … 273 405 CHARACTER(LEN=lc) :: cl_base 274 406 CHARACTER(LEN=lc) :: cl_suffix 407 CHARACTER(LEN=lc) :: cl_segnum 408 CHARACTER(LEN=lc) :: cl_date 275 409 CHARACTER(LEN=lc) :: cl_name 410 411 INTEGER(i4) :: il_ind 412 INTEGER(i4) :: il_indend 413 276 414 ! loop indices 277 415 !---------------------------------------------------------------- … … 288 426 cl_base =fct_split(TRIM(cl_basename),1,'.') 289 427 cl_suffix=fct_split(TRIM(cl_basename),2,'.') 290 291 cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//"."//TRIM(cl_suffix) 428 429 ! add segment number 430 IF( PRESENT(id_seg) )THEN 431 cl_segnum="_"//TRIM(fct_str(id_seg)) 432 ELSE 433 cl_segnum="" 434 ENDIF 435 436 ! add date 437 IF( PRESENT(cd_date) )THEN 438 cl_date="_"//TRIM(ADJUSTL(cd_date)) 439 ELSE 440 cl_date="" 441 ENDIF 442 443 ! special case for obcdta 444 il_ind=INDEX(cl_base,'_obcdta_') 445 IF( il_ind/=0 )THEN 446 il_ind=il_ind-1+8 447 il_indend=LEN_TRIM(cl_base) 448 449 cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//& 450 & TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//& 451 & TRIM(cl_date)//"."//TRIM(cl_suffix) 452 ELSE 453 cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 454 & TRIM(cl_date)//"."//TRIM(cl_suffix) 455 ENDIF 292 456 293 457 boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) … … 298 462 299 463 END FUNCTION boundary_set_filename 300 !> @endcode 301 !------------------------------------------------------------------- 302 !> @brief This function initialise a boundary structure 464 !------------------------------------------------------------------- 465 !> @brief This function initialise a boundary structure. 303 466 ! 304 467 !> @details … … 318 481 !> specify it for each segment. 319 482 !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 320 ! 483 !> 484 !> @note Boundaries are compute on T point, but expressed on U,V point. 485 !> change will be done to get data on other point when need be. 486 !> 321 487 !> @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 488 !> @date November, 2013 - Initial Version 489 !> @date September, 2014 490 !> - add boolean to use only one segment for each boundary 491 !> - check boundary width 492 ! 493 !> @param[in] td_var variable structure 494 !> @param[in] ld_north use north boundary or not 495 !> @param[in] ld_south use south boundary or not 496 !> @param[in] ld_east use east boundary or not 497 !> @param[in] ld_west use west boundary or not 498 !> @param[in] cd_north north boundary description 499 !> @param[in] cd_south south boundary description 500 !> @param[in] cd_east east boundary description 501 !> @param[in] cd_west west boundary description 502 !> @param[in] ld_oneseg force to use only one segment for each boundary 333 503 !> @return boundary structure 334 !> @todo use bondary_get_indices !!!! 335 !------------------------------------------------------------------- 336 !> @code 504 !------------------------------------------------------------------- 337 505 FUNCTION boundary__init_wrapper(td_var, & 338 506 & ld_north, ld_south, ld_east, ld_west, & … … 356 524 357 525 ! local variable 526 INTEGER(i4) :: il_width 527 INTEGER(i4) , DIMENSION(ip_ncard) :: il_max_width 358 528 INTEGER(i4) , DIMENSION(ip_ncard) :: il_index 359 529 INTEGER(i4) , DIMENSION(ip_ncard) :: il_min … … 390 560 tl_bdy(jp_west )=boundary__init('west ',ld_west ) 391 561 392 ! if EW cyclic no east west boundary 562 ! if EW cyclic no east west boundary and force to use one segment 393 563 IF( td_var%i_ew >= 0 )THEN 394 CALL logger_debug("BOUNDARY INIT: cyclic no East West boundary") 564 CALL logger_info("BOUNDARY INIT: cyclic domain, "//& 565 & "no East West boundary") 395 566 tl_bdy(jp_east )%l_use=.FALSE. 396 567 tl_bdy(jp_west )%l_use=.FALSE. 568 569 CALL logger_info("BOUNDARY INIT: force to use one segment due"//& 570 & " to EW cyclic domain") 571 ll_oneseg=.TRUE. 397 572 ENDIF 398 573 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 574 il_index(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 575 il_index(jp_south)=1+ip_ghost 576 il_index(jp_east )=td_var%t_dim(1)%i_len-ip_ghost 577 il_index(jp_west )=1+ip_ghost 404 578 405 579 il_min(jp_north)=1 … … 419 593 IF( PRESENT(cd_west ) ) cl_card(jp_west )=TRIM(cd_west ) 420 594 595 il_max_width(jp_north)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost)) 596 il_max_width(jp_south)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost)) 597 il_max_width(jp_east )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost)) 598 il_max_width(jp_west )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost)) 599 421 600 DO jk=1,ip_ncard 422 601 602 ! check boundary width 603 IF( il_max_width(jk) <= im_width )THEN 604 IF( il_max_width(jk) <= 0 )THEN 605 CALL logger_fatal("BOUNDARY INIT: domain too small to define"//& 606 & " boundaries.") 607 ELSE 608 CALL logger_warn("BOUNDARY INIT: default boundary width too "//& 609 & "large for boundaries. force to use boundary"//& 610 & " on one point") 611 il_width=1 612 ENDIF 613 ELSE 614 il_width=im_width 615 ENDIF 616 423 617 ! define default segment 424 tl_seg=seg__init(il_index(jk),i m_width,il_min(jk),il_max(jk))618 tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk)) 425 619 426 620 IF( tl_bdy(jk)%l_use )THEN 427 621 428 622 ! get namelist information 429 tl_tmp=boundary__get_info(cl_card(jk)) 623 tl_tmp=boundary__get_info(cl_card(jk),jk) 624 625 ! get segments indices 430 626 DO ji=1,tl_tmp%i_nseg 431 627 CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji)) 432 628 ENDDO 629 ! indices from namelist or not 630 tl_bdy(jk)%l_nam=tl_tmp%l_nam 631 433 632 CALL boundary_clean(tl_tmp) 434 633 … … 453 652 454 653 ENDIF 654 ! clean 655 CALL seg__clean(tl_seg) 455 656 456 657 ENDDO … … 460 661 CALL boundary_check(tl_bdy, td_var) 461 662 462 boundary__init_wrapper(:)= tl_bdy(:)663 boundary__init_wrapper(:)=boundary_copy(tl_bdy(:)) 463 664 464 665 ! clean … … 470 671 471 672 END FUNCTION boundary__init_wrapper 472 !> @endcode473 673 !------------------------------------------------------------------- 474 674 !> @brief This function initialise basically a boundary structure with … … 480 680 ! 481 681 !> @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 structure682 !> @date November, 2013 - Initial Version 683 ! 684 !> @param[in] cd_card cardinal name 685 !> @param[in] ld_use boundary use or not 686 !> @param[in] td_seg segment structure 487 687 !> @return boundary structure 488 688 !------------------------------------------------------------------- 489 !> @code 490 FUNCTION boundary__init( cd_card, ld_use, td_seg ) 689 FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg ) 491 690 IMPLICIT NONE 492 691 ! Argument 493 692 CHARACTER(LEN=*), INTENT(IN) :: cd_card 494 693 LOGICAL , INTENT(IN), OPTIONAL :: ld_use 694 LOGICAL , INTENT(IN), OPTIONAL :: ld_nam 495 695 TYPE(TSEG) , INTENT(IN), OPTIONAL :: td_seg 496 696 … … 511 711 IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use 512 712 713 boundary__init%l_nam=.FALSE. 714 IF( PRESENT(ld_nam) ) boundary__init%l_nam=ld_nam 715 513 716 IF( PRESENT(td_seg) )THEN 514 717 CALL boundary__add_seg(boundary__init, td_seg) … … 520 723 521 724 END FUNCTION boundary__init 522 !> @endcode523 725 !------------------------------------------------------------------- 524 726 !> @brief This subroutine add one segment structure to a boundary structure … … 527 729 ! 528 730 !> @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 731 !> @date November, 2013 - Initial Version 732 ! 733 !> @param[inout] td_bdy boundary structure 734 !> @param[in] td_seg segment structure 735 !------------------------------------------------------------------- 535 736 SUBROUTINE boundary__add_seg(td_bdy, td_seg) 536 737 IMPLICIT NONE … … 554 755 ELSE 555 756 ! save temporary segment 556 tl_seg(:)=td_bdy%t_seg(:) 557 757 tl_seg(:)=seg__copy(td_bdy%t_seg(:)) 758 759 CALL seg__clean(td_bdy%t_seg(:)) 558 760 DEALLOCATE( td_bdy%t_seg ) 559 761 ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status ) … … 564 766 565 767 ! copy segment in boundary before 566 td_bdy%t_seg(1:td_bdy%i_nseg)=tl_seg(:) 567 768 td_bdy%t_seg(1:td_bdy%i_nseg)=seg__copy(tl_seg(:)) 769 770 ! clean 771 CALL seg__clean(tl_seg(:)) 568 772 DEALLOCATE(tl_seg) 569 773 … … 572 776 ! no segment in boundary structure 573 777 IF( ASSOCIATED(td_bdy%t_seg) )THEN 778 CALL seg__clean(td_bdy%t_seg(:)) 574 779 DEALLOCATE(td_bdy%t_seg) 575 780 ENDIF … … 585 790 586 791 ! add new segment 587 td_bdy%t_seg(td_bdy%i_nseg)= td_seg792 td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg) 588 793 589 794 END SUBROUTINE boundary__add_seg 590 !> @endcode591 795 !------------------------------------------------------------------- 592 796 !> @brief This subroutine remove all segments of a boundary structure … … 595 799 ! 596 800 !> @author J.Paul 597 !> - Nov, 2013- Initial Version 598 ! 599 !> @param[inout] td_bdy : boundary structure 600 !------------------------------------------------------------------- 601 !> @code 801 !> @date November, 2013 - Initial Version 802 ! 803 !> @param[inout] td_bdy boundary structure 804 !------------------------------------------------------------------- 602 805 SUBROUTINE boundary__del_seg(td_bdy) 603 806 IMPLICIT NONE … … 610 813 611 814 IF( ASSOCIATED(td_bdy%t_seg) )THEN 815 CALL seg__clean(td_bdy%t_seg(:)) 612 816 DEALLOCATE(td_bdy%t_seg) 613 817 ENDIF … … 616 820 617 821 END SUBROUTINE boundary__del_seg 618 !> @endcode619 822 !------------------------------------------------------------------- 620 823 !> @brief This function get information about boundary from string character. … … 624 827 !> orthogonal index, first and last indices, of each segment. 625 828 !> And also the width of all segments of this boundary. 626 !> cn_north='index1,first1 ,last1(width)|index2,first2,last2'829 !> cn_north='index1,first1:last1(width)|index2,first2:last2' 627 830 !> 628 831 !> @author J.Paul 629 !> - Nov, 2013- Initial Version 630 ! 631 !> @param[in] cd_card : boundary description 832 !> @date November, 2013 - Initial Version 833 !> @date february, 2015 834 !> - do not change indices read from namelist 835 !> - change format cn_north 836 ! 837 !> @param[in] cd_card boundary description 838 !> @param[in] id_jcard boundary index 632 839 !> @return boundary structure 633 840 !------------------------------------------------------------------- 634 !> @code 635 FUNCTION boundary__get_info(cd_card) 841 FUNCTION boundary__get_info(cd_card, id_jcard) 636 842 IMPLICIT NONE 637 843 ! Argument 638 844 CHARACTER(LEN=lc), INTENT(IN) :: cd_card 845 INTEGER(i4) , INTENT(IN) :: id_jcard 639 846 640 847 ! function … … 649 856 CHARACTER(LEN=lc) :: cl_index 650 857 CHARACTER(LEN=lc) :: cl_width 858 CHARACTER(LEN=lc) :: cl_tmp 651 859 CHARACTER(LEN=lc) :: cl_first 652 860 CHARACTER(LEN=lc) :: cl_last … … 665 873 ! width should be the same for all segment of one boundary 666 874 IF( TRIM(cl_seg) /= '' )THEN 875 876 ! initialise boundary 877 ! temporaty boundary, so it doesn't matter which caridnal is used 878 boundary__get_info=boundary__init('north',ld_nam=.TRUE.) 879 667 880 il_ind1=SCAN(fct_lower(cl_seg),'(') 668 881 IF( il_ind1 /=0 )THEN … … 678 891 ENDIF 679 892 ENDIF 893 680 894 ENDIF 681 895 … … 686 900 il_ind1=SCAN(fct_lower(cl_index),'(') 687 901 IF( il_ind1 /=0 )THEN 688 il_ind2=SCAN(fct_lower(cl_index),' (')902 il_ind2=SCAN(fct_lower(cl_index),')') 689 903 IF( il_ind2 /=0 )THEN 690 904 cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:)) … … 695 909 ENDIF 696 910 697 cl_first=fct_split(cl_seg,2,',') 911 912 cl_tmp=fct_split(cl_seg,2,',') 913 914 915 cl_first=fct_split(cl_tmp,1,':') 698 916 ! remove potential width information 699 917 il_ind1=SCAN(fct_lower(cl_first),'(') 700 918 IF( il_ind1 /=0 )THEN 701 il_ind2=SCAN(fct_lower(cl_first),' (')919 il_ind2=SCAN(fct_lower(cl_first),')') 702 920 IF( il_ind2 /=0 )THEN 703 921 cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:)) … … 708 926 ENDIF 709 927 710 cl_last =fct_split(cl_ seg,3,',')928 cl_last =fct_split(cl_tmp,2,':') 711 929 ! remove potential width information 712 930 il_ind1=SCAN(fct_lower(cl_last),'(') 713 931 IF( il_ind1 /=0 )THEN 714 il_ind2=SCAN(fct_lower(cl_last),' (')932 il_ind2=SCAN(fct_lower(cl_last),')') 715 933 IF( il_ind2 /=0 )THEN 716 934 cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:)) … … 726 944 IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first 727 945 IF( TRIM(cl_last) /= '' ) READ(cl_last ,*) tl_seg%i_last 946 947 ! index expressed on U,V point, move on T point. 948 SELECT CASE(id_jcard) 949 CASE(jp_north, jp_east) 950 tl_seg%i_index=tl_seg%i_index+1 951 END SELECT 728 952 729 953 IF( (tl_seg%i_first == 0 .AND. tl_seg%i_last == 0) .OR. & … … 737 961 ji=ji+1 738 962 cl_seg=fct_split(cd_card,ji) 963 964 ! clean 965 CALL seg__clean(tl_seg) 739 966 ENDDO 740 967 741 968 END FUNCTION boundary__get_info 742 !> @endcode743 969 !------------------------------------------------------------------- 744 970 !> @brief This subroutine get indices of each semgent for each boundary. … … 757 983 ! 758 984 !> @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 985 !> @date November, 2013 - Initial Version 986 ! 987 !> @param[inout] td_bdy boundary structure 988 !> @param[in] td_var variable structure 989 !> @param[in] ld_onseg use only one sgment for each boundary 990 !------------------------------------------------------------------- 766 991 SUBROUTINE boundary_get_indices( td_bdy, td_var, ld_oneseg) 767 992 IMPLICIT NONE … … 789 1014 790 1015 DO jk=1,ip_ncard 791 IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)% i_nseg > 1)THEN1016 IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN 792 1017 ! nothing to be done 793 1018 ELSE … … 811 1036 812 1037 IF( ll_oneseg .AND. td_bdy(jk)%l_use )THEN 813 tl_seg= td_bdy(jk)%t_seg(1)1038 tl_seg=seg__copy(td_bdy(jk)%t_seg(1)) 814 1039 ! use last indice of last segment 815 1040 tl_seg%i_last=td_bdy(jk)%t_seg(td_bdy(jk)%i_nseg)%i_last … … 820 1045 ! add one segment 821 1046 CALL boundary__add_seg(td_bdy(jk),tl_seg) 1047 1048 ! clean 1049 CALL seg__clean(tl_seg) 822 1050 ENDIF 823 1051 … … 829 1057 830 1058 END SUBROUTINE boundary_get_indices 831 !> @endcode832 1059 !------------------------------------------------------------------- 833 1060 !> @brief This subroutine compute the number of sea segment. … … 841 1068 ! 842 1069 !> @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 1070 !> @date November, 2013 - Initial Version 1071 ! 1072 !> @param[inout] td_bdy boundary structure 1073 !> @param[in] td_var variable structure 1074 !------------------------------------------------------------------- 849 1075 SUBROUTINE boundary__get_seg_number( td_bdy, td_var) 850 1076 IMPLICIT NONE … … 927 1153 END SELECT 928 1154 ENDIF 929 930 1155 931 1156 END SUBROUTINE boundary__get_seg_number 932 !> @endcode933 1157 !------------------------------------------------------------------- 934 1158 !> @brief This subroutine get segment indices for one boundary. … … 937 1161 ! 938 1162 !> @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 1163 !> @date November, 2013 - Initial Version 1164 ! 1165 !> @param[inout] td_bdy boundary structure 1166 !> @param[in] td_var variable structure 1167 !> @param[in] id_index boundary orthogonal index 1168 !> @param[in] id_width bounary width 1169 !> @param[in] id_first boundary first indice 1170 !> @param[in] id_last boundary last indice 1171 !------------------------------------------------------------------- 949 1172 SUBROUTINE boundary__get_seg_indices( td_bdy, td_var, & 950 1173 & id_index, id_width, id_first, id_last) … … 1004 1227 END SELECT 1005 1228 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_ghost1229 il_max(jp_north)=td_var%t_dim(1)%i_len-ip_ghost 1230 il_max(jp_south)=td_var%t_dim(1)%i_len-ip_ghost 1231 il_max(jp_east )=td_var%t_dim(2)%i_len-ip_ghost 1232 il_max(jp_west )=td_var%t_dim(2)%i_len-ip_ghost 1233 1234 il_min(jp_north)=1+ip_ghost 1235 il_min(jp_south)=1+ip_ghost 1236 il_min(jp_east )=1+ip_ghost 1237 il_min(jp_west )=1+ip_ghost 1015 1238 1016 1239 ! special case for EW cyclic … … 1074 1297 CALL boundary__add_seg(td_bdy,tl_seg) 1075 1298 1299 ! clean 1076 1300 CALL seg__clean(tl_seg) 1077 1301 … … 1081 1305 1082 1306 END SUBROUTINE boundary__get_seg_indices 1083 !> @endcode1084 1307 !------------------------------------------------------------------- 1085 1308 !> @brief This subroutine check if there is boundary at corner, and … … 1094 1317 ! 1095 1318 !> @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 1319 !> @date November, 2013 - Initial Version 1320 ! 1321 !> @param[inout] td_bdy boundary structure 1322 !> @param[in] td_var variable structure 1323 !------------------------------------------------------------------- 1104 1324 SUBROUTINE boundary_check_corner( td_bdy, td_var ) 1105 1325 IMPLICIT NONE … … 1126 1346 ! check north west corner 1127 1347 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)1348 tl_west =seg__copy(td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)) 1349 tl_north=seg__copy(td_bdy(jp_north)%t_seg(1)) 1130 1350 1131 1351 IF( tl_west%i_last >= tl_north%i_index .AND. & … … 1148 1368 ENDIF 1149 1369 1150 td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)= tl_west1151 td_bdy(jp_north)%t_seg(1) = tl_north1370 td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)=seg__copy(tl_west) 1371 td_bdy(jp_north)%t_seg(1) =seg__copy(tl_north) 1152 1372 1153 1373 ELSE … … 1169 1389 ! check north east corner 1170 1390 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)1391 tl_east =seg__copy(td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)) 1392 tl_north=seg__copy(td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)) 1173 1393 1174 1394 IF( tl_east%i_last >= tl_north%i_index .AND. & … … 1191 1411 ENDIF 1192 1412 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_north1413 td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)=seg__copy(tl_east) 1414 td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)=seg__copy(tl_north) 1195 1415 ELSE 1196 1416 … … 1211 1431 ! check south east corner 1212 1432 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)1433 tl_east =seg__copy(td_bdy(jp_east )%t_seg(1)) 1434 tl_south=seg__copy(td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)) 1215 1435 1216 1436 IF( tl_east%i_first <= tl_south%i_index .AND. & … … 1233 1453 ENDIF 1234 1454 1235 td_bdy(jp_east )%t_seg(1) = tl_east1236 td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)= tl_south1455 td_bdy(jp_east )%t_seg(1) =seg__copy(tl_east) 1456 td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)=seg__copy(tl_south) 1237 1457 ELSE 1238 1458 … … 1253 1473 ! check south west corner 1254 1474 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)1475 tl_west =seg__copy(td_bdy(jp_west )%t_seg(1)) 1476 tl_south=seg__copy(td_bdy(jp_south)%t_seg(1)) 1257 1477 1258 1478 IF( tl_west%i_first <= tl_south%i_index .AND. & … … 1275 1495 ENDIF 1276 1496 1277 td_bdy(jp_west )%t_seg(1) = tl_west1278 td_bdy(jp_south)%t_seg(1) = tl_south1497 td_bdy(jp_west )%t_seg(1) = seg__copy(tl_west) 1498 td_bdy(jp_south)%t_seg(1) = seg__copy(tl_south) 1279 1499 ELSE 1280 1500 … … 1293 1513 ENDIF 1294 1514 1515 ! clean 1516 CALL seg__clean(tl_north) 1517 CALL seg__clean(tl_south) 1518 CALL seg__clean(tl_east ) 1519 CALL seg__clean(tl_west ) 1520 1295 1521 END SUBROUTINE boundary_check_corner 1296 !> @endcode1297 1522 !------------------------------------------------------------------- 1298 1523 !> @brief This subroutine check boundary. … … 1303 1528 ! 1304 1529 !> @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 1530 !> @date November, 2013 - Initial Version 1531 ! 1532 !> @param[inout] td_bdy boundary structure 1533 !> @param[in] td_var variable structure 1534 !------------------------------------------------------------------- 1311 1535 SUBROUTINE boundary_check(td_bdy, td_var) 1312 1536 IMPLICIT NONE … … 1327 1551 il_max(jp_east )=td_var%t_dim(2)%i_len 1328 1552 il_max(jp_west )=td_var%t_dim(2)%i_len 1329 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_ghost1553 1554 il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 1555 il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost 1556 il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ip_ghost 1557 il_maxindex(jp_west )=td_var%t_dim(1)%i_len-ip_ghost 1334 1558 1335 1559 DO jk=1,ip_ncard … … 1362 1586 ENDIF 1363 1587 ENDDO 1364 1588 1365 1589 CALL boundary_check_corner(td_bdy, td_var) 1366 1590 1367 1591 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 1592 !------------------------------------------------------------------- 1492 1593 !> @brief This subroutine swap array for east and north boundary. … … 1495 1596 !> 1496 1597 !> @author J.Paul 1497 !> - Nov, 2013- Initial Version1598 !> @date November, 2013 - Initial Version 1498 1599 ! 1499 !> @param[inout] td_var :variable strucutre1500 !> @param[in ] td_bdy :boundary strucutre1600 !> @param[inout] td_var variable strucutre 1601 !> @param[in ] td_bdy boundary strucutre 1501 1602 !------------------------------------------------------------------- 1502 !> @code1503 1603 SUBROUTINE boundary_swap( td_var, td_bdy ) 1504 1604 IMPLICIT NONE … … 1516 1616 1517 1617 IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 1518 CALL logger_error("BOUNDARY SWAP: no tableof value "//&1618 CALL logger_error("BOUNDARY SWAP: no array of value "//& 1519 1619 & "associted to variable "//TRIM(td_var%c_name) ) 1520 1620 ELSE … … 1555 1655 ENDIF 1556 1656 END SUBROUTINE boundary_swap 1557 !> @endcode 1558 !------------------------------------------------------------------- 1559 !> @brief This subroutine print information about one boundary 1560 ! 1561 !> @details 1657 !------------------------------------------------------------------- 1658 !> @brief This subroutine print information about one boundary. 1562 1659 ! 1563 1660 !> @author J.Paul 1564 !> - Nov, 2013- Initial Version 1565 ! 1566 !> @param[in] td_bdy : boundary structure 1567 !------------------------------------------------------------------- 1568 !> @code 1661 !> @date November, 2013 - Initial Version 1662 ! 1663 !> @param[in] td_bdy boundary structure 1664 !------------------------------------------------------------------- 1569 1665 SUBROUTINE boundary__print_unit( td_bdy ) 1570 1666 IMPLICIT NONE … … 1588 1684 1589 1685 END SUBROUTINE boundary__print_unit 1590 !> @endcode 1591 !------------------------------------------------------------------- 1592 !> @brief This subroutine print information about a table of boundary 1686 !------------------------------------------------------------------- 1687 !> @brief This subroutine print information about a array of boundary 1593 1688 ! 1594 1689 !> @details 1595 1690 ! 1596 1691 !> @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 ) 1692 !> @date November, 2013 - Initial Version 1693 ! 1694 !> @param[in] td_bdy boundary structure 1695 !------------------------------------------------------------------- 1696 SUBROUTINE boundary__print_arr( td_bdy ) 1603 1697 IMPLICIT NONE 1604 1698 ! Argument … … 1613 1707 ENDDO 1614 1708 1615 END SUBROUTINE boundary__print_tab 1616 !> @endcode 1709 END SUBROUTINE boundary__print_arr 1617 1710 !------------------------------------------------------------------- 1618 1711 !> @brief 1619 !> This subroutine copy segment structure in another segment 1620 !> structure 1621 !> @details 1712 !> This subroutine copy segment structure in another one. 1622 1713 !> 1714 !> @warning do not use on the output of a function who create or read a 1715 !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 1716 !> This will create memory leaks. 1623 1717 !> @warning to avoid infinite loop, do not use any function inside 1624 1718 !> this subroutine 1625 1719 !> 1626 1720 !> @author J.Paul 1627 !> - Nov, 2013- Initial Version 1721 !> @date November, 2013 - Initial Version 1722 !> @date November, 2014 1723 !> - use function instead of overload assignment operator 1724 !> (to avoid memory leak) 1628 1725 ! 1629 !> @param[ out] td_seg1 :segment structure1630 !> @ param[in] td_seg2 :segment structure1726 !> @param[in] td_seg segment structure 1727 !> @return copy of input segment structure 1631 1728 !------------------------------------------------------------------- 1632 !> @code 1633 SUBROUTINE seg__copy( td_seg1, td_seg2 ) 1729 FUNCTION seg__copy_unit( td_seg ) 1634 1730 IMPLICIT NONE 1635 1731 ! Argument 1636 TYPE(TSEG), INTENT(OUT) :: td_seg1 1637 TYPE(TSEG), INTENT(IN) :: td_seg2 1732 TYPE(TSEG), INTENT(IN) :: td_seg 1733 ! function 1734 TYPE(TSEG) :: seg__copy_unit 1638 1735 1639 1736 ! local variable … … 1642 1739 1643 1740 ! 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 1741 seg__copy_unit%i_index = td_seg%i_index 1742 seg__copy_unit%i_width = td_seg%i_width 1743 seg__copy_unit%i_first = td_seg%i_first 1744 seg__copy_unit%i_last = td_seg%i_last 1745 1746 END FUNCTION seg__copy_unit 1747 !------------------------------------------------------------------- 1748 !> @brief 1749 !> This subroutine copy segment structure in another one. 1750 !> 1751 !> @warning do not use on the output of a function who create or read a 1752 !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden). 1753 !> This will create memory leaks. 1754 !> @warning to avoid infinite loop, do not use any function inside 1755 !> this subroutine 1756 !> 1757 !> @author J.Paul 1758 !> @date November, 2013 - Initial Version 1759 !> @date November, 2014 1760 !> - use function instead of overload assignment operator 1761 !> (to avoid memory leak) 1762 ! 1763 !> @param[in] td_seg segment structure 1764 !> @return copy of input array of segment structure 1765 !------------------------------------------------------------------- 1766 FUNCTION seg__copy_arr( td_seg ) 1767 IMPLICIT NONE 1768 ! Argument 1769 TYPE(TSEG), DIMENSION(:), INTENT(IN) :: td_seg 1770 ! function 1771 TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: seg__copy_arr 1772 1773 ! local variable 1774 ! loop indices 1775 INTEGER(i4) :: ji 1776 !---------------------------------------------------------------- 1777 1778 DO ji=1,SIZE(td_seg(:)) 1779 seg__copy_arr(ji)=seg__copy(td_seg(ji)) 1780 ENDDO 1781 1782 END FUNCTION seg__copy_arr 1651 1783 !------------------------------------------------------------------- 1652 1784 !> @brief This function initialise segment structure. … … 1657 1789 ! 1658 1790 !> @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 indices1791 !> @date November, 2013 - Initial Version 1792 ! 1793 !> @param[in] id_index orthogonal index 1794 !> @param[in] id_width width of the segment 1795 !> @param[in] id_first first indices 1796 !> @param[in] id_last last indices 1665 1797 !> @return segment structure 1666 1798 !------------------------------------------------------------------- 1667 !> @code1668 1799 FUNCTION seg__init( id_index, id_width, id_first, id_last ) 1669 1800 IMPLICIT NONE … … 1689 1820 1690 1821 END FUNCTION seg__init 1691 !> @endcode1692 1822 !------------------------------------------------------------------- 1693 1823 !> @brief This subroutine clean segment structure. 1694 1824 ! 1695 !> @details1696 !1697 1825 !> @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) 1826 !> @date November, 2013 - Initial Version 1827 ! 1828 !> @param[inout] td_seg segment structure 1829 !------------------------------------------------------------------- 1830 SUBROUTINE seg__clean_unit(td_seg) 1704 1831 IMPLICIT NONE 1705 1832 ! Argument … … 1710 1837 !---------------------------------------------------------------- 1711 1838 1712 td_seg= tl_seg1839 td_seg=seg__copy(tl_seg) 1713 1840 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 1841 END SUBROUTINE seg__clean_unit 1842 !------------------------------------------------------------------- 1843 !> @brief This subroutine clean segment structure. 1844 ! 1845 !> @author J.Paul 1846 !> @date November, 2013 - Initial Version 1847 ! 1848 !> @param[inout] td_seg array of segment structure 1849 !------------------------------------------------------------------- 1850 SUBROUTINE seg__clean_arr(td_seg) 1851 IMPLICIT NONE 1852 ! Argument 1853 TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg 1854 ! local variable 1855 ! loop indices 1856 INTEGER(i4) :: ji 1857 !---------------------------------------------------------------- 1858 1859 DO ji=SIZE(td_seg(:)),1,-1 1860 CALL seg__clean(td_seg(ji)) 1861 ENDDO 1862 1863 END SUBROUTINE seg__clean_arr 1757 1864 END MODULE boundary
Note: See TracChangeset
for help on using the changeset viewer.
