- Timestamp:
- 2015-02-17T10:06:39+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/SIREN/src/domain.f90
r4213 r5086 8 8 !> @brief 9 9 !> This module manage domain computation. 10 ! 10 !> 11 11 !> @details 12 !> 13 !> 14 !> 15 !> 12 !> define type TDOM:<br/> 13 !> @code 14 !> TYPE(TDOM) :: tl_dom 15 !> @endcode 16 !> 17 !> to initialize domain structure:<br/> 18 !> @code 19 !> tl_dom=dom_init(td_mpp, [id_imin,] [id_imax,] [id_jmin,] [id_jmax],[cd_card]) 20 !> @endcode 21 !> - td_mpp is mpp structure of an opened file. 22 !> - id_imin is i-direction sub-domain lower left point indice 23 !> - id_imax is i-direction sub-domain upper right point indice 24 !> - id_jmin is j-direction sub-domain lower left point indice 25 !> - id_jmax is j-direction sub-domain upper right point indice 26 !> - cd_card is the cardinal name (for boundary case) 27 !> 28 !> to get global domain dimension:<br/> 29 !> - tl_dom\%t_dim0 30 !> 31 !> to get NEMO periodicity index of global domain:<br/> 32 !> - tl_dom\%i_perio0 33 !> 34 !> to get NEMO pivot point index F(0),T(1):<br/> 35 !> - tl_dom\%i_pivot 36 !> 37 !> to get East-West overlap of global domain:<br/> 38 !> - tl_dom\%i_ew0 39 !> 40 !> to get selected sub domain dimension:<br/> 41 !> - tl_dom\%t_dim 42 !> 43 !> to get NEMO periodicity index of sub domain:<br/> 44 !> - tl_dom\%i_perio 45 !> 46 !> to get East-West overlap of sub domain:<br/> 47 !> - tl_dom\%i_ew 48 !> 49 !> to get i-direction sub-domain lower left point indice:<br/> 50 !> - tl_dom\%i_imin 51 !> 52 !> to get i-direction sub-domain upper right point indice:<br/> 53 !> - tl_dom\%i_imax 54 !> 55 !> to get j-direction sub-domain lower left point indice:<br/> 56 !> - tl_dom\%i_jmin 57 !> 58 !> to get j-direction sub-domain upper right point indice:<br/> 59 !> - tl_dom\%i_jmax 60 !> 61 !> to get size of i-direction extra band:<br/> 62 !> - tl_dom\%i_iextra 63 !> 64 !> to get size of j-direction extra band:<br/> 65 !> - tl_dom\%i_jextra 66 !> 67 !> to get i-direction ghost cell number:<br/> 68 !> - tl_dom\%i_ighost 69 !> 70 !> to get j-direction ghost cell number:<br/> 71 !> - tl_dom\%i_jghost 72 !> 73 !> to get boundary index:<br/> 74 !> - tl_dom\%i_bdy 75 !> - 0 = no boundary 76 !> - 1 = north 77 !> - 2 = south 78 !> - 3 = east 79 !> - 4 = west 80 !> 81 !> to clean domain structure:<br/> 82 !> @code 83 !> CALL dom_clean(td_dom) 84 !> @endcode 85 !> - td_dom is domain structure 86 !> 87 !> to print information about domain structure:<br/> 88 !> @code 89 !> CALL dom_print(td_dom) 90 !> @endcode 91 !> 92 !> to get East-West overlap (if any):<br/> 93 !> @code 94 !> il_ew=dom_get_ew_overlap(td_lon) 95 !> @endcode 96 !> - td_lon : longitude variable structure 97 !> 98 !> to add extra bands to coarse grid domain (for interpolation):<br/> 99 !> @code 100 !> CALL dom_add_extra( td_dom, id_iext, id_jext ) 101 !> @endcode 102 !> - td_dom is domain structure 103 !> - id_iext is i-direction size of extra bands 104 !> - id_jext is j-direction size of extra bands 105 !> 106 !> to remove extra bands from fine grid (after interpolation):<br/> 107 !> @code 108 !> CALL dom_del_extra( td_var, td_dom, id_rho ) 109 !> @endcode 110 !> - td_var is variable structure to be changed 111 !> - td_dom is domain structure 112 !> - id_rho is a array of refinement factor following i- and j-direction 113 !> 114 !> to reset coarse grid domain witouht extra bands:<br/> 115 !> @code 116 !> CALL dom_clean_extra( td_dom ) 117 !> @endcode 16 118 !> 17 119 !> @author 18 120 !> J.Paul 19 121 ! REVISION HISTORY: 20 !> @date Nov, 2013 - Initial Version 21 !> @todo 22 !> - check use of id_pivot 122 !> @date November, 2013 - Initial Version 123 !> @date September, 2014 124 !> - add header 125 !> - use zero indice to defined cyclic or global domain 126 !> @date October, 2014 127 !> - use mpp file structure instead of file 23 128 !> 24 129 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 28 133 USE global ! global parameter 29 134 USE fct ! basic useful function 30 USE logger 135 USE logger ! log file manager 31 136 USE dim ! dimension manager 32 137 USE var ! variable manager 33 USE file !file manager138 USE mpp ! mpp file manager 34 139 IMPLICIT NONE 35 PRIVATE36 140 ! NOTE_avoid_public_variables_if_possible 37 141 … … 39 143 PUBLIC :: TDOM !< domain structure 40 144 145 PRIVATE :: im_minext !< default minumum number of extraband 146 41 147 ! function and subroutine 42 PUBLI c :: dom_clean !< cleandomain structure43 PUBLI C :: dom_init !< initialisedomain structure44 PUBLIC :: dom_ print !< print information about domain45 PUBLIC :: dom_ get_ew_overlap !< get east west overlap46 PUBLIC :: dom_add_extra !< add useful extra pointto coarse grid for interpolation47 PUBLIC :: dom_clean_extra !< reset domain without extra point48 PUBLIC :: dom_del_extra !< remove extra point from fine grid after interpolation148 PUBLIC :: dom_copy !< copy domain structure 149 PUBLIc :: dom_clean !< clean domain structure 150 PUBLIC :: dom_init !< initialise domain structure 151 PUBLIC :: dom_print !< print information about domain 152 PUBLIC :: dom_add_extra !< add useful extra bands to coarse grid for interpolation 153 PUBLIC :: dom_clean_extra !< reset domain without extra bands 154 PUBLIC :: dom_del_extra !< remove extra point from fine grid after interpolation 49 155 50 PRIVATE :: dom__define !< define extract domain indices 51 !< define extract domain indices for input domain with 52 PRIVATE :: dom__define_cyclic_north_fold !< - cyclic east-west boundary and north fold boundary condition. 53 PRIVATE :: dom__define_north_fold !< - north fold boundary condition. 54 PRIVATE :: dom__define_symmetric !< - symmetric boundary condition across the equator. 55 PRIVATE :: dom__define_cyclic !< - cyclic east-west boundary. 56 PRIVATE :: dom__define_closed !< - cyclic east-west boundary. 57 PRIVATE :: dom__check_EW_index !< check East-West indices 58 !< compute size of an extract domain 59 PRIVATE :: dom__size_no_pole !< - without north fold condition 60 PRIVATE :: dom__size_no_pole_overlap !< - without north fold condition, and which overlap east-west boundary 61 PRIVATE :: dom__size_no_pole_no_overlap !< - without north fold condition, and which do not overlap east-west boundary 62 PRIVATE :: dom__size_pole !< - with north fold condition 63 PRIVATE :: dom__size_pole_overlap !< - with north fold condition, and which overlap east-west boundary 64 PRIVATE :: dom__size_pole_no_overlap !< - with north fold condition, and which do not overlap east-west boundary 65 66 !> @struct 67 TYPE TDOM 68 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim0 !< global domain dimension 69 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< sub domain dimension 70 INTEGER(i4) :: i_perio0 !< NEMO periodicity index 71 INTEGER(i4) :: i_ew0 !< East-West overlap 72 INTEGER(i4) :: i_perio !< NEMO periodicity index 73 INTEGER(i4) :: i_pivot !< NEMO pivot point index F(0),T(1) 74 INTEGER(i4) :: i_imin = 1 !< i-direction sub-domain lower left point indice 75 INTEGER(i4) :: i_imax = 1 !< i-direction sub-domain upper right point indice 76 INTEGER(i4) :: i_jmin = 1 !< j-direction sub-domain lower left point indice 77 INTEGER(i4) :: i_jmax = 1 !< j-direction sub-domain upper right point indice 78 INTEGER(i4) :: i_kmin = 1 !< k-direction sub-domain lower level indice 79 INTEGER(i4) :: i_kmax = 1 !< k-direction sub-domain upper level indice 80 INTEGER(i4) :: i_lmin = 1 !< l-direction sub-domain lower time indice 81 INTEGER(i4) :: i_lmax = 1 !< l-direction sub-domain upper time indice 82 83 INTEGER(i4) :: i_ighost = 0 !< i-direction ghost cell factor 84 INTEGER(i4) :: i_jghost = 0 !< j-direction ghost cell factor 85 86 INTEGER(i4), DIMENSION(2) :: i_iextra = 0 !< i-direction extra point 87 INTEGER(i4), DIMENSION(2) :: i_jextra = 0 !< j-direction extra point 156 PRIVATE :: dom__init_mpp ! initialise domain structure, given mpp file structure 157 PRIVATE :: dom__define ! define sub domain indices 158 ! define sub domain indices for input domain with 159 PRIVATE :: dom__define_cyclic_north_fold ! - cyclic east-west boundary and north fold boundary condition. 160 PRIVATE :: dom__define_north_fold ! - north fold boundary condition. 161 PRIVATE :: dom__define_symmetric ! - symmetric boundary condition across the equator. 162 PRIVATE :: dom__define_cyclic ! - cyclic east-west boundary. 163 PRIVATE :: dom__define_closed ! - cyclic east-west boundary. 164 ! compute size of sub domain 165 PRIVATE :: dom__size_no_pole ! - without north fold condition 166 PRIVATE :: dom__size_no_pole_overlap ! - without north fold condition, and which overlap east-west boundary 167 PRIVATE :: dom__size_no_pole_no_overlap ! - without north fold condition, and which do not overlap east-west boundary 168 PRIVATE :: dom__size_pole ! - with north fold condition 169 PRIVATE :: dom__size_pole_overlap ! - with north fold condition, and which overlap east-west boundary 170 PRIVATE :: dom__size_pole_no_overlap ! - with north fold condition, and which do not overlap east-west boundary 171 ! compute size of 172 PRIVATE :: dom__size_global ! - global domain 173 PRIVATE :: dom__size_semi_global ! - semi global domain 174 PRIVATE :: dom__copy_unit ! copy attribute structure 175 176 TYPE TDOM !< domain structure 177 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim0 !< global domain dimension 178 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< sub domain dimension 179 INTEGER(i4) :: i_perio0 !< NEMO periodicity index of global domain 180 INTEGER(i4) :: i_ew0 !< East-West overlap of global domain 181 INTEGER(i4) :: i_perio !< NEMO periodicity index of sub domain 182 INTEGER(i4) :: i_pivot !< NEMO pivot point index F(0),T(1) 183 INTEGER(i4) :: i_imin = 0 !< i-direction sub-domain lower left point indice 184 INTEGER(i4) :: i_imax = 0 !< i-direction sub-domain upper right point indice 185 INTEGER(i4) :: i_jmin = 0 !< j-direction sub-domain lower left point indice 186 INTEGER(i4) :: i_jmax = 0 !< j-direction sub-domain upper right point indice 187 188 INTEGER(i4) :: i_bdy = 0 !< boundary index : 0 = no boundary 189 !< 1 = north 190 !< 2 = south 191 !< 3 = east 192 !< 4 = west 193 INTEGER(i4), DIMENSION(2,2) :: i_ghost0 = 0 !< array of ghost cell factor of global domain 194 INTEGER(i4), DIMENSION(2,2) :: i_ghost = 0 !< array of ghost cell factor of sub domain 195 196 INTEGER(i4), DIMENSION(2) :: i_iextra = 0 !< i-direction extra point 197 INTEGER(i4), DIMENSION(2) :: i_jextra = 0 !< j-direction extra point 88 198 89 199 END TYPE TDOM … … 92 202 93 203 INTERFACE dom_init 94 MODULE PROCEDURE dom_ init_file95 ! MODULE PROCEDURE dom_init_mpp204 MODULE PROCEDURE dom__init_file 205 MODULE PROCEDURE dom__init_mpp 96 206 END INTERFACE dom_init 97 207 208 INTERFACE dom_copy 209 MODULE PROCEDURE dom__copy_unit ! copy attribute structure 210 END INTERFACE 211 98 212 CONTAINS 99 213 !------------------------------------------------------------------- 214 !> @brief 215 !> This subroutine copy an domain structure in another one 216 !> @details 217 !> dummy function to get the same use for all structure 218 !> 219 !> @warning do not use on the output of a function who create or read an 220 !> structure (ex: tl_dom=dom_copy(dom_init()) is forbidden). 221 !> This will create memory leaks. 222 !> @warning to avoid infinite loop, do not use any function inside 223 !> this subroutine 224 !> 225 !> @author J.Paul 226 !> @date November, 2014 - Initial Version 227 !> 228 !> @param[in] td_dom domain structure 229 !> @return copy of input domain structure 230 !------------------------------------------------------------------- 231 FUNCTION dom__copy_unit( td_dom ) 232 IMPLICIT NONE 233 ! Argument 234 TYPE(TDOM), INTENT(IN) :: td_dom 235 ! function 236 TYPE(TDOM) :: dom__copy_unit 237 238 ! local variable 239 !---------------------------------------------------------------- 240 241 dom__copy_unit=td_dom 242 243 END FUNCTION dom__copy_unit 244 !------------------------------------------------------------------- 100 245 !> @brief This subroutine print some information about domain strucutre. 101 246 ! … … 103 248 !> - Nov, 2013- Initial Version 104 249 ! 105 !> @param[inout] td_dom : dom structure 106 !------------------------------------------------------------------- 107 !> @code 250 !> @param[inout] td_dom dom structure 251 !------------------------------------------------------------------- 108 252 SUBROUTINE dom_print(td_dom) 109 253 IMPLICIT NONE … … 123 267 END SELECT 124 268 125 WRITE(*,'((a,4(i0,1x)),(/a,i2,a,a),(/a,4(i0,1x)),(/a,i2/),10(/a,i0))') & 269 WRITE(*,'((a,4(i0,1x)),(/a,i2,a,a),2(/a,2(i0,1x)),(/a,4(i0,1x)),(/a,i2/),& 270 & 4(/a,i0),4(/a,2(i0,1x)))') & 126 271 & " global domain size ",td_dom%t_dim0(:)%i_len, & 127 272 & " domain periodicity ",td_dom%i_perio0,", pivot: ",TRIM(cl_pivot), & 273 & " i-direction ghost cell factor of global domain ",td_dom%i_ghost0(jp_I,:), & 274 & " j-direction ghost cell factor of global domain ",td_dom%i_ghost0(jp_J,:), & 128 275 & " sub-domain size : ",td_dom%t_dim(:)%i_len, & 129 276 & " sub domain periodicity ",td_dom%i_perio, & … … 132 279 & " j-direction sub-domain lower left point indice ",td_dom%i_jmin, & 133 280 & " j-direction sub-domain upper right point indice ",td_dom%i_jmax, & 134 ! & " k-direction sub-domain lower level indice ",td_dom%i_kmin, & 135 ! & " k-direction sub-domain upper level indice ",td_dom%i_kmax, & 136 ! & " l-direction sub-domain lower time indice ",td_dom%i_lmin, & 137 ! & " l-direction sub-domain upper time indice ",td_dom%i_lmax, & 138 & " i-direction ghost cell factor ",td_dom%i_ighost, & 139 & " j-direction ghost cell factor ",td_dom%i_jghost 281 & " i-direction ghost cell factor ",td_dom%i_ghost(jp_I,:), & 282 & " j-direction ghost cell factor ",td_dom%i_ghost(jp_J,:), & 283 & " i-direction extra point for interpolation ",td_dom%i_iextra(:), & 284 & " j-direction extra point for interpolation ",td_dom%i_jextra(:) 140 285 141 286 END SUBROUTINE dom_print 142 !> @endcode143 287 !------------------------------------------------------------------- 144 288 !> @brief 145 289 !> This function intialise domain structure, given open file structure, 146 !> and grid periodicity. 290 !> and sub domain indices. 291 !> @details 292 !> sub domain indices are computed, taking into account coarse grid 293 !> periodicity, pivot point, and East-West overlap. 147 294 ! 148 295 !> @author J.Paul 149 296 !> - June, 2013- Initial Version 150 ! 151 !> @param[in] td_file : file structure 152 !> @param[in] id_perio : grid periodicity 153 !> @param[in] id_imin : i-direction sub-domain lower left point indice 154 !> @param[in] id_imax : i-direction sub-domain upper right point indice 155 !> @param[in] id_jmin : j-direction sub-domain lower left point indice 156 !> @param[in] id_jmax : j-direction sub-domain upper right point indice 157 !> @param[in] id_kmin : k-direction sub-domain lower level indice 158 !> @param[in] id_kmax : k-direction sub-domain upper level indice 159 !> @param[in] id_lmin : l-direction sub-domain lower time indice 160 !> @param[in] id_lmax : l-direction sub-domain upper time indice 297 !> @date September, 2014 298 !> - add boundary index 299 !> - add ghost cell factor 300 !> @date October, 2014 301 !> - work on mpp file structure instead of file structure 302 !> 303 !> @param[in] td_mpp mpp structure 304 !> @param[in] id_perio grid periodicity 305 !> @param[in] id_imin i-direction sub-domain lower left point indice 306 !> @param[in] id_imax i-direction sub-domain upper right point indice 307 !> @param[in] id_jmin j-direction sub-domain lower left point indice 308 !> @param[in] id_jmax j-direction sub-domain upper right point indice 309 !> @param[in] cd_card name of cardinal (for boundary) 161 310 !> @return domain structure 162 !> 163 !> @todo 164 !> - initialiser domain 165 !> - add info new perio.. dans sortie 166 !------------------------------------------------------------------- 167 !> @code 168 TYPE(TDOM) FUNCTION dom_init_file( td_file, & 169 & id_imin, id_imax, id_jmin, id_jmax ) 170 ! & id_kmin, id_kmax, id_lmin, id_lmax ) 171 IMPLICIT NONE 172 ! Argument 173 TYPE(TFILE), INTENT(IN) :: td_file 174 INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin 175 INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax 176 INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin 177 INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax 178 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmin 179 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmax 180 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmin 181 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmax 182 311 !------------------------------------------------------------------- 312 TYPE(TDOM) FUNCTION dom__init_mpp( td_mpp, & 313 & id_imin, id_imax, id_jmin, id_jmax, & 314 & cd_card ) 315 IMPLICIT NONE 316 ! Argument 317 TYPE(TMPP) , INTENT(IN) :: td_mpp 318 319 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imin 320 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imax 321 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmin 322 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmax 323 324 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card 183 325 !local variable 184 326 !---------------------------------------------------------------- 185 327 186 328 ! clean domain structure 187 CALL dom_clean(dom_init_file) 329 CALL dom_clean(dom__init_mpp) 330 331 IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 332 333 CALL logger_error( & 334 & " DOM INIT: no processor file associated to mpp "//& 335 & TRIM(td_mpp%c_name)) 336 337 ELSE 338 ! global domain define by file 339 340 ! look for boundary index 341 IF( PRESENT(cd_card) )THEN 342 SELECT CASE(TRIM(cd_card)) 343 CASE('north') 344 dom__init_mpp%i_bdy=jp_north 345 CASE('south') 346 dom__init_mpp%i_bdy=jp_south 347 CASE('east') 348 dom__init_mpp%i_bdy=jp_east 349 CASE('west') 350 dom__init_mpp%i_bdy=jp_west 351 CASE DEFAULT 352 ! no boundary 353 dom__init_mpp%i_bdy=0 354 END SELECT 355 ELSE 356 ! no boundary 357 dom__init_mpp%i_bdy=0 358 ENDIF 359 360 ! use global dimension define by mpp file 361 dom__init_mpp%t_dim0(:) = dim_copy(td_mpp%t_dim(:)) 362 363 IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN 364 CALL logger_error("DOM INIT: invalid grid periodicity. "//& 365 & "you should use grid_get_perio to compute it") 366 ELSE 367 dom__init_mpp%i_perio0=td_mpp%i_perio 368 ENDIF 369 370 ! global domain pivot point 371 SELECT CASE(dom__init_mpp%i_perio0) 372 CASE(3,4) 373 dom__init_mpp%i_pivot = 0 374 CASE(5,6) 375 dom__init_mpp%i_pivot = 1 376 CASE DEFAULT 377 dom__init_mpp%i_pivot = 0 378 END SELECT 379 380 ! add ghost cell factor of global domain 381 dom__init_mpp%i_ghost0(:,:)=0 382 SELECT CASE(dom__init_mpp%i_perio0) 383 CASE(0) 384 dom__init_mpp%i_ghost0(:,:)=1 385 CASE(1) 386 dom__init_mpp%i_ghost0(jp_J,:)=1 387 CASE(2) 388 dom__init_mpp%i_ghost0(jp_I,:)=1 389 dom__init_mpp%i_ghost0(jp_J,2)=1 390 CASE(3,5) 391 dom__init_mpp%i_ghost0(jp_I,:)=1 392 dom__init_mpp%i_ghost0(jp_J,1)=1 393 CASE(4,6) 394 dom__init_mpp%i_ghost0(jp_J,1)=1 395 END SELECT 396 397 ! look for EW overlap 398 dom__init_mpp%i_ew0=td_mpp%i_ew 399 400 ! initialise domain as global 401 dom__init_mpp%i_imin = 1 402 dom__init_mpp%i_imax = dom__init_mpp%t_dim0(1)%i_len 403 404 dom__init_mpp%i_jmin = 1 405 dom__init_mpp%i_jmax = dom__init_mpp%t_dim0(2)%i_len 406 407 ! sub domain dimension 408 dom__init_mpp%t_dim(:) = dim_copy(td_mpp%t_dim(:)) 409 410 ! define sub domain indices 411 CALL dom__define( dom__init_mpp, & 412 & id_imin, id_imax, id_jmin, id_jmax ) 413 414 ENDIF 415 416 END FUNCTION dom__init_mpp 417 !------------------------------------------------------------------- 418 !> @brief 419 !> This function intialise domain structure, given open file structure, 420 !> and sub domain indices. 421 !> @details 422 !> sub domain indices are computed, taking into account coarse grid 423 !> periodicity, pivot point, and East-West overlap. 424 ! 425 !> @author J.Paul 426 !> - June, 2013- Initial Version 427 !> @date September, 2014 428 !> - add boundary index 429 !> - add ghost cell factor 430 !> 431 !> @param[in] td_file file structure 432 !> @param[in] id_perio grid periodicity 433 !> @param[in] id_imin i-direction sub-domain lower left point indice 434 !> @param[in] id_imax i-direction sub-domain upper right point indice 435 !> @param[in] id_jmin j-direction sub-domain lower left point indice 436 !> @param[in] id_jmax j-direction sub-domain upper right point indice 437 !> @param[in] cd_card name of cardinal (for boundary) 438 !> @return domain structure 439 !------------------------------------------------------------------- 440 TYPE(TDOM) FUNCTION dom__init_file( td_file, & 441 & id_imin, id_imax, id_jmin, id_jmax, & 442 & cd_card ) 443 IMPLICIT NONE 444 ! Argument 445 TYPE(TFILE) , INTENT(IN) :: td_file 446 447 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imin 448 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imax 449 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmin 450 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmax 451 452 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card 453 !local variable 454 !---------------------------------------------------------------- 455 456 ! clean domain structure 457 CALL dom_clean(dom__init_file) 188 458 189 459 IF( td_file%i_id == 0 )THEN … … 195 465 ! global domain define by file 196 466 467 ! look for boundary index 468 IF( PRESENT(cd_card) )THEN 469 SELECT CASE(TRIM(cd_card)) 470 CASE('north') 471 dom__init_file%i_bdy=jp_north 472 CASE('south') 473 dom__init_file%i_bdy=jp_south 474 CASE('east') 475 dom__init_file%i_bdy=jp_east 476 CASE('west') 477 dom__init_file%i_bdy=jp_west 478 CASE DEFAULT 479 ! no boundary 480 dom__init_file%i_bdy=0 481 END SELECT 482 ELSE 483 ! no boundary 484 dom__init_file%i_bdy=0 485 ENDIF 486 197 487 ! use global dimension define by file 198 dom_ init_file%t_dim0(:) = td_file%t_dim(:)488 dom__init_file%t_dim0(:) = dim_copy(td_file%t_dim(:)) 199 489 200 490 IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN 201 491 CALL logger_error("DOM INIT: invalid grid periodicity. "//& 202 & "you should use dom_get_perio to compute it")492 & "you should use grid_get_perio to compute it") 203 493 ELSE 204 dom_ init_file%i_perio0=td_file%i_perio494 dom__init_file%i_perio0=td_file%i_perio 205 495 ENDIF 206 496 207 497 ! global domain pivot point 208 SELECT CASE(dom_ init_file%i_perio0)498 SELECT CASE(dom__init_file%i_perio0) 209 499 CASE(3,4) 210 dom_ init_file%i_pivot = 0500 dom__init_file%i_pivot = 0 211 501 CASE(5,6) 212 dom_ init_file%i_pivot = 1502 dom__init_file%i_pivot = 1 213 503 CASE DEFAULT 214 dom_ init_file%i_pivot = 0504 dom__init_file%i_pivot = 0 215 505 END SELECT 216 506 507 ! add ghost cell factor of global domain 508 dom__init_file%i_ghost0(:,:)=0 509 SELECT CASE(dom__init_file%i_perio0) 510 CASE(0) 511 dom__init_file%i_ghost0(:,:)=1 512 CASE(1) 513 dom__init_file%i_ghost0(jp_J,:)=1 514 CASE(2) 515 dom__init_file%i_ghost0(jp_I,:)=1 516 dom__init_file%i_ghost0(jp_J,2)=1 517 CASE(3,5) 518 dom__init_file%i_ghost0(jp_I,:)=1 519 dom__init_file%i_ghost0(jp_J,1)=1 520 CASE(4,6) 521 dom__init_file%i_ghost0(jp_J,1)=1 522 END SELECT 523 217 524 ! look for EW overlap 218 dom_ init_file%i_ew0=td_file%i_ew525 dom__init_file%i_ew0=td_file%i_ew 219 526 220 527 ! initialise domain as global 221 dom_init_file%i_imin = 1 222 dom_init_file%i_imax = dom_init_file%t_dim0(1)%i_len 223 224 dom_init_file%i_jmin = 1 225 dom_init_file%i_jmax = dom_init_file%t_dim0(2)%i_len 226 227 ! dom_init_file%i_kmin = 1 228 ! dom_init_file%i_kmax = dom_init_file%t_dim(3)%i_len 229 ! 230 ! dom_init_file%i_lmin = 1 231 ! dom_init_file%i_lmax = dom_init_file%t_dim(4)%i_len 232 233 ! extract domain dimension 234 dom_init_file%t_dim(:) = td_file%t_dim(:) 235 236 ! define extract domain indices 237 CALL dom__define( dom_init_file, & 238 & id_imin, id_imax, id_jmin, id_jmax ) 239 ! & id_kmin, id_kmax, id_lmin, id_lmax ) 240 241 ENDIF 242 243 END FUNCTION dom_init_file 244 !> @endcode 245 ! !------------------------------------------------------------------- 246 ! !> @brief 247 ! !> This function intialise domain structure, given mpp structure, 248 ! !> and variable name. domain indices could be specify. 249 ! ! 250 ! !> @details 251 ! !> 252 ! ! 253 ! !> @author J.Paul 254 ! !> - Nov, 2013- Initial Version 255 ! ! 256 ! !> @param[in] td_mpp : mpp structure 257 ! !> @param[in] cd_varname : variable name 258 ! !> @return domain structure 259 ! !> 260 ! !> @todo 261 ! !> - initialiser domain 262 ! !------------------------------------------------------------------- 263 ! !> @code 264 ! TYPE(TDOM) FUNCTION dom_init_mpp( td_mpp, cd_varname ) 265 ! IMPLICIT NONE 266 ! ! Argument 267 ! TYPE(TMPP), INTENT(IN) :: td_mpp 268 ! CHARACTER(LEN=*), INTENT(IN) :: cd_varname 269 ! !---------------------------------------------------------------- 270 271 ! ! clean domain structure 272 ! CALL dom_clean(dom_init_mpp) 273 274 ! IF( ASSOCIATED(td_mpp%t_proc) )THEN 275 276 ! CALL logger_error( " INIT: mpp strcuture "//TRIM(td_mpp%c_name)//& 277 ! & " not define" ) 278 279 ! ELSE 280 ! ! global domain define by mpp 281 282 ! ! use global dimension define by mpp 283 ! dom_init_mpp%t_dim(:) = td_mpp%t_dim(:) 284 285 ! ! get global domain periodicity ?? 286 ! dom_init_mpp%i_perio = dom_get_perio(td_mpp, cd_varname) 287 288 ! ! global domain pivot point 289 ! SELECT CASE(dom_init%i_perio) 290 ! CASE(3,4) 291 ! dom_init%i_pivot = 0 292 ! CASE(5,6) 293 ! dom_init%i_pivot = 1 294 ! CASE DEFAULT 295 ! dom_init%i_pivot = 0 296 ! END SELECT 297 298 ! ! initialise domain as global 299 ! dom_init_mpp%i_imin = 1 300 ! dom_init_mpp%i_imax = dom_init_mpp%t_dim(1)%i_len 301 302 ! dom_init_mpp%i_jmin = 1 303 ! dom_init_mpp%i_jmax = dom_init_mpp%t_dim(2)%i_len 304 305 ! dom_init_mpp%i_kmin = 1 306 ! dom_init_mpp%i_kmax = dom_init_mpp%t_dim(3)%i_len 307 308 ! dom_init_mpp%i_lmin = 1 309 ! dom_init_mpp%i_lmax = dom_init_mpp%t_dim(4)%i_len 310 311 ! ENDIF 312 313 ! END FUNCTION dom_init_mpp 314 ! !> @endcode 528 dom__init_file%i_imin = 1 529 dom__init_file%i_imax = dom__init_file%t_dim0(1)%i_len 530 531 dom__init_file%i_jmin = 1 532 dom__init_file%i_jmax = dom__init_file%t_dim0(2)%i_len 533 534 ! sub domain dimension 535 dom__init_file%t_dim(:) = dim_copy(td_file%t_dim(:)) 536 537 ! define sub domain indices 538 CALL dom__define( dom__init_file, & 539 & id_imin, id_imax, id_jmin, id_jmax ) 540 541 ENDIF 542 543 END FUNCTION dom__init_file 315 544 !------------------------------------------------------------------- 316 545 !> @brief 317 !> This subroutine define extract domain indices, and compute the size 318 !> of the domain. 319 !> 320 !> @author J.Paul 321 !> - Nov, 2013- Subroutine written 322 ! 323 !> @param[inout] td_dom : domain structure 324 !> @param[in] id_imin : i-direction sub-domain lower left point indice 325 !> @param[in] id_imax : i-direction sub-domain upper right point indice 326 !> @param[in] id_jmin : j-direction sub-domain lower left point indice 327 !> @param[in] id_jmax : j-direction sub-domain upper right point indice 328 !> @param[in] id_kmin : k-direction sub-domain lower level indice 329 !> @param[in] id_kmax : k-direction sub-domain upper level indice 330 !> @param[in] id_lmin : l-direction sub-domain lower time indice 331 !> @param[in] id_lmax : l-direction sub-domain upper time indice 332 !------------------------------------------------------------------- 333 !> @code 546 !> This subroutine define sub domain indices, and compute the size 547 !> of the sub domain. 548 !> 549 !> @author J.Paul 550 !> - November, 2013- Subroutine written 551 ! 552 !> @param[inout] td_dom domain structure 553 !> @param[in] id_imin i-direction sub-domain lower left point indice 554 !> @param[in] id_imax i-direction sub-domain upper right point indice 555 !> @param[in] id_jmin j-direction sub-domain lower left point indice 556 !> @param[in] id_jmax j-direction sub-domain upper right point indice 557 !------------------------------------------------------------------- 334 558 SUBROUTINE dom__define(td_dom, & 335 559 & id_imin, id_imax, id_jmin, id_jmax ) 336 ! & id_kmin, id_kmax, id_lmin, id_lmax )337 560 IMPLICIT NONE 338 561 ! Argument … … 342 565 INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin 343 566 INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax 344 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmin345 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_kmax346 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmin347 ! INTEGER(i4), INTENT(IN), OPTIONAL :: id_lmax348 567 !---------------------------------------------------------------- 349 568 … … 354 573 IF( PRESENT(id_jmax) ) td_dom%i_jmax = id_jmax 355 574 356 ! IF( PRESENT(id_kmin) ) td_dom%i_kmin = id_kmin357 ! IF( PRESENT(id_kmax) ) td_dom%i_kmax = id_kmax358 !359 ! IF( PRESENT(id_lmin) ) td_dom%i_lmin = id_lmin360 ! IF( PRESENT(id_lmax) ) td_dom%i_lmax = id_lmax361 362 575 ! check indices 363 IF(( td_dom%i_imin < 0 .OR. td_dom%i_imin > td_dom%t_dim0(1)%i_len ).OR. & 364 & ( td_dom%i_imax < 0 .OR. td_dom%i_imax > td_dom%t_dim0(1)%i_len ).OR. & 365 & ( td_dom%i_jmin < 0 .OR. td_dom%i_jmin > td_dom%t_dim0(2)%i_len ).OR. & 366 & ( td_dom%i_jmax < 0 .OR. td_dom%i_jmax > td_dom%t_dim0(2)%i_len ))THEN 367 ! & ( td_dom%i_kmin < 0 .OR. td_dom%i_kmin > td_dom%t_dim0(3)%i_len ).OR. & 368 ! & ( td_dom%i_kmax < 0 .OR. td_dom%i_kmax > td_dom%t_dim0(3)%i_len ).OR. & 369 ! & ( td_dom%i_lmin < 0 .OR. td_dom%i_lmin > td_dom%t_dim0(4)%i_len ).OR. & 370 ! & ( td_dom%i_lmax < 0 .OR. td_dom%i_lmax > td_dom%t_dim0(4)%i_len ))THEN 371 CALL logger_error( "DOM INIT DEFINE: invalid grid definition."// & 576 IF(( td_dom%i_imin < -1 .OR. td_dom%i_imin > td_dom%t_dim0(1)%i_len ).OR. & 577 & ( td_dom%i_imax < -1 .OR. td_dom%i_imax > td_dom%t_dim0(1)%i_len ).OR. & 578 & ( td_dom%i_jmin < -1 .OR. td_dom%i_jmin > td_dom%t_dim0(2)%i_len ).OR. & 579 & ( td_dom%i_jmax < -1 .OR. td_dom%i_jmax > td_dom%t_dim0(2)%i_len ))THEN 580 CALL logger_debug("0 <= imin ("//TRIM(fct_str(id_imin))//") < "//& 581 & TRIM(fct_str(td_dom%t_dim0(1)%i_len))) 582 CALL logger_debug("0 <= imax ("//TRIM(fct_str(id_imax))//") < "//& 583 & TRIM(fct_str(td_dom%t_dim0(1)%i_len))) 584 CALL logger_debug("0 <= jmin ("//TRIM(fct_str(id_jmin))//") < "//& 585 & TRIM(fct_str(td_dom%t_dim0(2)%i_len))) 586 CALL logger_debug("0 <= jmax ("//TRIM(fct_str(id_jmax))//") < "//& 587 & TRIM(fct_str(td_dom%t_dim0(2)%i_len))) 588 CALL logger_fatal( "DOM INIT DEFINE: invalid grid definition."// & 372 589 & " check min and max indices") 373 CALL logger_debug("0 < imin ("//TRIM(fct_str(id_imin))//") < "//&374 & TRIM(fct_str(td_dom%t_dim0(1)%i_len)))375 CALL logger_debug("0 < imax ("//TRIM(fct_str(id_imax))//") < "//&376 & TRIM(fct_str(td_dom%t_dim0(1)%i_len)))377 CALL logger_debug("0 < jmin ("//TRIM(fct_str(id_jmin))//") < "//&378 & TRIM(fct_str(td_dom%t_dim0(2)%i_len)))379 CALL logger_debug("0 < jmax ("//TRIM(fct_str(id_jmax))//") < "//&380 & TRIM(fct_str(td_dom%t_dim0(2)%i_len)))381 ! CALL logger_debug("0 < kmin ("//TRIM(fct_str(id_kmin))//") < "//&382 ! & TRIM(fct_str(td_dom%t_dim0(3)%i_len)))383 ! CALL logger_debug("0 < kmax ("//TRIM(fct_str(id_kmax))//") < "//&384 ! & TRIM(fct_str(td_dom%t_dim0(3)%i_len)))385 ! CALL logger_debug("0 < lmin ("//TRIM(fct_str(id_lmin))//") < "//&386 ! & TRIM(fct_str(td_dom%t_dim0(4)%i_len)))387 ! CALL logger_debug("0 < lmax ("//TRIM(fct_str(id_lmax))//") < "//&388 ! & TRIM(fct_str(td_dom%t_dim0(4)%i_len)))389 590 ELSE 390 591 391 ! td_dom%t_dim(3)%i_len=td_dom%i_kmax-td_dom%i_kmin+1 392 ! td_dom%t_dim(4)%i_len=td_dom%i_lmax-td_dom%i_lmin+1 592 ! force to select north fold 593 IF( td_dom%i_perio0 > 2 .AND. & 594 & ( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 .OR. & 595 & td_dom%i_jmax < td_dom%i_jmin .OR. & 596 & td_dom%i_jmin == 0 ) )THEN 597 td_dom%i_jmax=0 598 ENDIF 599 600 ! force to use cyclic boundary 601 IF( ( td_dom%i_perio0 == 1 .OR. & 602 & td_dom%i_perio0 == 4 .OR. & 603 & td_dom%i_perio0 == 6 ) .AND. & 604 & ( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. & 605 & ABS(td_dom%i_imax-td_dom%i_imin)+1 == td_dom%t_dim0(1)%i_len ) & 606 & )THEN 607 td_dom%i_imin = 0 608 td_dom%i_imax = 0 609 ENDIF 393 610 394 611 SELECT CASE(td_dom%i_perio0) 395 612 CASE(0) ! closed boundary 396 CALL logger_trace("D EFINE: closed boundary")613 CALL logger_trace("DOM INIT DEFINE: closed boundary") 397 614 CALL dom__define_closed( td_dom ) 398 615 CASE(1) ! cyclic east-west boundary 399 CALL logger_trace("D EFINE: cyclic east-west boundary")616 CALL logger_trace("DOM INIT DEFINE: cyclic east-west boundary") 400 617 CALL dom__define_cyclic( td_dom ) 401 618 CASE(2) ! symmetric boundary condition across the equator 402 CALL logger_trace("D EFINE: symmetric boundary condition "//&619 CALL logger_trace("DOM INIT DEFINE: symmetric boundary condition "//& 403 620 & " across the equator") 404 621 CALL dom__define_symmetric( td_dom ) 405 622 CASE(3) ! North fold boundary (with a F-point pivot) 406 CALL logger_trace("D EFINE: North fold boundary "//&623 CALL logger_trace("DOM INIT DEFINE: North fold boundary "//& 407 624 & "(with a F-point pivot)") 408 625 CALL dom__define_north_fold( td_dom ) 409 626 CASE(5) ! North fold boundary (with a T-point pivot) 410 CALL logger_trace("D EFINE: North fold boundary "//&627 CALL logger_trace("DOM INIT DEFINE: North fold boundary "//& 411 628 & "(with a T-point pivot)") 412 629 CALL dom__define_north_fold( td_dom ) 413 630 CASE(4) ! North fold boundary (with a F-point pivot) 414 631 ! and cyclic east-west boundary 415 CALL logger_trace("D EFINE: North fold boundary "//&632 CALL logger_trace("DOM INIT DEFINE: North fold boundary "//& 416 633 & "(with a F-point pivot) and cyclic "//& 417 634 & "east-west boundary") … … 419 636 CASE(6) ! North fold boundary (with a T-point pivot) 420 637 ! and cyclic east-west boundary 421 CALL logger_trace("D EFINE: North fold boundary "//&638 CALL logger_trace("DOM INIT DEFINE: North fold boundary "//& 422 639 & "(with a T-point pivot) and cyclic "//& 423 640 & "east-west boundary") 424 641 CALL dom__define_cyclic_north_fold( td_dom ) 425 642 CASE DEFAULT 426 CALL logger_error("D EFINE: invalid grid periodicity index")643 CALL logger_error("DOM INIT DEFINE: invalid grid periodicity index") 427 644 END SELECT 428 645 … … 430 647 431 648 END SUBROUTINE dom__define 432 !> @endcode433 649 !------------------------------------------------------------------- 434 650 !> @brief 435 !> This subroutine define domain indices from global domain with651 !> This subroutine define sub domain indices from global domain with 436 652 !> cyclic east-west boundary and north fold boundary condition. 437 653 !> 438 654 !> @author J.Paul 439 !> - Nov, 2013- Subroutine written 440 ! 441 !> @param[inout] td_dom : domain strcuture 442 !------------------------------------------------------------------- 443 !> @code 655 !> - November, 2013- Subroutine written 656 !> @date September, 2014 657 !> - use zero indice to defined cyclic or global domain 658 ! 659 !> @param[inout] td_dom domain strcuture 660 !------------------------------------------------------------------- 444 661 SUBROUTINE dom__define_cyclic_north_fold( td_dom ) 445 662 IMPLICIT NONE … … 448 665 !---------------------------------------------------------------- 449 666 450 CALL dom__check_EW_index( td_dom )451 452 IF( td_dom%i_imin == td_dom%i_imax.AND. &453 & td_dom%i_jmin == td_dom%i_jmax)THEN454 455 CALL logger_trace("D EFINE CYCLIC NORTH FOLD: "//&667 !CALL dom__check_EW_index( td_dom ) 668 669 IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. & 670 & td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN 671 672 CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//& 456 673 & "domain to extract is global" ) 457 674 ! coarse domain is global domain … … 459 676 CALL dom__size_global( td_dom ) 460 677 461 ELSEIF( td_dom%i_imin == td_dom%i_imax.AND. &462 & td_dom%i_jm in >= td_dom%i_jmax)THEN463 464 CALL logger_trace("D EFINE CYCLIC NORTH FOLD: "//&678 ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. & 679 & td_dom%i_jmax == 0 )THEN 680 681 CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//& 465 682 & "domain to extract is semi-global" ) 466 683 467 684 CALL dom__size_semi_global( td_dom ) 468 685 469 ELSEIF( td_dom%i_imin == td_dom%i_imax.AND. &470 & td_dom%i_jm in < td_dom%i_jmax)THEN471 472 CALL logger_trace("D EFINE CYCLIC NORTH FOLD: "//&686 ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. & 687 & td_dom%i_jmax /= 0 )THEN 688 689 CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//& 473 690 & "domain to extract is band of latidue" ) 474 691 475 692 CALL dom__size_no_pole( td_dom ) 476 693 477 ELSEIF( td_dom%i_imin /= td_dom%i_imax .AND. & 478 & td_dom%i_jmin == td_dom%i_jmax )THEN 479 480 CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 481 & "domain to extract has north boundary" ) 694 ELSEIF( td_dom%i_jmax == 0 )THEN 695 696 CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//& 697 & "domain to extract use north fold" ) 482 698 483 699 CALL dom__size_pole( td_dom ) 484 700 485 ELSEIF( td_dom%i_imin /= td_dom%i_imax .AND. & 486 & td_dom%i_jmin /= td_dom%i_jmax )THEN 487 488 IF( td_dom%i_jmax < td_dom%t_dim0(2)%i_len-1 .AND. & 489 & td_dom%i_jmax > td_dom%i_jmin )THEN 490 491 CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 492 & "domain to extract has no north boundary" ) 493 ! no North Pole 494 495 CALL dom__size_no_pole( td_dom ) 496 497 ELSE 498 499 CALL logger_trace("DEFINE CYCLIC NORTH FOLD: "//& 500 & "domain to extract has north boundary" ) 501 502 CALL dom__size_pole( td_dom ) 503 504 ENDIF 701 ELSEIF( td_dom%i_jmax /= 0 )THEN 702 703 CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//& 704 & "domain to extract do not use north fold" ) 705 ! no North Pole 706 707 CALL dom__size_no_pole( td_dom ) 505 708 506 709 ELSE 507 710 508 CALL logger_error("D EFINE CYCLIC NORTH FOLD: "//&711 CALL logger_error("DOM DEFINE CYCLIC NORTH FOLD: "//& 509 712 & "should have been an impossible case" ) 510 713 … … 512 715 513 716 END SUBROUTINE dom__define_cyclic_north_fold 514 !> @endcode515 717 !------------------------------------------------------------------- 516 718 !> @brief 517 !> This subroutine define extractdomain indices from global domain719 !> This subroutine define sub domain indices from global domain 518 720 !> with north fold boundary condition. 519 721 !> 520 722 !> @author J.Paul 521 !> - Nov, 2013- Subroutine written 522 ! 523 !> @param[inout] td_dom : domain strcuture 524 !------------------------------------------------------------------- 525 !> @code 723 !> - November, 2013- Subroutine written 724 ! 725 !> @param[inout] td_dom domain strcuture 726 !------------------------------------------------------------------- 526 727 SUBROUTINE dom__define_north_fold( td_dom ) 527 728 IMPLICIT NONE … … 530 731 !---------------------------------------------------------------- 531 732 532 IF( td_dom%i_jmax < td_dom%t_dim0(2)%i_len-1 .AND. & 533 & td_dom%i_jmax > td_dom%i_jmin )THEN 534 535 CALL logger_trace("DEFINE NORTH FOLD: "//& 733 IF( td_dom%i_jmax /= 0 )THEN 734 735 CALL logger_trace("DOM DEFINE NORTH FOLD: "//& 536 736 & "domain to extract has no north boundary" ) 537 737 ! no North Pole … … 541 741 ELSE 542 742 543 CALL logger_trace("D EFINE NORTH FOLD: "//&544 & " domain to extracthas north boundary" )743 CALL logger_trace("DOM DEFINE NORTH FOLD: "//& 744 & "sub domain has north boundary" ) 545 745 546 746 CALL dom__size_pole_no_overlap( td_dom ) … … 549 749 550 750 END SUBROUTINE dom__define_north_fold 551 !> @endcode552 751 !------------------------------------------------------------------- 553 752 !> @brief 554 !> This subroutine define extractdomain indices from global domain753 !> This subroutine define sub domain indices from global domain 555 754 !> with symmetric boundary condition across the equator. 556 755 !> 557 756 !> @author J.Paul 558 !> - Nov, 2013- Subroutine written 559 ! 560 !> @param[inout] td_dom : domain strcuture 561 !------------------------------------------------------------------- 562 !> @code 757 !> - November, 2013- Subroutine written 758 ! 759 !> @param[inout] td_dom domain strcuture 760 !------------------------------------------------------------------- 563 761 SUBROUTINE dom__define_symmetric( td_dom ) 564 762 IMPLICIT NONE … … 570 768 571 769 END SUBROUTINE dom__define_symmetric 572 !> @endcode573 770 !------------------------------------------------------------------- 574 771 !> @brief 575 !> This subroutine define extractdomain indices from global domain772 !> This subroutine define sub domain indices from global domain 576 773 !> with cyclic east-west boundary. 577 774 !> 578 775 !> @author J.Paul 579 !> - Nov, 2013- Subroutine written 580 ! 581 !> @param[inout] td_dom : domain strcuture 582 !------------------------------------------------------------------- 583 !> @code 776 !> - November, 2013- Subroutine written 777 ! 778 !> @param[inout] td_dom domain strcuture 779 !------------------------------------------------------------------- 584 780 SUBROUTINE dom__define_cyclic( td_dom ) 585 781 IMPLICIT NONE … … 587 783 TYPE(TDOM), INTENT(INOUT) :: td_dom 588 784 !---------------------------------------------------------------- 589 CALL dom__check_EW_index( td_dom )590 785 591 786 IF( td_dom%i_imin >= td_dom%i_imax )THEN 592 CALL logger_trace("D EFINE CYCLIC: "//&787 CALL logger_trace("DOM DEFINE CYCLIC: "//& 593 788 & "domain to extract overlap east-west boundary") 594 789 … … 597 792 ELSE 598 793 ! id_imin < id_imax 599 CALL logger_trace("D EFINE CYCLIC: "//&794 CALL logger_trace("DOM DEFINE CYCLIC: "//& 600 795 & "domain to extract do not overlap east-west boundary") 601 796 … … 605 800 606 801 END SUBROUTINE dom__define_cyclic 607 !> @endcode608 802 !------------------------------------------------------------------- 609 803 !> @brief 610 !> This subroutine define extractdomain indices from global domain804 !> This subroutine define sub domain indices from global domain 611 805 !> with closed boundaries. 612 806 !> 613 807 !> @author J.Paul 614 !> - Nov, 2013- Subroutine written 615 ! 616 !> @param[inout] td_dom : domain strcuture 617 !------------------------------------------------------------------- 618 !> @code 808 !> - November, 2013- Subroutine written 809 ! 810 !> @param[inout] td_dom domain strcuture 811 !------------------------------------------------------------------- 619 812 SUBROUTINE dom__define_closed( td_dom ) 620 813 IMPLICIT NONE … … 626 819 627 820 END SUBROUTINE dom__define_closed 628 !> @endcode629 !-------------------------------------------------------------------630 !> @brief631 !> This subroutine check East-West indices, use inside a cyclic domain,632 !> and redefine it in some particular cases.633 !>634 !> @author J.Paul635 !> - Nov, 2013- Subroutine written636 !637 !> @param[inout] td_dom : domain strcuture638 !-------------------------------------------------------------------639 !> @code640 SUBROUTINE dom__check_EW_index( td_dom )641 IMPLICIT NONE642 ! Argument643 TYPE(TDOM), INTENT(INOUT) :: td_dom644 !----------------------------------------------------------------645 646 IF( td_dom%i_imin /= td_dom%i_imax )THEN647 648 IF((ABS(td_dom%i_imax-td_dom%i_imin) >= td_dom%t_dim0(1)%i_len-1).OR.&649 (ABS(td_dom%i_imax-td_dom%i_imin) <= td_dom%i_ew0 ) )THEN650 651 td_dom%i_imin = td_dom%i_imax652 653 ENDIF654 655 ENDIF656 657 END SUBROUTINE dom__check_EW_index658 !> @endcode659 821 !------------------------------------------------------------------- 660 822 !> @brief … … 662 824 !> 663 825 !> @author J.Paul 664 !> - Nov, 2013- Subroutine written 665 ! 666 !> @param[inout] td_dom : domain strcuture 667 !------------------------------------------------------------------- 668 !> @code 826 !> - November, 2013- Subroutine written 827 ! 828 !> @param[inout] td_dom domain strcuture 829 !------------------------------------------------------------------- 669 830 SUBROUTINE dom__size_global( td_dom ) 670 831 IMPLICIT NONE … … 684 845 685 846 ! no ghost cell to add 686 td_dom%i_ighost=0 687 td_dom%i_jghost=0 688 689 ! peiordicity 847 td_dom%i_ghost(:,:)=0 848 849 ! periodicity 690 850 IF( td_dom%i_pivot == 0 )THEN ! 0-F 691 851 td_dom%i_perio=4 … … 697 857 698 858 END SUBROUTINE dom__size_global 699 !> @endcode700 859 !------------------------------------------------------------------- 701 860 !> @brief … … 703 862 !> 704 863 !> @author J.Paul 705 !> - Nov , 2013- Subroutine written706 ! 707 !> @param[inout] td_dom :domain strcuture864 !> - November, 2013- Subroutine written 865 ! 866 !> @param[inout] td_dom domain strcuture 708 867 !> @note never tested 709 868 !------------------------------------------------------------------- 710 !> @code711 869 SUBROUTINE dom__size_semi_global( td_dom ) 712 870 IMPLICIT NONE … … 715 873 716 874 ! local variable 717 INTEGER(i4) :: il_imid ! cana nadian bipole index (middle of global domain)875 INTEGER(i4) :: il_imid ! canadian bipole index (middle of global domain) 718 876 !---------------------------------------------------------------- 719 877 … … 723 881 td_dom%i_imax = il_imid !td_dom%t_dim0(1)%i_len 724 882 725 IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 726 td_dom%i_jmax=MIN( td_dom%i_jmin, & 727 & td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 728 ELSE 729 td_dom%i_jmin=td_dom%i_jmax 730 ENDIF 883 IF( td_dom%i_jmin == 0 ) td_dom%i_jmin=1 884 td_dom%i_jmax = td_dom%t_dim0(2)%i_len 731 885 732 886 ! domain size 733 td_dom%t_dim(1)%i_len = (td_dom%i_imax )- &734 & (td_dom%i_imin )+ 1887 td_dom%t_dim(1)%i_len = td_dom%i_imax - & 888 & td_dom%i_imin + 1 735 889 736 890 td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 737 & ( td_dom%i_jmin )+ 1 ) + &891 & td_dom%i_jmin + 1 ) + & 738 892 & ( td_dom%t_dim0(2)%i_len - & 739 & ( td_dom%i_jmax )+ 1 ) - 2 ! remove north fold condition ?893 & td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ? 740 894 741 895 ! ghost cell to add 742 td_dom%i_ighost=1 743 td_dom%i_jghost=1 896 td_dom%i_ghost(:,:)=1 744 897 745 898 ! periodicity … … 753 906 754 907 END SUBROUTINE dom__size_semi_global 755 !> @endcode756 908 !------------------------------------------------------------------- 757 909 !> @brief 758 !> This subroutine compute size of an extractdomain without north fold910 !> This subroutine compute size of sub domain without north fold 759 911 !> condition 760 912 !> 761 913 !> @author J.Paul 762 !> - Nov, 2013- Subroutine written 763 ! 764 !> @param[inout] td_dom : domain strcuture 765 !------------------------------------------------------------------- 766 !> @code 914 !> - November, 2013- Subroutine written 915 ! 916 !> @param[inout] td_dom domain strcuture 917 !------------------------------------------------------------------- 767 918 SUBROUTINE dom__size_no_pole( td_dom ) 768 919 IMPLICIT NONE … … 771 922 !---------------------------------------------------------------- 772 923 773 IF( td_dom%i_jm in >= td_dom%i_jmax)THEN774 CALL logger_fatal("DOM INIT: invalid domain. "//&924 IF( td_dom%i_jmax == 0 )THEN 925 CALL logger_fatal("DOM SIZE NO POLE: invalid domain. "//& 775 926 & "can not get north pole from this coarse grid. "//& 776 927 & "check namelist and coarse grid periodicity." ) 777 928 ENDIF 778 929 779 IF( td_dom%i_imin >= td_dom%i_imax )THEN 780 CALL logger_trace("DEFINE NO POLE: "// & 930 IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .OR. & 931 & td_dom%i_imin > td_dom%i_imax )THEN 932 CALL logger_trace("DOM SIZE NO POLE: "// & 781 933 & "domain to extract overlap east-west boundary") 782 934 … … 785 937 ELSE 786 938 ! id_imin < id_imax 787 CALL logger_trace("D EFINE NO POLE: "// &939 CALL logger_trace("DOM SIZE NO POLE: "// & 788 940 & "domain to extract do not overlap east-west boundary") 789 941 … … 793 945 794 946 END SUBROUTINE dom__size_no_pole 795 !> @endcode796 947 !------------------------------------------------------------------- 797 948 !> @brief 798 !> This subroutine compute size of an extractdomain with north fold799 !> condition 949 !> This subroutine compute size of sub domain with north fold 950 !> condition. 800 951 !> 801 952 !> @author J.Paul 802 953 !> - April, 2013- Subroutine written 803 954 ! 804 !> @param[inout] td_dom :domain strcuture805 ! -------------------------------------------------------------------806 ! > @code955 !> @param[inout] td_dom domain strcuture 956 !> @note never tested 957 !------------------------------------------------------------------- 807 958 SUBROUTINE dom__size_pole( td_dom ) 808 959 IMPLICIT NONE … … 811 962 !---------------------------------------------------------------- 812 963 813 IF( td_dom%i_imin > td_dom%i_imax )THEN814 CALL logger_trace("D EFINE POLE: "//&964 IF( td_dom%i_imin >= td_dom%i_imax )THEN 965 CALL logger_trace("DOM SIZE POLE: "//& 815 966 & "domain to extract overlap east-west boundary") 816 967 CALL dom__size_pole_overlap( td_dom ) 817 968 ELSEIF( td_dom%i_imin < td_dom%i_imax )THEN 818 CALL logger_trace("D EFINE POLE: "//&969 CALL logger_trace("DOM SIZE POLE: "//& 819 970 & "domain to extract do not overlap east-west boundary") 820 971 CALL dom__size_pole_no_overlap( td_dom ) … … 822 973 823 974 END SUBROUTINE dom__size_pole 824 !> @endcode825 975 !------------------------------------------------------------------- 826 976 !> @brief 827 !> This subroutine compute size of an extractdomain without north fold977 !> This subroutine compute size of sub domain without north fold 828 978 !> condition, and which overlap east-west boundary 829 979 !> 830 980 !> @author J.Paul 831 !> - Nov, 2013- Subroutine written 832 ! 833 !> @param[inout] td_dom : domain strcuture 834 !------------------------------------------------------------------- 835 !> @code 981 !> - November, 2013- Subroutine written 982 ! 983 !> @param[inout] td_dom domain strcuture 984 !------------------------------------------------------------------- 836 985 SUBROUTINE dom__size_no_pole_overlap( td_dom ) 837 986 IMPLICIT NONE … … 840 989 !---------------------------------------------------------------- 841 990 842 IF( td_dom%i_jm in >= td_dom%i_jmax)THEN843 CALL logger_fatal("DOM INIT: invalid domain. "//&991 IF( td_dom%i_jmax == 0 )THEN 992 CALL logger_fatal("DOM SIZE NO POLE OVERLAP: invalid domain. "//& 844 993 & "can not get north pole from this coarse grid. "//& 845 994 & "check namelist and coarse grid periodicity." ) 846 995 ENDIF 847 996 848 IF( td_dom%i_imin == td_dom%i_imax)THEN997 IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 )THEN 849 998 ! domain to extract with east west cyclic boundary 850 CALL logger_trace("D EFINE NO POLE OVERLAP: "//&999 CALL logger_trace("DOM SIZE NO POLE OVERLAP: "//& 851 1000 & "domain to extract has cyclic east-west boundary") 852 1001 … … 857 1006 858 1007 ! no ghost cell 859 td_dom%i_ ighost=01008 td_dom%i_ghost(jp_I,:)=0 860 1009 861 1010 ! periodicity … … 867 1016 ! extract domain overlap east-west boundary 868 1017 869 td_dom%t_dim(1)%i_len = td_dom% t_dim0(1)%i_len -&870 & (td_dom%i_imin ) + 1 +&871 & (td_dom%i_imax ) - 2! remove cyclic boundary1018 td_dom%t_dim(1)%i_len = td_dom%i_imax + & 1019 & td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - & 1020 & td_dom%i_ew0 ! remove cyclic boundary 872 1021 873 1022 ! add ghost cell 874 td_dom%i_ ighost=11023 td_dom%i_ghost(jp_I,:)=1 875 1024 876 1025 ! periodicity … … 879 1028 ENDIF 880 1029 881 td_dom%t_dim(2)%i_len = (td_dom%i_jmax )- &882 & (td_dom%i_jmin )+ 11030 td_dom%t_dim(2)%i_len = td_dom%i_jmax - & 1031 & td_dom%i_jmin + 1 883 1032 884 1033 ! add ghost cell 885 td_dom%i_ jghost=11034 td_dom%i_ghost(jp_J,:)=1 886 1035 887 1036 END SUBROUTINE dom__size_no_pole_overlap 888 !> @endcode889 1037 !------------------------------------------------------------------- 890 1038 !> @brief 891 !> This subroutine compute size of an extractdomain without north fold1039 !> This subroutine compute size of sub domain without north fold 892 1040 !> condition, and which do not overlap east-west boundary 893 1041 !> 894 1042 !> @author J.Paul 895 !> - Nov, 2013- Subroutine written 896 ! 897 !> @param[inout] td_dom : domain strcuture 898 !------------------------------------------------------------------- 899 !> @code 1043 !> - November, 2013- Subroutine written 1044 ! 1045 !> @param[inout] td_dom domain strcuture 1046 !------------------------------------------------------------------- 900 1047 SUBROUTINE dom__size_no_pole_no_overlap( td_dom ) 901 1048 IMPLICIT NONE … … 904 1051 !---------------------------------------------------------------- 905 1052 906 IF( td_dom%i_jm in >= td_dom%i_jmax)THEN907 CALL logger_fatal("DOM INIT: invalid domain. "//&1053 IF( td_dom%i_jmax == 0 )THEN 1054 CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//& 908 1055 & "can not get north pole from this coarse grid. "//& 909 & "check namelist and coarsegrid periodicity." )910 ENDIF 911 912 IF( td_dom%i_imin >= td_dom%i_imax)THEN913 CALL logger_fatal("DOM INIT: invalid domain. "//&1056 & "check domain indices and grid periodicity." ) 1057 ENDIF 1058 1059 IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 )THEN 1060 CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//& 914 1061 & "can not overlap East-West boundary with this coarse grid. "//& 915 & "check namelist and coarsegrid periodicity." )916 ENDIF 917 918 td_dom%t_dim(1)%i_len = ( td_dom%i_imax )- &919 & ( td_dom%i_imin )+ 1920 921 td_dom%t_dim(2)%i_len = ( td_dom%i_jmax )- &922 & ( td_dom%i_jmin )+ 11062 & "check domain indices and grid periodicity." ) 1063 ENDIF 1064 1065 td_dom%t_dim(1)%i_len = td_dom%i_imax - & 1066 & td_dom%i_imin + 1 1067 1068 td_dom%t_dim(2)%i_len = td_dom%i_jmax - & 1069 & td_dom%i_jmin + 1 923 1070 924 1071 ! add ghost cell 925 td_dom%i_ighost=1 926 td_dom%i_jghost=1 1072 td_dom%i_ghost(:,:)=1 927 1073 928 1074 ! periodicity … … 930 1076 931 1077 END SUBROUTINE dom__size_no_pole_no_overlap 932 !> @endcode933 1078 !------------------------------------------------------------------- 934 1079 !> @brief 935 !> This subroutine compute size of an extractdomain with north fold1080 !> This subroutine compute size of sub domain with north fold 936 1081 !> condition, and which overlap east-west boundary 937 1082 !> 938 1083 !> @author J.Paul 939 !> - Nov , 2013- Subroutine written940 ! 941 !> @param[inout] td_dom :domain strcuture1084 !> - November, 2013- Subroutine written 1085 ! 1086 !> @param[inout] td_dom domain strcuture 942 1087 !> @note never tested 943 1088 !------------------------------------------------------------------- 944 !> @code945 1089 SUBROUTINE dom__size_pole_overlap( td_dom ) 946 1090 IMPLICIT NONE … … 954 1098 !---------------------------------------------------------------- 955 1099 956 CALL logger_trace("D EFINE POLE OVERLAP: "//&1100 CALL logger_trace("DOM SIZE POLE OVERLAP: "//& 957 1101 & "asian bipole inside domain to extract") 958 1102 … … 964 1108 IF( il_idom1 > il_imid .OR. il_idom2 > il_imid )THEN 965 1109 966 CALL logger_trace("D EFINE POLE OVERLAP: "//&1110 CALL logger_trace("DOM SIZE POLE OVERLAP: "//& 967 1111 & "canadian bipole inside domain to extract") 968 td_dom%i_imin = td_dom%i_imax 969 970 IF( td_dom%i_jmin == td_dom%i_jmax )THEN 1112 td_dom%i_imin = 0 1113 td_dom%i_imax = 0 1114 1115 IF( td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN 971 1116 CALL dom__size_global( td_dom ) 972 1117 ELSE … … 980 1125 981 1126 ! east part bigger than west part 982 CALL logger_trace("D EFINE POLE OVERLAP: east part bigger than west part ")1127 CALL logger_trace("DOM SIZE POLE OVERLAP: east part bigger than west part ") 983 1128 ! to respect symmetry around asian bipole 984 1129 td_dom%i_imax = il_idom1 985 1130 1131 IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1 986 1132 ! north pole 987 IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 988 td_dom%i_jmax=MIN( td_dom%i_jmin, & 989 & td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 990 ELSE 991 td_dom%i_jmax=MIN( td_dom%i_jmin, td_dom%i_jmax ) 992 ENDIF 993 td_dom%i_jmin=td_dom%i_jmax 1133 td_dom%i_jmax = td_dom%t_dim0(2)%i_len 994 1134 995 1135 ! compute size 996 1136 td_dom%t_dim(1)%i_len = il_idom1 !! no ghost cell ?? 997 1137 td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 998 & ( td_dom%i_jmin )+ 1 ) + &1138 & td_dom%i_jmin + 1 ) + & 999 1139 & ( td_dom%t_dim0(2)%i_len - & 1000 & ( td_dom%i_jmax )+ 1 ) - 2 ! remove north fold condition ?1140 & td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ? 1001 1141 1002 1142 ! add ghost cell 1003 td_dom%i_ighost=1 1004 td_dom%i_jghost=1 1143 td_dom%i_ghost(:,:)=1 1005 1144 1006 1145 ! periodicity … … 1010 1149 1011 1150 ! west part bigger than east part 1012 CALL logger_trace("D EFINE POLE OVERLAP: west part bigger than east part ")1151 CALL logger_trace("DOM SIZE POLE OVERLAP: west part bigger than east part ") 1013 1152 1014 1153 ! to respect symmetry around asian bipole 1015 1154 td_dom%i_imin = td_dom%t_dim0(1)%i_len - il_idom2 + 1 1016 1155 1156 IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1 1017 1157 ! north pole 1018 IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 1019 td_dom%i_jmax=MIN( td_dom%i_jmin, & 1020 & td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 1021 ELSE 1022 td_dom%i_jmax=MIN( td_dom%i_jmin, td_dom%i_jmax ) 1023 ENDIF 1024 td_dom%i_jmin=td_dom%i_jmax 1158 td_dom%i_jmax=td_dom%t_dim0(2)%i_len 1025 1159 1026 1160 ! compute size 1027 1161 td_dom%t_dim(1)%i_len = il_idom2 1028 1162 td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 1029 & ( td_dom%i_jmin )+ 1 ) + &1163 & td_dom%i_jmin + 1 ) + & 1030 1164 & ( td_dom%t_dim0(2)%i_len - & 1031 & ( td_dom%i_jmax )+ 1 ) - 21165 & td_dom%i_jmin + 1 ) - 2 1032 1166 1033 1167 ! add ghost cell 1034 td_dom%i_ighost=1 1035 td_dom%i_jghost=1 1168 td_dom%i_ghost(:,:)=1 1036 1169 1037 1170 ! periodicity … … 1041 1174 1042 1175 END SUBROUTINE dom__size_pole_overlap 1043 !> @endcode1044 1176 !------------------------------------------------------------------- 1045 1177 !> @brief 1046 !> This subroutine compute size of an extractdomain with north fold1178 !> This subroutine compute size of sub domain with north fold 1047 1179 !> condition, and which do not overlap east-west boundary 1048 1180 !> 1049 1181 !> @author J.Paul 1050 !> - Nov , 2013- Subroutine written1051 ! 1052 !> @param[inout] td_dom :domain strcuture1182 !> - November, 2013- Subroutine written 1183 ! 1184 !> @param[inout] td_dom domain strcuture 1053 1185 !> @note never tested 1054 1186 !------------------------------------------------------------------- 1055 !> @code1056 1187 SUBROUTINE dom__size_pole_no_overlap( td_dom ) 1057 1188 IMPLICIT NONE … … 1065 1196 !---------------------------------------------------------------- 1066 1197 1067 IF( td_dom%i_imin >= td_dom%i_imax )THEN 1068 CALL logger_fatal("DOM INIT: invalid domain. "//& 1198 IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. & 1199 & td_dom%i_imin > td_dom%i_imax )THEN 1200 CALL logger_fatal("DOM SIZE POLE NO OVERLAP: invalid domain. "//& 1069 1201 & "can not overlap East-West boundary with this coarse grid. "//& 1070 1202 & "check namelist and coarse grid periodicity." ) 1071 1203 ENDIF 1072 1204 1073 CALL logger_trace("D EFINE POLE NO OVERLAP: "//&1205 CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//& 1074 1206 & "no asian bipole inside domain to extract") 1075 1207 1076 ! north pole 1077 IF( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 )THEN 1078 td_dom%i_jmax=MIN( td_dom%i_jmin, & 1079 & td_dom%t_dim0(2)%i_len-td_dom%i_jmax ) 1080 ELSE 1081 td_dom%i_jmax=MIN( td_dom%i_jmin, td_dom%i_jmax ) 1082 ENDIF 1083 td_dom%i_jmin=td_dom%i_jmax 1208 IF( td_dom%i_jmin==0 ) td_dom%i_jmin = 1 1209 IF( td_dom%i_jmax==0 ) td_dom%i_jmax = td_dom%t_dim0(2)%i_len 1084 1210 1085 1211 ! … … 1088 1214 IF( (td_dom%i_imin < il_mid .AND. td_dom%i_imax < il_mid) .OR. & 1089 1215 & (td_dom%i_imin > il_mid .AND. td_dom%i_imax > il_mid) )THEN 1090 CALL logger_trace("D EFINE POLE NO OVERLAP: "//&1216 CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//& 1091 1217 & "no canadian bipole inside domain to extract") 1092 1218 1093 td_dom%t_dim(1)%i_len = ( td_dom%i_imax )- &1094 & ( td_dom%i_imin )+ 11219 td_dom%t_dim(1)%i_len = td_dom%i_imax - & 1220 & td_dom%i_imin + 1 1095 1221 1096 1222 td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 1097 & ( td_dom%i_jmin )+ 1 ) + &1223 & td_dom%i_jmin + 1 ) + & 1098 1224 & ( td_dom%t_dim0(2)%i_len - & 1099 & ( td_dom%i_jmax )+ 1 ) - 2 ! remove north fold condition ?1225 & td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ? 1100 1226 1101 1227 ! add ghost cell 1102 td_dom%i_ighost=1 1103 td_dom%i_jghost=1 1228 td_dom%i_ghost(:,:)=1 1104 1229 1105 1230 ! periodicity … … 1107 1232 1108 1233 ELSE ! id_imin < il_mid .AND. id_imax > il_mid 1109 CALL logger_trace("D EFINE POLE NO OVERLAP: "//&1234 CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//& 1110 1235 & "canadian bipole inside domain to extract") 1111 1236 … … 1114 1239 IF( il_idom1 > il_idom2 )THEN 1115 1240 ! east part bigger than west part 1116 CALL logger_trace("D EFINE POLE NO OVERLAP: east part bigger than west part ")1241 CALL logger_trace("DOM SIZE POLE NO OVERLAP: east part bigger than west part ") 1117 1242 ! to respect symmetry around canadian bipole 1118 1243 td_dom%i_imin = il_mid - il_idom1 … … 1120 1245 td_dom%t_dim(1)%i_len = il_idom1 + 1 1121 1246 td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 1122 & ( td_dom%i_jmin )+ 1 ) + &1247 & td_dom%i_jmin + 1 ) + & 1123 1248 & ( td_dom%t_dim0(2)%i_len - & 1124 & ( td_dom%i_jmax )+ 1 ) &1249 & td_dom%i_jmin + 1 ) & 1125 1250 & - 2 - 2 * td_dom%i_pivot ! remove north fold condition ? 1126 1251 1127 1252 ! add ghost cell 1128 td_dom%i_ighost=1 1129 td_dom%i_jghost=1 1253 td_dom%i_ghost(:,:)=1 1130 1254 1131 1255 ! periodicity … … 1134 1258 ELSE ! il_idom2 >= il_idom1 1135 1259 ! west part bigger than east part 1136 CALL logger_trace("D EFINE POLE NO OVERLAP: west part bigger than east part ")1260 CALL logger_trace("DOM SIZE POLE NO OVERLAP: west part bigger than east part ") 1137 1261 ! to respect symmetry around canadian bipole 1138 1262 … … 1141 1265 td_dom%t_dim(1)%i_len = il_idom2 + 1 1142 1266 td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - & 1143 & ( td_dom%i_jmin )+ 1 ) + &1267 & td_dom%i_jmin + 1 ) + & 1144 1268 & ( td_dom%t_dim0(2)%i_len - & 1145 & ( td_dom%i_jmax )+ 1 ) &1269 & td_dom%i_jmax + 1 ) & 1146 1270 & - 2 - 2 * td_dom%i_pivot ! remove north fold condition ? 1147 1271 1148 1272 ! add ghost cell 1149 td_dom%i_ighost=1 1150 td_dom%i_jghost=1 1273 td_dom%i_ghost(:,:)=1 1151 1274 1152 1275 ! periodicity … … 1157 1280 1158 1281 END SUBROUTINE dom__size_pole_no_overlap 1159 !> @endcode 1160 !------------------------------------------------------------------- 1161 !> @brief This function get east west overlap. 1162 ! 1282 !------------------------------------------------------------------- 1283 !> @brief 1284 !> This subroutine add extra bands to coarse domain to get enough point for 1285 !> interpolation... 1286 !> 1163 1287 !> @details 1164 !> If no east -west wrap return -1, 1165 !> else return the size of the ovarlap band 1166 ! 1167 !> @author J.Paul 1168 !> - 2013- Initial Version 1169 ! 1170 !> @param[in] 1171 !------------------------------------------------------------------- 1172 !> @code 1173 FUNCTION dom_get_ew_overlap(td_lon) 1174 IMPLICIT NONE 1175 ! Argument 1176 TYPE(TVAR), INTENT(IN) :: td_lon 1177 1178 ! function 1179 INTEGER(i4) :: dom_get_ew_overlap 1180 1181 ! local variable 1182 REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 1183 REAL(dp), DIMENSION(:) , ALLOCATABLE :: dl_lone 1184 REAL(dp), DIMENSION(:) , ALLOCATABLE :: dl_lonw 1185 1186 REAL(dp) :: dl_delta 1187 REAL(dp) :: dl_lonmax 1188 REAL(dp) :: dl_lonmin 1189 1190 INTEGER(i4) :: il_east 1191 INTEGER(i4) :: il_west 1192 INTEGER(i4) :: il_jmin 1193 INTEGER(i4) :: il_jmax 1194 1195 INTEGER(i4), PARAMETER :: ip_max_overlap = 5 1196 1197 ! loop indices 1198 INTEGER(i4) :: ji 1199 !---------------------------------------------------------------- 1200 ! init 1201 dom_get_ew_overlap=-1 1202 1203 il_west=1 1204 il_east=td_lon%t_dim(1)%i_len 1205 1206 ALLOCATE( dl_value(td_lon%t_dim(1)%i_len, & 1207 & td_lon%t_dim(2)%i_len, & 1208 & td_lon%t_dim(3)%i_len, & 1209 & td_lon%t_dim(4)%i_len) ) 1210 1211 dl_value(:,:,:,:)=td_lon%d_value(:,:,:,:) 1212 WHERE( dl_value(:,:,:,:) > 180._dp .AND. & 1213 & dl_value(:,:,:,:) /= td_lon%d_fill ) 1214 dl_value(:,:,:,:)=360.-dl_value(:,:,:,:) 1215 END WHERE 1216 1217 ! we do not use jmax as dimension length due to north fold boundary 1218 il_jmin=1+ig_ghost 1219 il_jmax=(td_lon%t_dim(2)%i_len-ig_ghost)/2 1220 1221 ALLOCATE( dl_lone(il_jmax-il_jmin+1) ) 1222 ALLOCATE( dl_lonw(il_jmax-il_jmin+1) ) 1223 1224 dl_lone(:)=dl_value(il_east,il_jmin:il_jmax,1,1) 1225 dl_lonw(:)=dl_value(il_west,il_jmin:il_jmax,1,1) 1226 1227 IF( .NOT.( ALL(dl_lone(:)==td_lon%d_fill) .AND. & 1228 & ALL(dl_lonw(:)==td_lon%d_fill) ) )THEN 1229 1230 dl_lonmax=MAXVAL(dl_value(:,il_jmin:il_jmax,:,:)) 1231 dl_lonmin=MINVAL(dl_value(:,il_jmin:il_jmax,:,:)) 1232 1233 dl_delta=(dl_lonmax-dl_lonmin)/td_lon%t_dim(1)%i_len 1234 1235 IF( ALL(ABS(dl_lone(:)) - ABS(dl_lonw(:)) == dl_delta) )THEN 1236 1237 dom_get_ew_overlap=0 1238 1239 ELSE IF( ALL( ABS(dl_lone(:)) - ABS(dl_lonw(:)) < & 1240 & ip_max_overlap*dl_delta ) )THEN 1241 DO ji=0,ip_max_overlap 1242 1243 IF( il_east-ji == il_west )THEN 1244 ! case of small domain 1245 EXIT 1246 ELSE 1247 dl_lone(:)=dl_value(il_east-ji,il_jmin:il_jmax,1,1) 1248 1249 IF( ALL( dl_lonw(:) == dl_lone(:) ) )THEN 1250 dom_get_ew_overlap=ji+1 1251 EXIT 1252 ENDIF 1253 ENDIF 1254 1255 ENDDO 1256 ENDIF 1257 1258 ENDIF 1259 1260 DEALLOCATE( dl_value ) 1261 1262 END FUNCTION dom_get_ew_overlap 1263 !> @endcode 1264 !------------------------------------------------------------------- 1265 !> @brief 1266 !> This subroutine add extra point to domain 1267 ! 1268 !> @author J.Paul 1269 !> @date Nov, 2013 1270 ! 1271 !> @param[inout] td_dom : domain strcuture 1272 !> @param [in] id_iext : i-direction size of extra bands (default=im_minext) 1273 !> @param [in] id_jext : j-direction size of extra bands (default=im_minext) 1274 !------------------------------------------------------------------- 1275 !> @code 1288 !> - domain periodicity is take into account.<br/> 1289 !> - domain indices are changed, and size of extra bands are saved.<br/> 1290 !> - optionaly, i- and j- direction size of extra bands could be specify 1291 !> (default=im_minext) 1292 !> 1293 !> @author J.Paul 1294 !> @date November, 2013 1295 !> @date September, 2014 1296 !> - take into account number of ghost cell 1297 ! 1298 !> @param[inout] td_dom domain strcuture 1299 !> @param [in] id_iext i-direction size of extra bands (default=im_minext) 1300 !> @param [in] id_jext j-direction size of extra bands (default=im_minext) 1301 !------------------------------------------------------------------- 1276 1302 SUBROUTINE dom_add_extra( td_dom, id_iext, id_jext ) 1277 1303 IMPLICIT NONE … … 1288 1314 !---------------------------------------------------------------- 1289 1315 ! init 1290 !WARNING: two extrabands are required for cubic interpolation1291 1316 il_iext=im_minext 1292 1317 IF( PRESENT(id_iext) ) il_iext=id_iext … … 1305 1330 ! nothing to be done 1306 1331 ELSE 1332 1307 1333 IF( td_dom%i_imin == 1 .AND. & 1308 1334 & td_dom%i_imax == td_dom%t_dim0(1)%i_len )THEN … … 1310 1336 ! nothing to be done 1311 1337 ELSE 1312 IF( td_dom%i_imin /= 1 )THEN 1313 td_dom%i_iextra(1)=il_iext 1314 1315 ELSE 1316 IF( td_dom%i_ew0 > 0 )THEN 1317 td_dom%i_iextra(1)=il_iext 1318 1338 IF( td_dom%i_ew0 < 0 )THEN 1339 ! EW not cyclic 1340 IF( td_dom%i_imin - il_iext > td_dom%i_ghost0(jp_I,1)*ip_ghost )THEN 1341 td_dom%i_iextra(1) = il_iext 1342 td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1) 1343 ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost 1344 td_dom%i_iextra(1) = MIN(0, & 1345 & td_dom%i_imin - & 1346 & td_dom%i_ghost0(jp_I,1)*ip_ghost -1) 1347 td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1) 1319 1348 ENDIF 1349 1350 IF( td_dom%i_imax + il_iext < & 1351 & td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost )THEN 1352 td_dom%i_iextra(2) = il_iext 1353 td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2) 1354 ELSE ! td_dom%i_imax + il_iext >= & 1355 ! td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost 1356 td_dom%i_iextra(2) = MIN(0, & 1357 & td_dom%t_dim0(1)%i_len - & 1358 & td_dom%i_ghost0(jp_I,2)*ip_ghost - & 1359 & td_dom%i_imax ) 1360 td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2) 1361 ENDIF 1362 1363 ELSE ! td_dom%i_ew0 >= 0 1364 ! EW cyclic 1365 IF( td_dom%i_imin - il_iext > 0 )THEN 1366 td_dom%i_iextra(1) = il_iext 1367 td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1) 1368 ELSE ! td_dom%i_imin - il_iext <= 0 1369 td_dom%i_iextra(1) = il_iext 1370 td_dom%i_imin = td_dom%t_dim0(1)%i_len + & 1371 & td_dom%i_imin - td_dom%i_iextra(1) -& 1372 & td_dom%i_ew0 1373 ENDIF 1374 1375 IF( td_dom%i_imax + il_iext <= td_dom%t_dim0(1)%i_len )THEN 1376 td_dom%i_iextra(2) = il_iext 1377 td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2) 1378 ELSE ! td_dom%i_imax + il_iext > td_dom%t_dim0(1)%i_len 1379 td_dom%i_iextra(2) = il_iext 1380 td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2) - & 1381 & (td_dom%t_dim0(1)%i_len-td_dom%i_ew0) 1382 ENDIF 1320 1383 ENDIF 1321 1384 1322 IF( td_dom%i_imax /= td_dom%t_dim(1)%i_len )THEN 1323 td_dom%i_iextra(2)=1 1324 1325 ELSE 1326 IF( td_dom%i_ew0 > 0 )THEN 1327 td_dom%i_iextra(2)=il_jext 1328 1329 ENDIF 1385 ENDIF 1386 1387 IF( td_dom%i_jmin == 1 .AND. & 1388 & td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN 1389 ! nothing to be done 1390 ELSE 1391 IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN 1392 td_dom%i_jextra(1) = il_jext 1393 td_dom%i_jmin = td_dom%i_jmin - td_dom%i_jextra(1) 1394 ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost 1395 td_dom%i_jextra(1) = MIN(0, & 1396 & td_dom%i_jmin - & 1397 & td_dom%i_ghost0(jp_J,1)*ip_ghost - 1) 1398 td_dom%i_jmin = td_dom%i_jmin - td_dom%i_jextra(1) 1330 1399 ENDIF 1331 1400 1332 ENDIF 1333 1334 IF( td_dom%i_jmin == td_dom%i_jmax )THEN 1335 td_dom%i_jextra(1)=il_iext 1336 td_dom%i_jextra(2)=il_jext 1337 1338 ELSE 1339 IF( td_dom%i_jmin /= 1)THEN 1340 td_dom%i_jextra(1)=il_iext 1341 1401 IF( td_dom%i_jmax + il_jext < & 1402 & td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost )THEN 1403 td_dom%i_jextra(2) = il_jext 1404 td_dom%i_jmax = td_dom%i_jmax + td_dom%i_jextra(2) 1405 ELSE ! td_dom%i_jmax + il_jext >= & 1406 ! td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost 1407 td_dom%i_jextra(2) = MIN(0, & 1408 & td_dom%t_dim0(2)%i_len - & 1409 & td_dom%i_ghost0(jp_J,2)*ip_ghost - & 1410 & td_dom%i_jmax ) 1411 td_dom%i_jmax = td_dom%i_jmax + td_dom%i_jextra(2) 1342 1412 ENDIF 1343 IF( td_dom%i_jmax /= td_dom%t_dim(2)%i_len )THEN 1344 td_dom%i_jextra(2)=il_jext 1345 1346 ENDIF 1347 1348 ENDIF 1349 1350 ENDIF 1351 1352 ! change domain 1353 td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1) 1354 td_dom%i_jmin = td_dom%i_jmin - td_dom%i_jextra(1) 1355 1356 td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2) 1357 td_dom%i_jmax = td_dom%i_jmax + td_dom%i_jextra(2) 1358 1359 td_dom%t_dim(1)%i_len = td_dom%t_dim(1)%i_len + & 1360 & td_dom%i_iextra(1) + & 1361 & td_dom%i_iextra(2) 1362 td_dom%t_dim(2)%i_len = td_dom%t_dim(2)%i_len + & 1363 & td_dom%i_jextra(1) + & 1364 & td_dom%i_jextra(2) 1413 ENDIF 1414 1415 ENDIF 1416 1417 IF( td_dom%i_imin <= td_dom%i_imax )THEN 1418 td_dom%t_dim(1)%i_len = td_dom%i_imax - td_dom%i_imin +1 1419 ELSE ! td_dom%i_imin > td_dom%i_imax 1420 td_dom%t_dim(1)%i_len = td_dom%i_imax + & 1421 & td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - & 1422 & td_dom%i_ew0 ! remove overlap 1423 ENDIF 1424 1425 td_dom%t_dim(2)%i_len = td_dom%i_jmax-td_dom%i_jmin+1 1365 1426 1366 1427 1367 1428 END SUBROUTINE dom_add_extra 1368 !> @endcode1369 1429 !------------------------------------------------------------------- 1370 1430 !> @brief 1371 !> This subroutine clean domain structure. it remove extra point added.1372 ! 1373 ! > @author J.Paul1374 !> @ date Nov, 20131375 ! 1376 ! > @param[inout] td_dom : domain strcuture1377 ! -------------------------------------------------------------------1378 ! > @code1431 !> This subroutine clean coarse grid domain structure. 1432 !> it remove extra point added. 1433 ! 1434 !> @author J.Paul 1435 !> @date November, 2013 1436 ! 1437 !> @param[inout] td_dom domain strcuture 1438 !------------------------------------------------------------------- 1379 1439 SUBROUTINE dom_clean_extra( td_dom ) 1380 1440 IMPLICIT NONE … … 1404 1464 1405 1465 END SUBROUTINE dom_clean_extra 1406 !> @endcode1407 1466 !------------------------------------------------------------------- 1408 1467 !> @brief 1409 !> This subroutine 1410 ! 1411 !> @author J.Paul 1412 !> @date Nov, 2013 1413 ! 1414 !> @param[inout] td_var : variable strcuture 1415 !> @param[inout] td_dom : domain strcuture 1416 !> @param[inout] id_rhoi : i-direction refinement factor 1417 !> @param[inout] id_rhoj : j-direction refinement factor 1418 !------------------------------------------------------------------- 1419 !> @code 1420 SUBROUTINE dom_del_extra( td_var, td_dom, id_rho ) 1421 IMPLICIT NONE 1422 ! Argument 1423 TYPE(TVAR) , INTENT(INOUT) :: td_var 1424 TYPE(TDOM) , INTENT(IN ) :: td_dom 1425 INTEGER(i4), DIMENSION(:), INTENT(IN ) :: id_rho 1468 !> This subroutine delete extra band, from fine grid variable value, 1469 !> and dimension, taking into account refinement factor. 1470 !> 1471 !> @details 1472 !> @note This subroutine should be used before clean domain structure. 1473 !> 1474 !> @warning if work on coordinates grid, do not remove all extra point. 1475 !> save value on ghost cell. 1476 !> 1477 !> @author J.Paul 1478 !> @date November, 2013 1479 !> @date September, 2014 1480 !> - take into account boundary for one point size domain 1481 !> @date December, 2014 1482 !> - add special case for coordinates file. 1483 ! 1484 !> @param[inout] td_var variable strcuture 1485 !> @param[in] td_dom domain strcuture 1486 !> @param[in] id_rho array of refinement factor 1487 !> @param[in] ld_coord work on coordinates file or not 1488 !------------------------------------------------------------------- 1489 SUBROUTINE dom_del_extra( td_var, td_dom, id_rho, ld_coord ) 1490 IMPLICIT NONE 1491 ! Argument 1492 TYPE(TVAR) , INTENT(INOUT) :: td_var 1493 TYPE(TDOM) , INTENT(IN ) :: td_dom 1494 INTEGER(i4), DIMENSION(:), INTENT(IN ), OPTIONAL :: id_rho 1495 LOGICAL , INTENT(IN ), OPTIONAL :: ld_coord 1426 1496 1427 1497 ! local variable … … 1434 1504 INTEGER(i4) :: il_jmax 1435 1505 1436 REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 1437 1506 INTEGER(i4), DIMENSION(2) :: il_rho 1507 INTEGER(i4), DIMENSION(2,2) :: il_ghost 1508 1509 REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 1510 1511 LOGICAL :: ll_coord 1438 1512 ! loop indices 1439 1513 !---------------------------------------------------------------- 1514 1515 IF( PRESENT(id_rho) )THEN 1516 ! work on coarse grid 1517 il_rho(:)=id_rho(jp_I:jp_J) 1518 ELSE 1519 ! work on fine grid 1520 il_rho(:)=1 1521 ENDIF 1522 1523 ll_coord=.false. 1524 IF( PRESENT(ld_coord) ) ll_coord=ld_coord 1440 1525 1441 1526 IF( .NOT. ASSOCIATED(td_var%d_value) )THEN … … 1443 1528 & "variable "//TRIM(td_var%c_name) ) 1444 1529 ELSE 1445 ! get va irbale right domain1530 ! get variable right domain 1446 1531 IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 1447 il_iextra=SUM(td_dom%i_iextra(:))*id_rho(jp_I)1448 il_jextra=SUM(td_dom%i_jextra(:))*id_rho(jp_J)1449 1532 1450 1533 ALLOCATE(dl_value(td_var%t_dim(1)%i_len, & … … 1454 1537 dl_value(:,:,:,:)=td_var%d_value(:,:,:,:) 1455 1538 1456 il_imin=1 + td_dom%i_iextra(1)*id_rho(jp_I) 1457 il_imax=td_var%t_dim(1)%i_len - td_dom%i_iextra(2)*id_rho(jp_I) 1458 1459 il_jmin=1 + td_dom%i_jextra(1)*id_rho(jp_J) 1460 il_jmax=td_var%t_dim(2)%i_len - td_dom%i_jextra(2)*id_rho(jp_J) 1461 1462 td_var%t_dim(1)%i_len=td_var%t_dim(1)%i_len-il_iextra 1463 td_var%t_dim(2)%i_len=td_var%t_dim(2)%i_len-il_jextra 1539 il_iextra=SUM(td_dom%i_iextra(:))*il_rho(jp_I) 1540 il_jextra=SUM(td_dom%i_jextra(:))*il_rho(jp_J) 1541 1542 il_ghost(:,:)=0 1543 IF( ll_coord )THEN 1544 il_ghost(:,:)=td_dom%i_ghost(:,:) 1545 ENDIF 1546 1547 IF( il_iextra >= td_var%t_dim(1)%i_len )THEN 1548 ! case one point size dimension 1549 SELECT CASE(td_dom%i_bdy) 1550 1551 CASE(jp_north,jp_east) 1552 1553 CALL logger_info("DOM DEL EXTRA: special case for north"//& 1554 & " or east boundary.") 1555 IF( td_dom%i_iextra(1) <= 0 )THEN 1556 il_imin= 1 1557 il_ghost(jp_I,1) = 0 1558 ELSE 1559 il_imin= 1 + (td_dom%i_iextra(1)-1)*il_rho(jp_I) + 1 & 1560 & - il_ghost(jp_I,1) 1561 ENDIF 1562 IF( td_dom%i_iextra(2) <= 0 )THEN; 1563 il_imax= td_var%t_dim(1)%i_len 1564 il_ghost(jp_I,2) = 0 1565 ELSE 1566 il_imax= td_var%t_dim(1)%i_len - & 1567 & td_dom%i_iextra(2)*il_rho(jp_I) & 1568 & + il_ghost(jp_I,2) 1569 ENDIF 1570 1571 CASE(jp_south,jp_west) 1572 1573 CALL logger_info("DOM DEL EXTRA: special case for south"//& 1574 & " or west boundary.") 1575 IF( td_dom%i_iextra(1) <= 0 )THEN 1576 il_imin= 1 1577 il_ghost(jp_I,1) = 0 1578 ELSE 1579 il_imin= 1 + td_dom%i_iextra(1)*il_rho(jp_I) & 1580 & - il_ghost(jp_I,1) 1581 ENDIF 1582 IF( td_dom%i_iextra(2) <= 0 )THEN 1583 il_imax= td_var%t_dim(1)%i_len 1584 il_ghost(jp_I,2) = 0 1585 ELSE 1586 il_imax= td_var%t_dim(1)%i_len - & 1587 & (td_dom%i_iextra(2)-1)*il_rho(jp_I) - 1 & 1588 & + il_ghost(jp_I,2) 1589 ENDIF 1590 1591 CASE DEFAULT 1592 1593 IF( MOD(il_iextra-td_var%t_dim(1)%i_len,2)==0 )THEN 1594 ! case one point size dimension with even refinment 1595 CALL logger_fatal("DOM DEL EXTRA: should have been"//& 1596 & "an impossible case: domain of "//& 1597 & " one point size and even refinment.") 1598 ELSE 1599 il_imin= 1 + & 1600 & (td_dom%i_iextra(1)-1)*il_rho(jp_I) + & 1601 & (il_rho(jp_I)-1)/2 + 1 & 1602 & - il_ghost(jp_I,1) 1603 il_imax= td_var%t_dim(1)%i_len - & 1604 & (td_dom%i_iextra(2)-1)*il_rho(jp_I) - & 1605 & (il_rho(jp_I)-1)/2 - 1 & 1606 & + il_ghost(jp_I,2) 1607 ENDIF 1608 1609 END SELECT 1610 1611 td_var%t_dim(1)%i_len = 1 + SUM(il_ghost(jp_I,:)) 1612 1613 ELSE 1614 ! general case 1615 il_imin=1 + td_dom%i_iextra(1)*il_rho(jp_I) & 1616 & - il_ghost(jp_I,1) 1617 il_imax=td_var%t_dim(1)%i_len - td_dom%i_iextra(2)*il_rho(jp_I) & 1618 & + il_ghost(jp_I,2) 1619 1620 td_var%t_dim(1)%i_len=td_var%t_dim(1)%i_len - il_iextra & 1621 & + SUM(il_ghost(jp_I,:)) 1622 ENDIF 1623 1624 IF( il_jextra >= td_var%t_dim(2)%i_len )THEN 1625 ! case one point size dimension 1626 SELECT CASE(td_dom%i_bdy) 1627 1628 CASE(jp_north,jp_east) 1629 1630 IF( td_dom%i_jextra(1) <= 0 )THEN 1631 il_jmin= 1 1632 il_ghost(jp_J,1) = 0 1633 ELSE 1634 il_jmin= 1 + (td_dom%i_jextra(1)-1)*il_rho(jp_J) + 1 & 1635 & - il_ghost(jp_J,1) 1636 ENDIF 1637 IF( td_dom%i_jextra(2) <= 0 )THEN 1638 il_jmax= td_var%t_dim(2)%i_len 1639 il_ghost(jp_J,2) = 0 1640 ELSE 1641 il_jmax= td_var%t_dim(2)%i_len - & 1642 & td_dom%i_jextra(2)*il_rho(jp_J) & 1643 & + il_ghost(jp_J,2) 1644 ENDIF 1645 1646 CASE(jp_south,jp_west) 1647 1648 IF( td_dom%i_iextra(2) <= 0 )THEN 1649 il_jmin= 1 1650 il_ghost(jp_J,1) = 0 1651 ELSE 1652 il_jmin= 1 + td_dom%i_jextra(1)*il_rho(jp_J) & 1653 & - il_ghost(jp_J,1) 1654 ENDIF 1655 IF( td_dom%i_jextra(2) <= 0 )THEN 1656 il_jmax= td_var%t_dim(2)%i_len 1657 il_ghost(jp_J,2) = 0 1658 ELSE 1659 il_jmax= td_var%t_dim(2)%i_len - & 1660 & (td_dom%i_jextra(2)-1)*il_rho(jp_J) - 1 & 1661 & + il_ghost(jp_J,2) 1662 ENDIF 1663 1664 CASE DEFAULT 1665 1666 IF( MOD(il_jextra-td_var%t_dim(2)%i_len,2)==0 )THEN 1667 ! case one point size dimension with even refinment 1668 CALL logger_fatal("DOM DEL EXTRA: should have been"//& 1669 & "an impossible case: domain of "//& 1670 & " one point size and even refinment.") 1671 ELSE 1672 il_jmin= 1 + & 1673 & (td_dom%i_jextra(1)-1)*il_rho(jp_J) + & 1674 & (il_rho(jp_J)-1)/2 + 1 & 1675 & - il_ghost(jp_J,1) 1676 il_jmax= td_var%t_dim(2)%i_len - & 1677 & (td_dom%i_jextra(2)-1)*il_rho(jp_J) - & 1678 & (il_rho(jp_J)-1)/2 - 1 & 1679 & + il_ghost(jp_J,2) 1680 ENDIF 1681 1682 END SELECT 1683 1684 td_var%t_dim(2)%i_len = 1 + SUM(il_ghost(jp_J,:)) 1685 1686 ELSE 1687 ! general case 1688 il_jmin=1 + td_dom%i_jextra(1)*il_rho(jp_J) & 1689 & - il_ghost(jp_J,1) 1690 il_jmax=td_var%t_dim(2)%i_len - td_dom%i_jextra(2)*il_rho(jp_J) & 1691 & + il_ghost(jp_J,2) 1692 1693 td_var%t_dim(2)%i_len= td_var%t_dim(2)%i_len - il_jextra & 1694 & + SUM(il_ghost(jp_J,:)) 1695 ENDIF 1464 1696 1465 1697 DEALLOCATE(td_var%d_value) … … 1478 1710 1479 1711 END SUBROUTINE dom_del_extra 1480 !> @endcode1481 1712 !------------------------------------------------------------------- 1482 1713 !> @brief 1483 !> This subroutine clean mpp strcuture. 1484 ! 1485 !> @author J.Paul 1486 !> @date Nov, 2013 1487 ! 1488 !> @param[inout] td_dom : domain strcuture 1489 !------------------------------------------------------------------- 1490 !> @code 1714 !> This subroutine clean domain structure. 1715 ! 1716 !> @author J.Paul 1717 !> @date November, 2013 1718 ! 1719 !> @param[inout] td_dom domain strcuture 1720 !------------------------------------------------------------------- 1491 1721 SUBROUTINE dom_clean( td_dom ) 1492 1722 IMPLICIT NONE … … 1495 1725 1496 1726 ! local variable 1497 TYPE(TDOM) :: tl_dom ! empty filestructure1727 TYPE(TDOM) :: tl_dom ! empty dom structure 1498 1728 1499 1729 ! loop indices … … 1501 1731 !---------------------------------------------------------------- 1502 1732 1503 CALL logger_info( " CLEAN: reset domain " )1733 CALL logger_info( "DOM CLEAN: reset domain " ) 1504 1734 1505 1735 ! del dimension … … 1511 1741 td_dom=tl_dom 1512 1742 1513 1743 END SUBROUTINE dom_clean 1514 1744 END MODULE dom
Note: See TracChangeset
for help on using the changeset viewer.
