Changeset 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src/grid.f90
- Timestamp:
- 2015-05-12T12:37:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/TOOLS/SIREN/src/grid.f90
r4213 r5260 6 6 ! 7 7 ! DESCRIPTION: 8 !> @brief grid manager <br/>8 !> @brief This module is grid manager. 9 9 !> 10 10 !> @details 11 !> 11 !> to get NEMO pivot point index:<br/> 12 !> @code 13 !> il_pivot=grid_get_pivot(td_file) 14 !> @endcode 15 !> - il_pivot is NEMO pivot point index F(0), T(1) 16 !> - td_file is mpp structure 17 !> 18 !> to get NEMO periodicity index:<br/> 19 !> @code 20 !> il_perio=grid_get_perio(td_file) 21 !> @endcode 22 !> - il_perio is NEMO periodicity index (0,1,2,3,4,5,6) 23 !> - td_file is mpp structure 24 !> 25 !> to check domain validity:<br/> 26 !> @code 27 !> CALL grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax) 28 !> @endcode 29 !> - td_coord is coordinates mpp structure 30 !> - id_imin is i-direction lower left point indice 31 !> - id_imax is i-direction upper right point indice 32 !> - id_jmin is j-direction lower left point indice 33 !> - id_jmax is j-direction upper right point indice 34 !> 35 !> to get closest coarse grid indices of fine grid domain:<br/> 36 !> @code 37 !> il_index(:,:)=grid_get_coarse_index(td_coord0, td_coord1, 38 !> [id_rho,] [cd_point]) 39 !> @endcode 40 !> or 41 !> @code 42 !> il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_coord1, 43 !> [id_rho,] [cd_point]) 44 !> @endcode 45 !> or 46 !> @code 47 !> il_index(:,:)=grid_get_coarse_index(td_coord0, td_lon1, td_lat1, 48 !> [id_rho,] [cd_point]) 49 !> @endcode 50 !> or 51 !> @code 52 !> il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_lon1, td_lat1, 53 !> [id_rho,] [cd_point]) 54 !> @endcode 55 !> - il_index(:,:) is coarse grid indices (/ (/ imin0, imax0 /), 56 !> (/ jmin0, jmax0 /) /) 57 !> - td_coord0 is coarse grid coordinate mpp structure 58 !> - td_coord1 is fine grid coordinate mpp structure 59 !> - td_lon0 is coarse grid longitude variable structure 60 !> - td_lat0 is coarse grid latitude variable structure 61 !> - td_lon1 is fine grid longitude variable structure 62 !> - td_lat1 is fine grid latitude variable structure 63 !> - id_rho is array of refinment factor (default 1) 64 !> - cd_point is Arakawa grid point (default 'T') 65 !> 66 !> to know if grid is global:<br/> 67 !> @code 68 !> ll_global=grid_is_global(td_lon, td_lat) 69 !> @endcode 70 !> - td_lon is longitude variable structure 71 !> - td_lat is latitude variable structure 72 !> 73 !> to know if grid contains north fold:<br/> 74 !> @code 75 !> ll_north=grid_is_north_fold(td_lat) 76 !> @endcode 77 !> - td_lat is latitude variable structure 78 !> 79 !> to get coarse grid indices of the closest point from one fine grid 80 !> point:<br/> 81 !> @code 82 !> il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1) 83 !> @endcode 84 !> - il_index(:) is coarse grid indices (/ i0, j0 /) 85 !> - dd_lon0 is coarse grid array of longitude value (real(8)) 86 !> - dd_lat0 is coarse grid array of latitude value (real(8)) 87 !> - dd_lon1 is fine grid longitude value (real(8)) 88 !> - dd_lat1 is fine grid latitude value (real(8)) 89 !> 90 !> to compute distance between a point A and grid points:<br/> 91 !> @code 92 !> il_dist(:,:)=grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) 93 !> @endcode 94 !> - il_dist(:,:) is array of distance between point A and grid points 95 !> - dd_lon is array of longitude value (real(8)) 96 !> - dd_lat is array of longitude value (real(8)) 97 !> - dd_lonA is longitude of point A (real(8)) 98 !> - dd_latA is latitude of point A (real(8)) 99 !> 100 !> to get offset between fine grid and coarse grid:<br/> 101 !> @code 102 !> il_offset(:,:)=grid_get_fine_offset(td_coord0, 103 !> id_imin0, id_jmin0, id_imax0, id_jmax0, 104 !> td_coord1 105 !> [,id_rho] [,cd_point]) 106 !> @endcode 107 !> or 108 !> @code 109 !> il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0, 110 !> id_imin0, id_jmin0,id_imax0, id_jmax0, 111 !> td_coord1 112 !> [,id_rho] [,cd_point]) 113 !> @endcode 114 !> or 115 !> @code 116 !> il_offset(:,:)=grid_get_fine_offset(td_coord0, 117 !> id_imin0, id_jmin0, id_imax0, id_jmax0, 118 !> dd_lon1, dd_lat1 119 !> [,id_rho] [,cd_point]) 120 !> @endcode 121 !> or 122 !> @code 123 !> il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0, 124 !> id_imin0, id_jmin0, id_imax0, id_jmax0, 125 !> dd_lon1, dd_lat1 126 !> [,id_rho] [,cd_point]) 127 !> @endcode 128 !> - il_offset(:,:) is offset array 129 !> (/ (/ i_offset_left, i_offset_right /), (/ j_offset_lower, j_offset_upper /) /) 130 !> - td_coord0 is coarse grid coordinate mpp structure 131 !> - dd_lon0 is coarse grid longitude array (real(8)) 132 !> - dd_lat0 is coarse grid latitude array (real(8)) 133 !> - id_imin0 is coarse grid lower left corner i-indice of fine grid 134 !> domain 135 !> - id_jmin0 is coarse grid lower left corner j-indice of fine grid 136 !> domain 137 !> - id_imax0 is coarse grid upper right corner i-indice of fine grid 138 !> domain 139 !> - id_jmax0 is coarse grid upper right corner j-indice of fine grid 140 !> domain 141 !> - td_coord1 is fine grid coordinate mpp structure 142 !> - dd_lon1 is fine grid longitude array (real(8)) 143 !> - dd_lat1 is fine grid latitude array (real(8)) 144 !> - id_rho is array of refinment factor (default 1) 145 !> - cd_point is Arakawa grid point (default 'T') 146 !> 147 !> to check fine and coarse grid coincidence:<br/> 148 !> @code 149 !> CALL grid_check_coincidence(td_coord0, td_coord1, 150 !> id_imin0, id_imax0, id_jmin0, id_jmax0 151 !> [,id_rho]) 152 !> @endcode 153 !> - td_coord0 is coarse grid coordinate mpp structure 154 !> - td_coord1 is fine grid coordinate mpp structure 155 !> - id_imin0 is coarse grid lower left corner i-indice of fine grid 156 !> domain 157 !> - id_imax0 is coarse grid upper right corner i-indice of fine grid 158 !> domain 159 !> - id_jmin0 is coarse grid lower left corner j-indice of fine grid 160 !> domain 161 !> - id_jmax0 is coarse grid upper right corner j-indice of fine grid 162 !> domain 163 !> - id_rho is array of refinement factor (default 1) 164 !> 165 !> to add ghost cell at boundaries:<br/> 166 !> @code 167 !> CALL grid_add_ghost(td_var, id_ghost) 168 !> @endcode 169 !> - td_var is array of variable structure 170 !> - id_ghost is 2D array of ghost cell factor 171 !> 172 !> to delete ghost cell at boundaries:<br/> 173 !> @code 174 !> CALL grid_del_ghost(td_var, id_ghost) 175 !> @endcode 176 !> - td_var is array of variable structure 177 !> - id_ghost is 2D array of ghost cell factor 178 !> 179 !> to get ghost cell factor (use or not):<br/> 180 !> @code 181 !> il_factor(:)= grid_get_ghost( td_var ) 182 !> @endcode 183 !> or 184 !> @code 185 !> il_factor(:)= grid_get_ghost( td_mpp ) 186 !> @endcode 187 !> - il_factor(:) is array of ghost cell factor (0 or 1) 188 !> - td_var is variable structure 189 !> - td_mpp is mpp sturcture 190 !> 191 !> to compute closed sea domain:<br/> 192 !> @code 193 !> il_mask(:,:)=grid_split_domain(td_var, [id_level]) 194 !> @endcode 195 !> - il_mask(:,:) is domain mask 196 !> - td_var is variable strucutre 197 !> - id_level is level to be used [optional] 198 !> 199 !> to fill small closed sea with _FillValue:<br/> 200 !> @code 201 !> CALL grid_fill_small_dom(td_var, id_mask, [id_minsize]) 202 !> @endcode 203 !> - td_var is variable structure 204 !> - id_mask is domain mask (from grid_split_domain) 205 !> - id_minsize is minimum size of sea to be kept [optional] 206 !> 12 207 !> @author 13 208 !> J.Paul 14 209 ! REVISION HISTORY: 15 !> @date Nov, 2013 - Initial Version 210 !> @date November, 2013 - Initial Version 211 !> @date September, 2014 212 !> - add header 213 !> @date October, 2014 214 !> - use mpp file structure instead of file 16 215 ! 17 216 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 18 !> @todo19 217 !---------------------------------------------------------------------- 20 218 MODULE grid … … 24 222 USE global ! global parameter 25 223 USE phycst ! physical constant 26 USE logger 224 USE logger ! log file manager 27 225 USE file ! file manager 226 USE att ! attribute manager 28 227 USE var ! variable manager 29 228 USE dim ! dimension manager 30 USE dom ! domain manager31 229 USE iom ! I/O manager 32 230 USE mpp ! MPP manager 231 USE dom ! domain manager 33 232 USE iom_mpp ! MPP I/O manager 233 USE iom_dom ! DOM I/O manager 34 234 IMPLICIT NONE 35 PRIVATE36 235 ! NOTE_avoid_public_variables_if_possible 37 236 … … 39 238 40 239 ! function and subroutine 41 PUBLIC :: grid_check_dom !< check domain validity 42 PUBLIC :: grid_get_coarse_index !< get closest coarse grid indices of fine grid domain. 43 PUBLIC :: grid_is_global !< check if grid is global or not 44 PUBLIC :: grid_get_closest !< return closest coarse grid point from another point 45 PUBLIC :: grid_distance !< compute grid distance to a point 46 PUBLIC :: grid_get_fine_offset !< get fine grid offset 47 PUBLIC :: grid_check_coincidence !< check fine and coarse grid coincidence 48 PUBLIC :: grid_get_perio !< return NEMO periodicity index 49 PUBLIC :: grid_get_pivot !< return NEMO pivot point index 50 PUBLIC :: grid_add_ghost !< add ghost cell at boundaries. 51 PUBLIC :: grid_del_ghost !< delete ghost cell at boundaries. 52 PUBLIC :: grid_get_ghost !< return ghost cell factor 53 PUBLIC :: grid_split_domain !< 54 PUBLIC :: grid_fill_small_dom !< 55 56 PRIVATE :: grid_get_coarse_index_ff 57 PRIVATE :: grid_get_coarse_index_cf 58 PRIVATE :: grid_get_coarse_index_fc 59 PRIVATE :: grid_get_coarse_index_cc 60 PRIVATE :: grid__get_ghost_f 61 PRIVATE :: grid__get_ghost_ll 62 PRIVATE :: grid__check_corner 240 PUBLIC :: grid_get_info !< get information about mpp global domain (pivot, perio, ew) 241 PUBLIC :: grid_get_pivot !< get NEMO pivot point index 242 PUBLIC :: grid_get_perio !< get NEMO periodicity index 243 PUBLIC :: grid_get_ew_overlap !< get East West overlap 244 PUBLIC :: grid_check_dom !< check domain validity 245 PUBLIC :: grid_get_coarse_index !< get closest coarse grid indices of fine grid domain. 246 PUBLIC :: grid_is_global !< check if grid is global or not 247 PUBLIC :: grid_is_north_fold 248 PUBLIC :: grid_get_closest !< return closest coarse grid point from another point 249 PUBLIC :: grid_distance !< compute grid distance to a point 250 PUBLIC :: grid_get_fine_offset !< get fine grid offset 251 PUBLIC :: grid_check_coincidence !< check fine and coarse grid coincidence 252 PUBLIC :: grid_add_ghost !< add ghost cell at boundaries. 253 PUBLIC :: grid_del_ghost !< delete ghost cell at boundaries. 254 PUBLIC :: grid_get_ghost !< return ghost cell factor 255 PUBLIC :: grid_split_domain !< compute closed sea domain 256 PUBLIC :: grid_fill_small_dom !< fill small closed sea with fill value 257 258 ! get closest coarse grid indices of fine grid domain 259 PRIVATE :: grid__get_coarse_index_ff ! - using coarse and fine grid coordinates files 260 PRIVATE :: grid__get_coarse_index_cf ! - using coarse grid array of lon,lat and fine grid coordinates files 261 PRIVATE :: grid__get_coarse_index_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat 262 PRIVATE :: grid__get_coarse_index_cc ! - using coarse and fine grid array of lon,lat 263 264 ! get offset between fine and coarse grid 265 PRIVATE :: grid__get_fine_offset_ff ! - using coarse and fine grid coordinates files 266 PRIVATE :: grid__get_fine_offset_cf ! - using coarse grid array of lon,lat and fine grid coordinates files 267 PRIVATE :: grid__get_fine_offset_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat 268 PRIVATE :: grid__get_fine_offset_cc ! - using coarse and fine grid array of lon,lat 269 270 ! get information about global domain (pivot, perio, ew) 271 PRIVATE :: grid__get_info_mpp ! - using mpp files structure 272 PRIVATE :: grid__get_info_file ! - using files structure 273 274 ! get NEMO pivot point index 275 PRIVATE :: grid__get_pivot_mpp ! - using mpp files structure 276 PRIVATE :: grid__get_pivot_file ! - using files structure 277 PRIVATE :: grid__get_pivot_var ! - using variable structure 278 PRIVATE :: grid__get_pivot_varT ! compute NEMO pivot point index for variable on grid T 279 PRIVATE :: grid__get_pivot_varU ! compute NEMO pivot point index for variable on grid U 280 PRIVATE :: grid__get_pivot_varV ! compute NEMO pivot point index for variable on grid V 281 PRIVATE :: grid__get_pivot_varF ! compute NEMO pivot point index for variable on grid F 282 283 ! get NEMO periodicity index 284 PRIVATE :: grid__get_perio_mpp ! - using mpp files structure 285 PRIVATE :: grid__get_perio_file ! - using files structure 286 PRIVATE :: grid__get_perio_var ! - using variable structure 287 288 ! get East West overlap 289 PRIVATE :: grid__get_ew_overlap_mpp ! - using mpp files structure 290 PRIVATE :: grid__get_ew_overlap_file ! - using files structure 291 PRIVATE :: grid__get_ew_overlap_var ! - using longitude variable structure 292 293 ! return ghost cell factor 294 PRIVATE :: grid__get_ghost_mpp ! - using mpp files structure 295 PRIVATE :: grid__get_ghost_var ! - using array of lon,lat 296 PRIVATE :: grid__check_corner ! check that fine grid is inside coarse grid 297 PRIVATE :: grid__check_lat ! check that fine grid latitude are inside coarse grid latitude 63 298 299 INTERFACE grid_get_info 300 MODULE PROCEDURE grid__get_info_mpp 301 MODULE PROCEDURE grid__get_info_file 302 END INTERFACE grid_get_info 303 304 INTERFACE grid_get_pivot 305 MODULE PROCEDURE grid__get_pivot_mpp 306 MODULE PROCEDURE grid__get_pivot_file 307 MODULE PROCEDURE grid__get_pivot_var 308 END INTERFACE grid_get_pivot 309 310 INTERFACE grid_get_perio 311 MODULE PROCEDURE grid__get_perio_mpp 312 MODULE PROCEDURE grid__get_perio_file 313 MODULE PROCEDURE grid__get_perio_var 314 END INTERFACE grid_get_perio 315 316 INTERFACE grid_get_ew_overlap 317 MODULE PROCEDURE grid__get_ew_overlap_mpp 318 MODULE PROCEDURE grid__get_ew_overlap_file 319 MODULE PROCEDURE grid__get_ew_overlap_var 320 END INTERFACE grid_get_ew_overlap 321 64 322 INTERFACE grid_get_ghost 65 MODULE PROCEDURE grid__get_ghost_ ll66 MODULE PROCEDURE grid__get_ghost_ f323 MODULE PROCEDURE grid__get_ghost_var 324 MODULE PROCEDURE grid__get_ghost_mpp 67 325 END INTERFACE grid_get_ghost 68 326 69 327 INTERFACE grid_get_coarse_index 70 MODULE PROCEDURE grid_ get_coarse_index_ff71 MODULE PROCEDURE grid_ get_coarse_index_cf72 MODULE PROCEDURE grid_ get_coarse_index_fc73 MODULE PROCEDURE grid_ get_coarse_index_cc328 MODULE PROCEDURE grid__get_coarse_index_ff 329 MODULE PROCEDURE grid__get_coarse_index_cf 330 MODULE PROCEDURE grid__get_coarse_index_fc 331 MODULE PROCEDURE grid__get_coarse_index_cc 74 332 END INTERFACE grid_get_coarse_index 75 333 334 INTERFACE grid_get_fine_offset 335 MODULE PROCEDURE grid__get_fine_offset_ff 336 MODULE PROCEDURE grid__get_fine_offset_fc 337 MODULE PROCEDURE grid__get_fine_offset_cf 338 MODULE PROCEDURE grid__get_fine_offset_cc 339 END INTERFACE grid_get_fine_offset 340 76 341 CONTAINS 77 342 !------------------------------------------------------------------- 343 !> @brief This subroutine get information about global domain, given file 344 !> strucutre. 345 !> 346 !> @details 347 !> open edge files then: 348 !> - compute NEMO pivot point 349 !> - compute NEMO periodicity 350 !> - compute East West overlap 351 !> 352 !> @note need all processor files to be there 353 !> @author J.Paul 354 !> - October, 2014- Initial Version 355 !> 356 !> @param[inout] td_file file structure 357 !------------------------------------------------------------------- 358 SUBROUTINE grid__get_info_file(td_file) 359 IMPLICIT NONE 360 ! Argument 361 TYPE(TFILE), INTENT(INOUT) :: td_file 362 363 ! local variable 364 INTEGER(i4) :: il_ew 365 INTEGER(i4) :: il_pivot 366 INTEGER(i4) :: il_perio 367 INTEGER(i4) :: il_attid 368 369 TYPE(TATT) :: tl_att 370 371 TYPE(TFILE) :: tl_file 372 373 ! loop indices 374 INTEGER(i4) :: ji 375 !---------------------------------------------------------------- 376 ! intialise 377 il_pivot=-1 378 il_perio=-1 379 il_ew =-1 380 381 ! copy structure 382 tl_file=file_copy(td_file) 383 384 ! open file to be used 385 CALL iom_open(tl_file) 386 387 IF( td_file%i_perio >= 0 .AND. td_file%i_perio <= 6 )THEN 388 il_perio=td_file%i_perio 389 ELSE 390 ! look for attribute in file 391 il_attid=att_get_index(tl_file%t_att(:),'periodicity') 392 IF( il_attid /= 0 )THEN 393 il_perio=INT(tl_file%t_att(il_attid)%d_value(1),i4) 394 ENDIF 395 ENDIF 396 397 IF( td_file%i_ew >= 0 )THEN 398 il_ew=td_file%i_ew 399 ELSE 400 ! look for attribute in file 401 il_attid=att_get_index(tl_file%t_att(:),'ew_overlap') 402 IF( il_attid /= 0 )THEN 403 il_ew=INT(tl_file%t_att(il_attid)%d_value(1),i4) 404 ENDIF 405 ENDIF 406 407 SELECT CASE(il_perio) 408 CASE(3,4) 409 il_pivot=0 410 CASE(5,6) 411 il_pivot=1 412 CASE(0,1,2) 413 il_pivot=1 414 END SELECT 415 416 IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 417 ! get pivot 418 il_pivot=grid_get_pivot(tl_file) 419 ENDIF 420 421 IF( il_perio < 0 .OR. il_perio > 6 )THEN 422 ! get periodicity 423 il_perio=grid_get_perio(tl_file, il_pivot) 424 ENDIF 425 426 IF( il_ew < 0 )THEN 427 ! get periodicity 428 il_ew=grid_get_ew_overlap(tl_file) 429 ENDIF 430 431 ! close 432 CALL iom_close(tl_file) 433 434 !save in file structure 435 td_file%i_ew=il_ew 436 td_file%i_pivot=il_pivot 437 td_file%i_perio=il_perio 438 439 ! save in variable of file structure 440 tl_att=att_init("ew_overlap",il_ew) 441 DO ji=1,td_file%i_nvar 442 IF( td_file%t_var(ji)%t_dim(jp_I)%l_use )THEN 443 CALL var_move_att(td_file%t_var(ji),tl_att) 444 ENDIF 445 ENDDO 446 447 ! clean 448 CALL file_clean(tl_file) 449 CALL att_clean(tl_att) 450 451 IF( td_file%i_perio == -1 )THEN 452 CALL logger_fatal("GRID GET INFO: can not read or compute "//& 453 & "domain periodicity from file "//TRIM(td_file%c_name)//"."//& 454 & " you have to inform periodicity in namelist.") 455 ENDIF 456 457 END SUBROUTINE grid__get_info_file 458 !------------------------------------------------------------------- 459 !> @brief This subroutine get information about global domain, given mpp 460 !> strucutre. 461 !> 462 !> @details 463 !> open edge files then: 464 !> - compute NEMO pivot point 465 !> - compute NEMO periodicity 466 !> - compute East West overlap 467 !> 468 !> @note need all processor files to be there 469 !> @author J.Paul 470 !> - October, 2014- Initial Version 471 !> 472 !> @param[in] td_mpp mpp structure 473 !------------------------------------------------------------------- 474 SUBROUTINE grid__get_info_mpp(td_mpp) 475 IMPLICIT NONE 476 ! Argument 477 TYPE(TMPP) , INTENT(INOUT) :: td_mpp 478 479 ! local variable 480 INTEGER(i4) :: il_ew 481 INTEGER(i4) :: il_pivot 482 INTEGER(i4) :: il_perio 483 INTEGER(i4) :: il_attid 484 485 TYPE(TATT) :: tl_att 486 487 TYPE(TMPP) :: tl_mpp 488 489 ! loop indices 490 INTEGER(i4) :: ji 491 INTEGER(i4) :: jj 492 !---------------------------------------------------------------- 493 ! intialise 494 il_pivot=-1 495 il_perio=-1 496 il_ew =-1 497 498 ! copy structure 499 tl_mpp=mpp_copy(td_mpp) 500 ! select edge files 501 CALL mpp_get_contour(tl_mpp) 502 ! open mpp file to be used 503 CALL iom_mpp_open(tl_mpp) 504 505 IF( td_mpp%i_perio >= 0 .AND. td_mpp%i_perio <= 6 )THEN 506 il_perio=td_mpp%i_perio 507 ELSE 508 ! look for attribute in mpp files 509 il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'periodicity') 510 IF( il_attid /= 0 )THEN 511 il_perio=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4) 512 ENDIF 513 ENDIF 514 515 IF( td_mpp%i_ew >= 0 )THEN 516 il_ew=td_mpp%i_ew 517 ELSE 518 ! look for attribute in mpp files 519 il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'ew_overlap') 520 IF( il_attid /= 0 )THEN 521 il_ew=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4) 522 ENDIF 523 ENDIF 524 525 SELECT CASE(il_perio) 526 CASE(3,4) 527 il_pivot=0 528 CASE(5,6) 529 il_pivot=1 530 CASE(0,1,2) 531 il_pivot=1 532 END SELECT 533 534 IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 535 ! get pivot 536 il_pivot=grid_get_pivot(tl_mpp) 537 ENDIF 538 539 IF( il_perio < 0 .OR. il_perio > 6 )THEN 540 ! get periodicity 541 il_perio=grid_get_perio(tl_mpp, il_pivot) 542 ENDIF 543 544 IF( il_ew < 0 )THEN 545 ! get periodicity 546 il_ew=grid_get_ew_overlap(tl_mpp) 547 ENDIF 548 549 ! close 550 CALL iom_mpp_close(tl_mpp) 551 552 !save in mpp structure 553 td_mpp%i_ew=il_ew 554 td_mpp%i_pivot=il_pivot 555 td_mpp%i_perio=il_perio 556 557 ! save in variable of mpp structure 558 IF( ASSOCIATED(td_mpp%t_proc) )THEN 559 tl_att=att_init("ew_overlap",il_ew) 560 DO jj=1,td_mpp%i_nproc 561 DO ji=1,td_mpp%t_proc(jj)%i_nvar 562 IF( td_mpp%t_proc(jj)%t_var(ji)%t_dim(jp_I)%l_use )THEN 563 CALL var_move_att(td_mpp%t_proc(jj)%t_var(ji),tl_att) 564 ENDIF 565 ENDDO 566 ENDDO 567 ENDIF 568 569 ! clean 570 CALL mpp_clean(tl_mpp) 571 CALL att_clean(tl_att) 572 573 IF( td_mpp%i_perio == -1 )THEN 574 CALL logger_fatal("GRID GET INFO: can not read or compute "//& 575 & "domain periodicity from mpp "//TRIM(td_mpp%c_name)//"."//& 576 & " you have to inform periodicity in namelist.") 577 ENDIF 578 579 END SUBROUTINE grid__get_info_mpp 580 !------------------------------------------------------------------- 78 581 !> @brief 79 !> This fun tion returnNEMO pivot point index of the input variable.582 !> This function compute NEMO pivot point index of the input variable. 80 583 !> - F-point : 0 81 584 !> - T-point : 1 82 585 !> 586 !> @details 587 !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point 588 !> (T,F,U,V) variable is defined 589 !> 590 !> @note variable must be at least 2D variable, and should not be coordinate 591 !> variable (i.e lon, lat) 592 !> 83 593 !> @warning 84 !> - variable must be nav_lon or nav_lat85 594 !> - do not work with ORCA2 grid (T-point) 86 595 !> 87 596 !> @author J.Paul 88 !> - Nov , 2013- Subroutine written89 ! 90 !> @todo91 !> - improve check between T or F pivot.92 ! 93 ! > @param[in] td_file : file structure94 !> @param[in] cd_varname : variable name95 !> @ return NEMO pivot point index96 ! -------------------------------------------------------------------97 ! > @code98 INTEGER(i4) FUNCTION grid_get_pivot(td_file)597 !> - November, 2013- Subroutine written 598 !> @date September, 2014 599 !> - add dummy loop in case variable not over right point. 600 !> @date October, 2014 601 !> - work on variable structure instead of file structure 602 ! 603 !> @param[in] td_lat latitude variable structure 604 !> @param[in] td_var variable structure 605 !> @return pivot point index 606 !------------------------------------------------------------------- 607 FUNCTION grid__get_pivot_var(td_var) 99 608 IMPLICIT NONE 100 609 ! Argument 101 TYPE(TFILE), INTENT(IN) :: td_file 610 TYPE(TVAR), INTENT(IN) :: td_var 611 612 ! function 613 INTEGER(i4) :: grid__get_pivot_var 102 614 103 615 ! local variable 104 TYPE(TVAR) :: tl_var 616 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 617 618 REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 619 620 ! loop indices 621 INTEGER(i4) :: jj 622 !---------------------------------------------------------------- 623 ! intitalise 624 grid__get_pivot_var=-1 625 626 IF( .NOT. ASSOCIATED(td_var%d_value) .OR. & 627 & .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN 628 CALL logger_error("GRID GET PIVOT: can not compute pivot point"//& 629 & " with variable "//TRIM(td_var%c_name)//"."//& 630 & " no value associated or missing dimension.") 631 ELSE 632 il_dim(:)=td_var%t_dim(:)%i_len 633 634 ALLOCATE(dl_value(il_dim(1),4,1,1)) 635 ! extract value 636 dl_value(:,:,:,:)=td_var%d_value( 1:il_dim(1), & 637 & il_dim(2)-3:il_dim(2),& 638 & 1:1, & 639 & 1:1 ) 640 641 SELECT CASE(TRIM(td_var%c_point)) 642 CASE('T') 643 grid__get_pivot_var=grid__get_pivot_varT(dl_value) 644 CASE('U') 645 grid__get_pivot_var=grid__get_pivot_varU(dl_value) 646 CASE('V') 647 grid__get_pivot_var=grid__get_pivot_varV(dl_value) 648 CASE('F') 649 grid__get_pivot_var=grid__get_pivot_varF(dl_value) 650 END SELECT 651 652 ! dummy loop in case variable not over right point 653 ! (ex: nav_lon over U-point) 654 IF( grid__get_pivot_var == -1 )THEN 655 656 ! no pivot point found 657 CALL logger_error("GRID GET PIVOT: something wrong "//& 658 & "when computing pivot point with variable "//& 659 & TRIM(td_var%c_name)) 660 661 DO jj=1,ip_npoint 662 SELECT CASE(TRIM(cp_grid_point(jj))) 663 CASE('T') 664 CALL logger_debug("GRID GET PIVOT: check variable on point T") 665 grid__get_pivot_var=grid__get_pivot_varT(dl_value) 666 CASE('U') 667 CALL logger_debug("GRID GET PIVOT: check variable on point U") 668 grid__get_pivot_var=grid__get_pivot_varU(dl_value) 669 CASE('V') 670 CALL logger_debug("GRID GET PIVOT: check variable on point V") 671 grid__get_pivot_var=grid__get_pivot_varV(dl_value) 672 CASE('F') 673 CALL logger_debug("GRID GET PIVOT: check variable on point F") 674 grid__get_pivot_var=grid__get_pivot_varF(dl_value) 675 END SELECT 676 677 IF( grid__get_pivot_var /= -1 )THEN 678 CALL logger_warn("GRID GET PIVOT: variable "//& 679 & TRIM(td_var%c_name)//" seems to be on grid point "//& 680 & TRIM(cp_grid_point(jj)) ) 681 EXIT 682 ENDIF 683 684 ENDDO 685 ENDIF 686 687 IF( grid__get_pivot_var == -1 )THEN 688 CALL logger_warn("GRID GET PIVOT: not able to found pivot point. "//& 689 & "Force to use pivot point T.") 690 grid__get_pivot_var = 1 691 ENDIF 692 693 ! clean 694 DEALLOCATE(dl_value) 695 696 ENDIF 697 698 END FUNCTION grid__get_pivot_var 699 !------------------------------------------------------------------- 700 !> @brief 701 !> This function compute NEMO pivot point index for variable on grid T. 702 !> 703 !> @details 704 !> - F-point : 0 705 !> - T-point : 1 706 !> 707 !> @note array of value must be only the top border of the domain. 708 !> 709 !> @author J.Paul 710 !> - October, 2014 - Initial version 711 ! 712 !> @param[in] dd_value array of value 713 !> @return pivot point index 714 !------------------------------------------------------------------- 715 FUNCTION grid__get_pivot_varT(dd_value) 716 IMPLICIT NONE 717 ! Argument 718 REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 719 720 ! function 721 INTEGER(i4) :: grid__get_pivot_varT 722 723 ! local variable 724 INTEGER(i4) :: il_midT 725 INTEGER(i4) :: il_midF 726 727 INTEGER(i4) :: it1 728 INTEGER(i4) :: it2 729 INTEGER(i4) :: jt1 730 INTEGER(i4) :: jt2 731 732 INTEGER(i4) :: if1 733 INTEGER(i4) :: if2 734 INTEGER(i4) :: jf1 735 INTEGER(i4) :: jf2 736 737 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 738 739 LOGICAL :: ll_check 740 741 ! loop indices 742 INTEGER(i4) :: ji 743 !---------------------------------------------------------------- 744 ! intitalise 745 grid__get_pivot_varT=-1 746 747 il_dim(:)=SHAPE(dd_value(:,:,:,:)) 748 749 ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 750 jt1=4 ; jt2=2 751 il_midT=il_dim(1)/2+1 752 753 ! F-point pivot !case of ORCA05 grid 754 jf1=4 ; jf2=3 755 il_midF=il_dim(1)/2 756 757 ! check T-point pivot 758 DO ji=2,il_midT 759 ll_check=.TRUE. 760 it1=ji 761 it2=il_dim(1)-(ji-2) 762 IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2,1,1) )THEN 763 ll_check=.FALSE. 764 EXIT 765 ENDIF 766 ENDDO 767 768 IF( ll_check )THEN 769 CALL logger_info("GRID GET PIVOT: T-pivot") 770 grid__get_pivot_varT=1 771 ELSE 772 773 ! check F-point pivot 774 DO ji=1,il_midF 775 ll_check=.TRUE. 776 if1=ji 777 if2=il_dim(1)-(ji-1) 778 IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2,1,1) )THEN 779 ll_check=.FALSE. 780 EXIT 781 ENDIF 782 ENDDO 783 784 IF( ll_check )THEN 785 CALL logger_info("GRID GET PIVOT: T-pivot") 786 grid__get_pivot_varT=0 787 ENDIF 788 789 ENDIF 790 791 END FUNCTION grid__get_pivot_varT 792 !------------------------------------------------------------------- 793 !> @brief 794 !> This function compute NEMO pivot point index for variable on grid U. 795 !> 796 !> @details 797 !> - F-point : 0 798 !> - T-point : 1 799 !> 800 !> @note array of value must be only the top border of the domain. 801 !> 802 !> @author J.Paul 803 !> - October, 2014 - Initial version 804 ! 805 !> @param[in] dd_value array of value 806 !> @return pivot point index 807 !------------------------------------------------------------------- 808 FUNCTION grid__get_pivot_varU(dd_value) 809 IMPLICIT NONE 810 ! Argument 811 REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 812 813 ! function 814 INTEGER(i4) :: grid__get_pivot_varU 815 816 ! local variable 817 INTEGER(i4) :: il_midT 818 INTEGER(i4) :: il_midF 819 820 INTEGER(i4) :: it1 821 INTEGER(i4) :: it2 822 INTEGER(i4) :: jt1 823 INTEGER(i4) :: jt2 824 825 INTEGER(i4) :: if1 826 INTEGER(i4) :: if2 827 INTEGER(i4) :: jf1 828 INTEGER(i4) :: jf2 829 830 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 831 832 LOGICAL :: ll_check 833 834 ! loop indices 835 INTEGER(i4) :: ji 836 !---------------------------------------------------------------- 837 ! intitalise 838 grid__get_pivot_varU=-1 839 840 il_dim(:)=SHAPE(dd_value(:,:,:,:)) 841 842 ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 843 jt1=4 ; jt2=2 844 il_midT=il_dim(1)/2+1 845 846 ! F-point pivot !case of ORCA05 grid 847 jf1=4 ; jf2=3 848 il_midF=il_dim(1)/2 849 850 ! check T-point pivot 851 DO ji=1,il_midT 852 ll_check=.TRUE. 853 it1=ji 854 it2=il_dim(1)-(ji-2) 855 IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2,1,1) )THEN 856 ll_check=.FALSE. 857 EXIT 858 ENDIF 859 ENDDO 860 861 IF( ll_check )THEN 862 CALL logger_info("GRID GET PIVOT: T-pivot") 863 grid__get_pivot_varU=1 864 ELSE 865 866 ! check F-point pivot 867 DO ji=1,il_midF 868 ll_check=.TRUE. 869 if1=ji 870 if2=il_dim(1)-(ji-1) 871 IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2,1,1) )THEN 872 ll_check=.FALSE. 873 EXIT 874 ENDIF 875 ENDDO 876 877 IF( ll_check )THEN 878 CALL logger_info("GRID GET PIVOT: T-pivot") 879 grid__get_pivot_varU=0 880 ENDIF 881 882 ENDIF 883 884 END FUNCTION grid__get_pivot_varU 885 !------------------------------------------------------------------- 886 !> @brief 887 !> This function compute NEMO pivot point index for variable on grid V. 888 !> 889 !> @details 890 !> - F-point : 0 891 !> - T-point : 1 892 !> 893 !> @note array of value must be only the top border of the domain. 894 !> 895 !> @author J.Paul 896 !> - October, 2014 - Initial version 897 ! 898 !> @param[in] dd_value array of value 899 !> @return pivot point index 900 !------------------------------------------------------------------- 901 FUNCTION grid__get_pivot_varV(dd_value) 902 IMPLICIT NONE 903 ! Argument 904 REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 905 906 ! function 907 INTEGER(i4) :: grid__get_pivot_varV 908 909 ! local variable 910 INTEGER(i4) :: il_midT 911 INTEGER(i4) :: il_midF 912 913 INTEGER(i4) :: it1 914 INTEGER(i4) :: it2 915 INTEGER(i4) :: jt1 916 INTEGER(i4) :: jt2 917 918 INTEGER(i4) :: if1 919 INTEGER(i4) :: if2 920 INTEGER(i4) :: jf1 921 INTEGER(i4) :: jf2 922 923 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 924 925 LOGICAL :: ll_check 926 927 ! loop indices 928 INTEGER(i4) :: ji 929 !---------------------------------------------------------------- 930 ! intitalise 931 grid__get_pivot_varV=-1 932 933 il_dim(:)=SHAPE(dd_value(:,:,:,:)) 934 935 ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 936 jt1=4 ; jt2=2 937 il_midT=il_dim(1)/2+1 938 939 ! F-point pivot !case of ORCA05 grid 940 jf1=4 ; jf2=3 941 il_midF=il_dim(1)/2 942 943 ! check T-point pivot 944 DO ji=2,il_midT 945 ll_check=.TRUE. 946 it1=ji 947 it2=il_dim(1)-(ji-2) 948 IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2-1,1,1) )THEN 949 ll_check=.FALSE. 950 EXIT 951 ENDIF 952 ENDDO 953 954 IF( ll_check )THEN 955 CALL logger_info("GRID GET PIVOT: T-pivot") 956 grid__get_pivot_varV=1 957 ELSE 958 959 ! check F-point pivot 960 DO ji=1,il_midF 961 ll_check=.TRUE. 962 if1=ji 963 if2=il_dim(1)-(ji-1) 964 IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2-1,1,1) )THEN 965 ll_check=.FALSE. 966 EXIT 967 ENDIF 968 ENDDO 969 970 IF( ll_check )THEN 971 CALL logger_info("GRID GET PIVOT: T-pivot") 972 grid__get_pivot_varV=0 973 ENDIF 974 975 ENDIF 976 977 END FUNCTION grid__get_pivot_varV 978 !------------------------------------------------------------------- 979 !> @brief 980 !> This function compute NEMO pivot point index for variable on grid F. 981 !> 982 !> @details 983 !> - F-point : 0 984 !> - T-point : 1 985 !> 986 !> @note array of value must be only the top border of the domain. 987 !> 988 !> @author J.Paul 989 !> - October, 2014 - Initial version 990 ! 991 !> @param[in] dd_value array of value 992 !> @return pivot point index 993 !------------------------------------------------------------------- 994 FUNCTION grid__get_pivot_varF(dd_value) 995 IMPLICIT NONE 996 ! Argument 997 REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 998 999 ! function 1000 INTEGER(i4) :: grid__get_pivot_varF 1001 1002 ! local variable 1003 INTEGER(i4) :: il_midT 1004 INTEGER(i4) :: il_midF 1005 1006 INTEGER(i4) :: it1 1007 INTEGER(i4) :: it2 1008 INTEGER(i4) :: jt1 1009 INTEGER(i4) :: jt2 1010 1011 INTEGER(i4) :: if1 1012 INTEGER(i4) :: if2 1013 INTEGER(i4) :: jf1 1014 INTEGER(i4) :: jf2 1015 1016 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 1017 1018 LOGICAL :: ll_check 1019 1020 ! loop indices 1021 INTEGER(i4) :: ji 1022 !---------------------------------------------------------------- 1023 ! intitalise 1024 grid__get_pivot_varF=-1 1025 1026 il_dim(:)=SHAPE(dd_value(:,:,:,:)) 1027 1028 ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 1029 jt1=4 ; jt2=2 1030 il_midT=il_dim(1)/2+1 1031 1032 ! F-point pivot !case of ORCA05 grid 1033 jf1=4 ; jf2=3 1034 il_midF=il_dim(1)/2 1035 1036 ! check T-point pivot 1037 DO ji=1,il_midT 1038 ll_check=.TRUE. 1039 it1=ji 1040 it2=il_dim(1)-(ji-2) 1041 IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2-1,1,1) )THEN 1042 ll_check=.FALSE. 1043 EXIT 1044 ENDIF 1045 ENDDO 1046 1047 IF( ll_check )THEN 1048 CALL logger_info("GRID GET PIVOT: T-pivot") 1049 grid__get_pivot_varF=1 1050 ELSE 1051 1052 ! check F-point pivot 1053 DO ji=1,il_midF 1054 ll_check=.TRUE. 1055 if1=ji 1056 if2=il_dim(1)-(ji-1) 1057 IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2-1,1,1) )THEN 1058 ll_check=.FALSE. 1059 EXIT 1060 ENDIF 1061 ENDDO 1062 1063 IF( ll_check )THEN 1064 CALL logger_info("GRID GET PIVOT: T-pivot") 1065 grid__get_pivot_varF=0 1066 ENDIF 1067 1068 ENDIF 1069 1070 END FUNCTION grid__get_pivot_varF 1071 !------------------------------------------------------------------- 1072 !> @brief 1073 !> This function compute NEMO pivot point index from input file variable. 1074 !> - F-point : 0 1075 !> - T-point : 1 1076 !> 1077 !> @details 1078 !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point 1079 !> (T,F,U,V) variable is defined 1080 !> 1081 !> @warning 1082 !> - do not work with ORCA2 grid (T-point) 1083 !> 1084 !> @author J.Paul 1085 !> - Ocotber, 2014- Initial version 1086 ! 1087 !> @param[in] td_file file structure 1088 !> @return pivot point index 1089 !------------------------------------------------------------------- 1090 FUNCTION grid__get_pivot_file(td_file) 1091 IMPLICIT NONE 1092 ! Argument 1093 TYPE(TFILE), INTENT(IN) :: td_file 1094 1095 ! function 1096 INTEGER(i4) :: grid__get_pivot_file 1097 1098 ! local variable 105 1099 INTEGER(i4) :: il_varid 106 1100 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 107 1101 1102 LOGICAL :: ll_north 1103 1104 TYPE(TVAR) :: tl_var 1105 TYPE(TVAR) :: tl_lat 1106 108 1107 ! loop indices 109 1108 INTEGER(i4) :: ji 110 111 INTEGER(i4) :: it1112 INTEGER(i4) :: it2113 INTEGER(i4) :: jt1114 INTEGER(i4) :: jt2115 116 INTEGER(i4) :: if1117 INTEGER(i4) :: if2118 INTEGER(i4) :: jf1119 INTEGER(i4) :: jf2120 1109 !---------------------------------------------------------------- 121 ! initialise 122 grid_get_pivot=-1 1110 ! intitalise 1111 grid__get_pivot_file=-1 1112 1113 ! look for north fold 1114 il_varid=var_get_index(td_file%t_var(:), 'latitude') 1115 IF( il_varid == 0 )THEN 1116 CALL logger_error("GRID GET PIVOT: no variable with name "//& 1117 & "or standard name latitude in file structure "//& 1118 & TRIM(td_file%c_name)) 1119 ENDIF 1120 IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN 1121 tl_lat=var_copy(td_file%t_var(il_varid)) 1122 ELSE 1123 tl_lat=iom_read_var(td_file, 'latitude') 1124 ENDIF 1125 1126 ll_north=grid_is_north_fold(tl_lat) 1127 ! clean 1128 CALL var_clean(tl_lat) 1129 1130 IF( ll_north )THEN 1131 ! look for suitable variable 1132 DO ji=1,td_file%i_nvar 1133 IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 1134 1135 IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN 1136 tl_var=var_copy(td_file%t_var(ji)) 1137 ELSE 1138 il_dim(:)=td_file%t_var(ji)%t_dim(:)%i_len 1139 tl_var=iom_read_var(td_file, & 1140 & td_file%t_var(ji)%c_name, & 1141 & id_start=(/1,il_dim(2)-3,1,1/), & 1142 & id_count=(/il_dim(1),4,1,1/) ) 1143 ENDIF 1144 ENDDO 1145 1146 IF( ASSOCIATED(tl_var%d_value) )THEN 1147 1148 grid__get_pivot_file=grid_get_pivot(tl_var) 1149 1150 ENDIF 1151 1152 ! clean 1153 CALL var_clean(tl_var) 1154 ELSE 1155 CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT") 1156 grid__get_pivot_file=1 1157 ENDIF 1158 1159 END FUNCTION grid__get_pivot_file 1160 !------------------------------------------------------------------- 1161 !> @brief 1162 !> This function compute NEMO pivot point index from input mpp variable. 1163 !> - F-point : 0 1164 !> - T-point : 1 1165 !> 1166 !> @details 1167 !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point 1168 !> (T,F,U,V) variable is defined 1169 !> 1170 !> @warning 1171 !> - do not work with ORCA2 grid (T-point) 1172 !> 1173 !> @author J.Paul 1174 !> - October, 2014 - Initial version 1175 ! 1176 !> @param[in] td_mpp mpp file structure 1177 !> @return pivot point index 1178 !------------------------------------------------------------------- 1179 FUNCTION grid__get_pivot_mpp(td_mpp) 1180 IMPLICIT NONE 1181 ! Argument 1182 TYPE(TMPP), INTENT(IN) :: td_mpp 1183 1184 ! function 1185 INTEGER(i4) :: grid__get_pivot_mpp 1186 1187 ! local variable 1188 INTEGER(i4) :: il_varid 1189 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 1190 1191 LOGICAL :: ll_north 1192 1193 TYPE(TVAR) :: tl_var 1194 TYPE(TVAR) :: tl_lat 1195 1196 ! loop indices 1197 INTEGER(i4) :: ji 1198 !---------------------------------------------------------------- 1199 ! intitalise 1200 grid__get_pivot_mpp=-1 1201 1202 ! look for north fold 1203 il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:), 'latitude') 1204 IF( il_varid == 0 )THEN 1205 CALL logger_error("GRID GET PIVOT: no variable with name "//& 1206 & "or standard name latitude in mpp structure "//& 1207 & TRIM(td_mpp%c_name)//". Assume there is north fold and "//& 1208 & "try to get pivot point") 1209 1210 ll_north=.TRUE. 1211 ELSE 1212 IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(il_varid)%d_value) )THEN 1213 ! 1214 tl_lat=mpp_recombine_var(td_mpp, 'latitude') 1215 ELSE 1216 tl_lat=iom_mpp_read_var(td_mpp, 'latitude') 1217 ENDIF 1218 1219 ll_north=grid_is_north_fold(tl_lat) 1220 ENDIF 1221 1222 IF( ll_north )THEN 1223 1224 IF( ASSOCIATED(tl_lat%d_value) )THEN 1225 grid__get_pivot_mpp=grid_get_pivot(tl_lat) 1226 ELSE 1227 ! look for suitable variable 1228 DO ji=1,td_mpp%t_proc(1)%i_nvar 1229 IF(.NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use)) CYCLE 1230 1231 IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(ji)%d_value) )THEN 1232 CALL logger_debug("GRID GET PIVOT: mpp_recombine_var"//& 1233 & TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)) 1234 tl_var=mpp_recombine_var(td_mpp, & 1235 & TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)) 1236 ELSE 1237 CALL logger_debug("GRID GET PIVOT: iom_mpp_read_var "//& 1238 & TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)) 1239 il_dim(:)=td_mpp%t_dim(:)%i_len 1240 1241 ! read variable 1242 tl_var=iom_mpp_read_var(td_mpp, & 1243 & td_mpp%t_proc(1)%t_var(ji)%c_name, & 1244 & id_start=(/1,il_dim(2)-3,1,1/), & 1245 & id_count=(/il_dim(1),4,1,1/) ) 1246 ENDIF 1247 EXIT 1248 ENDDO 1249 1250 IF( ASSOCIATED(tl_var%d_value) )THEN 1251 1252 grid__get_pivot_mpp=grid_get_pivot(tl_var) 1253 1254 ELSE 1255 CALL logger_warn("GRID GET PIVOT: force to use T-PIVOT") 1256 grid__get_pivot_mpp=1 1257 ENDIF 1258 1259 ! clean 1260 CALL var_clean(tl_var) 1261 ENDIF 1262 ELSE 1263 CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT") 1264 grid__get_pivot_mpp=1 1265 ENDIF 1266 1267 CALL var_clean(tl_lat) 1268 END FUNCTION grid__get_pivot_mpp 1269 !------------------------------------------------------------------- 1270 !> @brief 1271 !> This subroutine search NEMO periodicity index given variable structure and 1272 !> pivot point index. 1273 !> @details 1274 !> The variable must be on T point. 1275 !> 1276 !> 0: closed boundaries 1277 !> 1: cyclic east-west boundary 1278 !> 2: symmetric boundary condition across the equator 1279 !> 3: North fold boundary (with a F-point pivot) 1280 !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 1281 !> 5: North fold boundary (with a T-point pivot) 1282 !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 1283 !> 1284 !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 1285 !> 1286 !> @author J.Paul 1287 !> - November, 2013- Subroutine written 1288 !> @date October, 2014 1289 !> - work on variable structure instead of file structure 1290 ! 1291 !> @param[in] td_var variable structure 1292 !> @param[in] id_pivot pivot point index 1293 !------------------------------------------------------------------- 1294 FUNCTION grid__get_perio_var(td_var, id_pivot) 1295 IMPLICIT NONE 1296 1297 ! Argument 1298 TYPE(TVAR) , INTENT(IN) :: td_var 1299 INTEGER(i4), INTENT(IN) :: id_pivot 1300 1301 ! function 1302 INTEGER(i4) :: grid__get_perio_var 1303 1304 ! local variable 1305 INTEGER(i4) :: il_perio 1306 1307 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 1308 1309 ! loop indices 1310 !---------------------------------------------------------------- 1311 ! intitalise 1312 grid__get_perio_var=-1 1313 1314 IF( id_pivot < 0 .OR. id_pivot > 1 )THEN 1315 CALL logger_error("GRID GET PERIO: invalid pivot point index. "//& 1316 & "you should use grid_get_pivot to compute it") 1317 ENDIF 1318 1319 IF( .NOT. ASSOCIATED(td_var%d_value) .OR. & 1320 & .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN 1321 CALL logger_error("GRID GET PERIO: can not compute periodicity"//& 1322 & " with variable "//TRIM(td_var%c_name)//"."//& 1323 & " no value associated or missing dimension.") 1324 ELSE 1325 1326 il_dim(:)=td_var%t_dim(:)%i_len 1327 1328 CALL logger_info("GRID GET PERIO: use varibale "//TRIM(td_var%c_name)) 1329 CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill))) 1330 CALL logger_info("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_value(1,1,1,1)))) 1331 1332 IF(ALL(td_var%d_value( 1 , : ,1,1)/=td_var%d_fill).AND.& 1333 & ALL(td_var%d_value(il_dim(1), : ,1,1)/=td_var%d_fill).AND.& 1334 & ALL(td_var%d_value( : , 1 ,1,1)/=td_var%d_fill).AND.& 1335 & ALL(td_var%d_value( : ,il_dim(2),1,1)/=td_var%d_fill))THEN 1336 ! no boundary closed 1337 CALL logger_warn("GRID GET PERIO: can't determined periodicity. "//& 1338 & "there is no boundary closed for variable "//& 1339 & TRIM(td_var%c_name) ) 1340 ELSE 1341 ! check periodicity 1342 IF(ANY(td_var%d_value( 1 ,:,1,1)/=td_var%d_fill).OR.& 1343 & ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN 1344 ! East-West cyclic (1,4,6) 1345 1346 IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 1347 ! South boundary not closed 1348 1349 CALL logger_debug("GRID GET PERIO: East_West cyclic") 1350 CALL logger_debug("GRID GET PERIO: South boundary not closed") 1351 CALL logger_error("GRID GET PERIO: should have been an "//& 1352 & "impossible case") 1353 1354 ELSE 1355 ! South boundary closed (1,4,6) 1356 CALL logger_info("GRID GET PERIO: South boundary closed") 1357 1358 IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN 1359 ! North boundary not closed (4,6) 1360 CALL logger_info("GRID GET PERIO: North boundary not closed") 1361 ! check pivot 1362 SELECT CASE(id_pivot) 1363 CASE(0) 1364 ! F pivot 1365 il_perio=6 1366 CASE(1) 1367 ! T pivot 1368 il_perio=4 1369 CASE DEFAULT 1370 CALL logger_error("GRID GET PERIO: invalid pivot ") 1371 END SELECT 1372 ELSE 1373 ! North boundary closed 1374 CALL logger_info("GRID GET PERIO: North boundary closed") 1375 il_perio=1 ! North and South boundaries closed 1376 ENDIF 1377 1378 ENDIF 1379 1380 ELSE 1381 ! East-West boundaries closed (0,2,3,5) 1382 CALL logger_info("GRID GET PERIO: East West boundaries closed") 1383 1384 IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 1385 ! South boundary not closed (2) 1386 CALL logger_info("GRID GET PERIO: South boundary not closed") 1387 1388 IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 1389 ! North boundary not closed 1390 CALL logger_debug("GRID GET PERIO: East West boundaries "//& 1391 & "closed") 1392 CALL logger_debug("GRID GET PERIO: South boundary not closed") 1393 CALL logger_debug("GRID GET PERIO: North boundary not closed") 1394 CALL logger_error("GRID GET PERIO: should have been "//& 1395 & "an impossible case") 1396 ELSE 1397 ! North boundary closed 1398 il_perio=2 ! East-West and North boundaries closed 1399 ENDIF 1400 1401 ELSE 1402 ! South boundary closed (0,3,5) 1403 CALL logger_info("GRID GET PERIO: South boundary closed") 1404 1405 IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 1406 ! North boundary not closed (3,5) 1407 CALL logger_info("GRID GET PERIO: North boundary not closed") 1408 ! check pivot 1409 SELECT CASE(id_pivot) 1410 CASE(0) 1411 ! F pivot 1412 il_perio=5 1413 CASE(1) 1414 ! T pivot 1415 il_perio=3 1416 CASE DEFAULT 1417 CALL logger_error("GRID GET PERIO: invalid pivot") 1418 END SELECT 1419 ELSE 1420 ! North boundary closed 1421 CALL logger_info("GRID GET PERIO: North boundary closed") 1422 il_perio=0 ! all boundary closed 1423 ENDIF 1424 1425 ENDIF 1426 1427 ENDIF 1428 1429 grid__get_perio_var=il_perio 1430 1431 ENDIF 1432 1433 ENDIF 1434 1435 END FUNCTION grid__get_perio_var 1436 !------------------------------------------------------------------- 1437 !> @brief 1438 !> This subroutine search NEMO periodicity index given file structure, and 1439 !> optionaly pivot point index. 1440 !> @details 1441 !> The variable used must be on T point. 1442 !> 1443 !> 0: closed boundaries 1444 !> 1: cyclic east-west boundary 1445 !> 2: symmetric boundary condition across the equator 1446 !> 3: North fold boundary (with a F-point pivot) 1447 !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary 1448 !> 5: North fold boundary (with a T-point pivot) 1449 !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 1450 !> 1451 !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 1452 !> 1453 !> @author J.Paul 1454 !> - October, 2014 - Initial version 1455 !> 1456 !> @param[in] td_file file structure 1457 !> @param[in] id_pivot pivot point index 1458 !------------------------------------------------------------------- 1459 FUNCTION grid__get_perio_file(td_file, id_pivot) 1460 IMPLICIT NONE 1461 1462 ! Argument 1463 TYPE(TFILE), INTENT(IN) :: td_file 1464 INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot 1465 1466 ! function 1467 INTEGER(i4) :: grid__get_perio_file 1468 1469 ! local variable 1470 INTEGER(i4) :: il_varid 1471 INTEGER(i4) :: il_pivot 1472 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 1473 1474 TYPE(TVAR) :: tl_var 1475 1476 ! loop indices 1477 INTEGER(i4) :: ji 1478 !---------------------------------------------------------------- 1479 !initialise 1480 grid__get_perio_file=-1 1481 1482 IF(PRESENT(id_pivot) )THEN 1483 il_pivot=id_pivot 1484 ELSE 1485 il_pivot=grid_get_pivot(td_file) 1486 ENDIF 1487 1488 IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 1489 CALL logger_error("GRID GET PERIO: invalid pivot point index. "//& 1490 & "you should use grid_get_pivot to compute it") 1491 ENDIF 123 1492 124 1493 ! look for suitable variable … … 134 1503 ENDDO 135 1504 136 IF( il_varid/=0 )THEN 137 IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN 138 CALL logger_debug("GRID GET PIVOT: ASSOCIATED") 139 tl_var=td_file%t_var(il_varid) 140 ELSE 141 ! read variable 142 il_dim(:)=td_file%t_var(il_varid)%t_dim(:)%i_len 143 144 CALL logger_debug("GRID GET PIVOT: read variable") 145 tl_var=iom_read_var(td_file, td_file%t_var(il_varid)%c_name, & 146 & id_start=(/1,il_dim(2)-3,1,1/), & 147 & id_count=(/3,4,1,1/) ) 148 ENDIF 149 150 CALL logger_debug("GRID GET PIVOT: use variable "//TRIM(tl_var%c_name)) 151 152 IF( ASSOCIATED(tl_var%d_value) )THEN 153 154 CALL logger_debug("GRID GET PIVOT: point "//TRIM(tl_var%c_point)) 155 ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid 156 it1=1 ; jt1=4 157 it2=3 ; jt2=2 158 159 ! F-point pivot !case of ORCA05 grid 160 if1=1 ; jf1=4 161 if2=2 ; jf2=3 162 163 SELECT CASE(TRIM(tl_var%c_point)) 164 CASE('T') 165 IF( ABS(tl_var%d_value(it1,jt1,1,1)) == & 166 & ABS(tl_var%d_value(it2,jt2,1,1)) )THEN 167 CALL logger_info("GRID GET PIVOT: T-pivot") 168 grid_get_pivot=1 169 ELSEIF( ABS(tl_var%d_value(if1,jf1,1,1)) == & 170 & ABS(tl_var%d_value(if2,jf2,1,1)) )THEN 171 CALL logger_info("GRID GET PIVOT: F-pivot") 172 grid_get_pivot=0 173 ELSE 174 CALL logger_error("GRID GET PIVOT: something wrong when "//& 175 & "computing pivot point") 176 ENDIF 177 CASE('U') 178 IF( ABS(tl_var%d_value(it1 ,jt1,1,1)) == & 179 & ABS(tl_var%d_value(it2-1,jt2,1,1)) )THEN 180 CALL logger_info("GRID GET PIVOT: T-pivot") 181 grid_get_pivot=1 182 ELSEIF( ABS(tl_var%d_value(if1 ,jf1,1,1)) == & 183 & ABS(tl_var%d_value(if2-1,jf2,1,1)) )THEN 184 CALL logger_info("GRID GET PIVOT: F-pivot") 185 grid_get_pivot=0 186 ELSE 187 CALL logger_error("GRID GET PIVOT: something wrong when "//& 188 & "computing pivot point") 189 ENDIF 190 CASE('V') 191 IF( ABS(tl_var%d_value(it1,jt1 ,1,1)) == & 192 & ABS(tl_var%d_value(it2,jt2-1,1,1)) )THEN 193 CALL logger_info("GRID GET PIVOT: T-pivot") 194 grid_get_pivot=1 195 ELSEIF( ABS(tl_var%d_value(if1,jf1 ,1,1)) == & 196 & ABS(tl_var%d_value(if2,jf2-1,1,1)) )THEN 197 CALL logger_info("GRID GET PIVOT: F-pivot") 198 grid_get_pivot=0 199 ELSE 200 CALL logger_error("GRID GET PIVOT: something wrong when "//& 201 & "computing pivot point") 202 ENDIF 203 CASE('F') 204 IF( ABS(tl_var%d_value(it1 ,jt1 ,1,1)) == & 205 & ABS(tl_var%d_value(it2-1,jt2-1,1,1)) )THEN 206 CALL logger_info("GRID GET PIVOT: T-pivot") 207 grid_get_pivot=1 208 ELSEIF( ABS(tl_var%d_value(if1 ,jf1 ,1,1)) == & 209 & ABS(tl_var%d_value(if2-1,jf2-1,1,1)) )THEN 210 CALL logger_info("GRID GET PIVOT: F-pivot") 211 grid_get_pivot=0 212 ELSE 213 CALL logger_error("GRID GET PIVOT: something wrong when "//& 214 & "computing pivot point") 215 ENDIF 216 END SELECT 217 ELSE 218 CALL logger_error("GRID GET PIVOT: can't compute pivot point. "//& 219 & "no value associated to variable "//TRIM(tl_var%c_name) ) 220 ENDIF 1505 IF( il_varid==0 )THEN 1506 1507 CALL logger_error("GRID GET PERIO: no suitable variable to compute "//& 1508 & " periodicity in file "//TRIM(td_file%c_name)) 221 1509 222 1510 ELSE 223 CALL logger_error("GRID GET PIVOT: no suitable variable to compute "//& 224 & "pivot point in file "//TRIM(td_file%c_name)) 225 ENDIF 226 227 END FUNCTION grid_get_pivot 228 !> @endcode 1511 1512 il_dim(:)= td_file%t_var(il_varid)%t_dim(:)%i_len 1513 1514 ! read variable 1515 tl_var=iom_read_var(td_file, & 1516 & td_file%t_var(il_varid)%c_name, & 1517 & id_start=(/1,1,1,1/), & 1518 & id_count=(/il_dim(1),il_dim(2),1,1/) ) 1519 1520 1521 grid__get_perio_file=grid_get_perio(tl_var,il_pivot) 1522 1523 ! clean 1524 CALL var_clean(tl_var) 1525 1526 ENDIF 1527 1528 END FUNCTION grid__get_perio_file 229 1529 !------------------------------------------------------------------- 230 1530 !> @brief 231 !> This funtion return NEMO periodicity index of the input file. 1531 !> This subroutine search NEMO periodicity given mpp structure and optionaly 1532 !> pivot point index. 1533 !> @details 232 1534 !> The variable used must be on T point. 233 !>234 !> @note the NEMO periodicity index can't be compute from coordinates file,235 !> neither with mpp files.236 1535 !> 237 1536 !> 0: closed boundaries … … 243 1542 !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary 244 1543 !> 1544 !> @warning pivot point should have been computed before run this script. see grid_get_pivot. 1545 !> 245 1546 !> @author J.Paul 246 !> - Nov, 2013- Subroutine written 247 ! 248 !> @todo 249 !> - improve check between T or F pivot. 250 !> - manage mpp case (read only border files) 251 ! 252 !> @param[in] td_file : file structure 253 !> @param[in] id_pivot : pivot point 254 !> @return NEMO periodicity index 255 !------------------------------------------------------------------- 256 !> @code 257 INTEGER(i4) FUNCTION grid_get_perio(td_file, id_pivot) 1547 !> - October, 2014 - Initial version 1548 ! 1549 !> @param[in] td_mpp mpp file structure 1550 !> @param[in] id_pivot pivot point index 1551 !------------------------------------------------------------------- 1552 FUNCTION grid__get_perio_mpp(td_mpp, id_pivot) 258 1553 IMPLICIT NONE 259 1554 260 1555 ! Argument 261 TYPE(TFILE), INTENT(IN) :: td_file 262 INTEGER(i4), INTENT(IN) :: id_pivot 1556 TYPE(TMPP) , INTENT(IN) :: td_mpp 1557 INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot 1558 1559 ! function 1560 INTEGER(i4) :: grid__get_perio_mpp 263 1561 264 1562 ! local variable 1563 INTEGER(i4) :: il_varid 1564 INTEGER(i4) :: il_pivot 1565 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 1566 265 1567 TYPE(TVAR) :: tl_var 266 INTEGER(i4) :: il_varid267 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim268 1568 269 1569 ! loop indices 270 1570 INTEGER(i4) :: ji 271 1571 !---------------------------------------------------------------- 272 273 1572 ! initialise 274 grid_get_perio=-1 275 276 IF( id_pivot < 0 .OR. id_pivot > 1 )THEN 1573 grid__get_perio_mpp=-1 1574 1575 IF(PRESENT(id_pivot) )THEN 1576 il_pivot=id_pivot 1577 ELSE 1578 il_pivot=grid_get_pivot(td_mpp) 1579 ENDIF 1580 1581 IF( il_pivot < 0 .OR. il_pivot > 1 )THEN 277 1582 CALL logger_error("GRID GET PERIO: invalid pivot point index. "//& 278 1583 & "you should use grid_get_pivot to compute it") … … 281 1586 ! look for suitable variable 282 1587 il_varid=0 283 DO ji=1,td_ file%i_nvar284 IF( .NOT. ALL(td_ file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE285 SELECT CASE(TRIM(fct_lower(td_ file%t_var(ji)%c_stdname)) )1588 DO ji=1,td_mpp%t_proc(1)%i_nvar 1589 IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 1590 SELECT CASE(TRIM(fct_lower(td_mpp%t_proc(1)%t_var(ji)%c_stdname)) ) 286 1591 CASE('longitude','latitude') 287 1592 CASE DEFAULT … … 292 1597 293 1598 IF( il_varid==0 )THEN 294 1599 295 1600 CALL logger_error("GRID GET PERIO: no suitable variable to compute "//& 296 & " periodicity in file "//TRIM(td_ file%c_name))1601 & " periodicity in file "//TRIM(td_mpp%c_name)) 297 1602 ELSE 298 il_dim(:)=td_file%t_var(il_varid)%t_dim(:)%i_len 299 300 IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN 301 tl_var=td_file%t_var(il_varid) 302 ELSE 303 ! read variable 304 tl_var=iom_read_var(td_file, td_file%t_var(il_varid)%c_name, & 305 & id_start=(/1,1,1,1/), & 306 & id_count=(/il_dim(1),il_dim(2),1,1/) ) 1603 1604 DO ji=1,ip_maxdim 1605 IF( td_mpp%t_proc(1)%t_var(il_varid)%t_dim(ji)%l_use )THEN 1606 il_dim(ji)=td_mpp%t_dim(ji)%i_len 1607 ELSE 1608 il_dim(ji)=1 1609 ENDIF 1610 ENDDO 1611 1612 ! read variable 1613 tl_var=iom_mpp_read_var(td_mpp, & 1614 & td_mpp%t_proc(1)%t_var(il_varid)%c_name, & 1615 & id_start=(/1,1,1,1/), & 1616 & id_count=(/il_dim(1),il_dim(2),1,1/) ) 1617 1618 grid__get_perio_mpp=grid_get_perio(tl_var, il_pivot) 1619 1620 ! clean 1621 CALL var_clean(tl_var) 1622 ENDIF 1623 1624 END FUNCTION grid__get_perio_mpp 1625 !------------------------------------------------------------------- 1626 !> @brief This function get East-West overlap. 1627 ! 1628 !> @details 1629 !> If no East-West wrap return -1, 1630 !> else return the size of the ovarlap band. 1631 !> East-West overlap is computed comparing longitude value of the 1632 !> South" part of the domain, to avoid north fold boundary. 1633 !> 1634 ! 1635 !> @author J.Paul 1636 !> - November, 2013- Initial Version 1637 !> @date October, 2014 1638 !> - work on mpp file structure instead of file structure 1639 !> 1640 !> @param[in] td_lon longitude variable structure 1641 !> @return East West overlap 1642 !------------------------------------------------------------------- 1643 FUNCTION grid__get_ew_overlap_var(td_var) 1644 IMPLICIT NONE 1645 ! Argument 1646 TYPE(TVAR), INTENT(INOUT) :: td_var 1647 ! function 1648 INTEGER(i4) :: grid__get_ew_overlap_var 1649 1650 ! local variable 1651 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_value 1652 REAL(dp), DIMENSION(:) , ALLOCATABLE :: dl_vare 1653 REAL(dp), DIMENSION(:) , ALLOCATABLE :: dl_varw 1654 1655 REAL(dp) :: dl_delta 1656 REAL(dp) :: dl_varmax 1657 REAL(dp) :: dl_varmin 1658 1659 INTEGER(i4) :: il_east 1660 INTEGER(i4) :: il_west 1661 INTEGER(i4) :: il_jmin 1662 INTEGER(i4) :: il_jmax 1663 1664 INTEGER(i4), PARAMETER :: il_max_overlap = 5 1665 1666 ! loop indices 1667 INTEGER(i4) :: ji 1668 !---------------------------------------------------------------- 1669 ! initialise 1670 grid__get_ew_overlap_var=-1 1671 1672 IF( ASSOCIATED(td_var%d_value) )THEN 1673 IF( td_var%t_dim(1)%i_len > 1 )THEN 1674 il_west=1 1675 il_east=td_var%t_dim(1)%i_len 1676 1677 ALLOCATE( dl_value(td_var%t_dim(1)%i_len, & 1678 & td_var%t_dim(2)%i_len) ) 1679 1680 dl_value(:,:)=td_var%d_value(:,:,1,1) 1681 1682 ! we do not use jmax as dimension length due to north fold boundary 1683 il_jmin=1+ip_ghost 1684 il_jmax=(td_var%t_dim(2)%i_len-ip_ghost)/2 1685 1686 ALLOCATE( dl_vare(il_jmax-il_jmin+1) ) 1687 ALLOCATE( dl_varw(il_jmax-il_jmin+1) ) 1688 1689 dl_vare(:)=dl_value(il_east,il_jmin:il_jmax) 1690 dl_varw(:)=dl_value(il_west,il_jmin:il_jmax) 1691 1692 IF( .NOT.( ALL(dl_vare(:)==td_var%d_fill) .AND. & 1693 & ALL(dl_varw(:)==td_var%d_fill) ) )THEN 1694 1695 IF( TRIM(td_var%c_stdname) == 'longitude' )THEN 1696 WHERE( dl_value(:,:) > 180._dp .AND. & 1697 & dl_value(:,:) /= td_var%d_fill ) 1698 dl_value(:,:)=360.-dl_value(:,:) 1699 END WHERE 1700 1701 dl_varmax=MAXVAL(dl_value(:,il_jmin:il_jmax)) 1702 dl_varmin=MINVAL(dl_value(:,il_jmin:il_jmax)) 1703 1704 dl_delta=(dl_varmax-dl_varmin)/td_var%t_dim(1)%i_len 1705 1706 IF( ALL(ABS(dl_vare(:)) - ABS(dl_varw(:)) == dl_delta) )THEN 1707 grid__get_ew_overlap_var=0 1708 ENDIF 1709 ENDIF 1710 1711 IF( grid__get_ew_overlap_var == -1 )THEN 1712 DO ji=0,il_max_overlap 1713 1714 IF( il_east-ji == il_west )THEN 1715 ! case of small domain 1716 EXIT 1717 ELSE 1718 dl_vare(:)=dl_value(il_east-ji,il_jmin:il_jmax) 1719 1720 IF( ALL( dl_varw(:) == dl_vare(:) ) )THEN 1721 grid__get_ew_overlap_var=ji+1 1722 EXIT 1723 ENDIF 1724 ENDIF 1725 1726 ENDDO 1727 ENDIF 1728 ENDIF 1729 307 1730 ENDIF 308 309 IF(ALL(tl_var%d_value( 1 , : ,1,1)/=tl_var%d_fill).AND.& 310 & ALL(tl_var%d_value(il_dim(1), : ,1,1)/=tl_var%d_fill).AND.& 311 & ALL(tl_var%d_value( : , 1 ,1,1)/=tl_var%d_fill).AND.& 312 & ALL(tl_var%d_value( : ,il_dim(2),1,1)/=tl_var%d_fill))THEN 313 ! no boundary closed 314 CALL logger_warn("GRID GET PERIO: can't determined periodicity. "//& 315 & "there is no boundary closed for variable "//& 316 & TRIM(tl_var%c_name)//" in file "//& 317 & TRIM(td_file%c_name) ) 318 ELSE 319 ! check periodicity 320 IF(ANY(tl_var%d_value( 1 ,:,1,1)/=tl_var%d_fill).OR.& 321 & ANY(tl_var%d_value(il_dim(1),:,1,1)/=tl_var%d_fill))THEN 322 ! East-West cyclic (1,4,6) 323 324 IF( ANY(tl_var%d_value(:, 1, 1, 1) /= tl_var%d_fill) )THEN 325 ! South boundary not closed 326 327 CALL logger_error("GRID GET PERIO: should have been an "//& 328 & "impossible case") 329 CALL logger_debug("GRID GET PERIO: East_West cyclic") 330 CALL logger_debug("GRID GET PERIO: South boundary not closed") 331 332 ELSE 333 ! South boundary closed (1,4,6) 334 CALL logger_info("GRID GET PERIO: South boundary closed") 335 336 IF(ANY(tl_var%d_value(:,il_dim(2),1,1)/=tl_var%d_fill) )THEN 337 ! North boundary not closed (4,6) 338 CALL logger_info("GRID GET PERIO: North boundary not closed") 339 ! check pivot 340 SELECT CASE(id_pivot) 341 CASE(0) 342 ! F pivot 343 grid_get_perio=4 344 CASE(1) 345 ! T pivot 346 grid_get_perio=6 347 CASE DEFAULT 348 CALL logger_error("GRID GET PERIO: invalid pivot ") 349 END SELECT 350 ELSE 351 ! North boundary closed 352 CALL logger_info("GRID GET PERIO: North boundary closed") 353 grid_get_perio=1 ! North and South boundaries closed 354 ENDIF 355 356 ENDIF 357 358 ELSE 359 ! East-West boundaries closed (0,2,3,5) 360 CALL logger_info("GRID GET PERIO: East West boundaries closed") 361 362 IF( ANY(tl_var%d_value(:, 1, 1, 1) /= tl_var%d_fill) )THEN 363 ! South boundary not closed (2) 364 CALL logger_info("GRID GET PERIO: South boundary not closed") 365 366 IF(ANY(tl_var%d_value(:,il_dim(2),1,1)/=tl_var%d_fill))THEN 367 ! North boundary not closed 368 CALL logger_error("GRID GET PERIO: should have been "//& 369 & "an impossible case") 370 CALL logger_debug("GRID GET PERIO: East West boundaries "//& 371 & "closed") 372 CALL logger_debug("GRID GET PERIO: South boundary not closed") 373 CALL logger_debug("GRID GET PERIO: North boundary not closed") 374 ELSE 375 ! North boundary closed 376 grid_get_perio=2 ! East-West and North boundaries closed 377 ENDIF 378 379 ELSE 380 ! South boundary closed (0,3,5) 381 CALL logger_info("GRID GET PERIO: South boundary closed") 382 383 IF(ANY(tl_var%d_value(:,il_dim(2),1,1)/=tl_var%d_fill))THEN 384 ! North boundary not closed (3,5) 385 CALL logger_info("GRID GET PERIO: North boundary not closed") 386 ! check pivot 387 SELECT CASE(id_pivot) 388 CASE(0) 389 ! F pivot 390 grid_get_perio=3 391 CASE(1) 392 ! T pivot 393 grid_get_perio=5 394 CASE DEFAULT 395 CALL logger_error("GRID GET PERIO: invalid pivot") 396 END SELECT 397 ELSE 398 ! North boundary closed 399 CALL logger_info("GRID GET PERIO: North boundary closed") 400 grid_get_perio=0 ! all boundary closed 401 ENDIF 402 403 ENDIF 404 405 ENDIF 406 1731 ELSE 1732 CALL logger_error("GRID GET EW OVERLAP: input variable standard name"//& 1733 & TRIM(td_var%c_stdname)//" can not be used to compute East West "//& 1734 & "overalp. no value associated. ") 1735 ENDIF 1736 1737 END FUNCTION grid__get_ew_overlap_var 1738 !------------------------------------------------------------------- 1739 !> @brief This function get East-West overlap. 1740 ! 1741 !> @details 1742 !> If no East-West wrap return -1, 1743 !> else return the size of the ovarlap band. 1744 !> East-West overlap is computed comparing longitude value of the 1745 !> South" part of the domain, to avoid north fold boundary. 1746 !> 1747 !> @author J.Paul 1748 !> - October, 2014- Initial Version 1749 !> 1750 !> @param[in] td_file file structure 1751 !> @return East West overlap 1752 !------------------------------------------------------------------- 1753 FUNCTION grid__get_ew_overlap_file(td_file) 1754 IMPLICIT NONE 1755 ! Argument 1756 TYPE(TFILE), INTENT(INOUT) :: td_file 1757 ! function 1758 INTEGER(i4) :: grid__get_ew_overlap_file 1759 1760 ! local variable 1761 INTEGER(i4) :: il_varid 1762 1763 TYPE(TVAR) :: tl_var 1764 1765 ! loop indices 1766 INTEGER(i4) :: ji 1767 !---------------------------------------------------------------- 1768 1769 il_varid=var_get_index(td_file%t_var(:), 'longitude') 1770 IF( il_varid /= 0 )THEN 1771 ! read longitude on boundary 1772 tl_var=iom_read_var(td_file, 'longitude') 1773 ELSE 1774 DO ji=1,td_file%i_nvar 1775 IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 1776 1777 tl_var=iom_read_var(td_file, td_file%t_var(ji)%c_name) 1778 EXIT 1779 ENDDO 1780 ENDIF 1781 1782 grid__get_ew_overlap_file=grid_get_ew_overlap(tl_var) 1783 1784 ! clean 1785 CALL var_clean(tl_var) 1786 1787 END FUNCTION grid__get_ew_overlap_file 1788 !------------------------------------------------------------------- 1789 !> @brief This function get East-West overlap. 1790 ! 1791 !> @details 1792 !> If no East-West wrap return -1, 1793 !> else return the size of the ovarlap band. 1794 !> East-West overlap is computed comparing longitude value of the 1795 !> South" part of the domain, to avoid north fold boundary. 1796 !> 1797 ! 1798 !> @author J.Paul 1799 !> - November, 2013- Initial Version 1800 !> @date October, 2014 1801 !> - work on mpp file structure instead of file structure 1802 !> 1803 !> @param[in] td_mpp mpp structure 1804 !> @return East West overlap 1805 !------------------------------------------------------------------- 1806 FUNCTION grid__get_ew_overlap_mpp(td_mpp) 1807 IMPLICIT NONE 1808 ! Argument 1809 TYPE(TMPP), INTENT(INOUT) :: td_mpp 1810 ! function 1811 INTEGER(i4) :: grid__get_ew_overlap_mpp 1812 1813 ! local variable 1814 INTEGER(i4) :: il_ew 1815 INTEGER(i4) :: il_varid 1816 1817 TYPE(TVAR) :: tl_var 1818 ! loop indices 1819 INTEGER(i4) :: ji 1820 !---------------------------------------------------------------- 1821 1822 ! initialise 1823 grid__get_ew_overlap_mpp=td_mpp%i_ew 1824 1825 ! read longitude on boundary 1826 il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:),'longitude') 1827 IF( il_varid /= 0 )THEN 1828 tl_var=iom_mpp_read_var(td_mpp, 'longitude') 1829 ELSE 1830 DO ji=1,td_mpp%t_proc(1)%i_nvar 1831 IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE 1832 1833 tl_var=iom_mpp_read_var(td_mpp, td_mpp%t_proc(1)%t_var(ji)%c_name) 1834 EXIT 1835 ENDDO 1836 ENDIF 1837 1838 il_ew=grid_get_ew_overlap(tl_var) 1839 IF( il_ew >= 0 )THEN 1840 grid__get_ew_overlap_mpp=il_ew 1841 ENDIF 1842 1843 1844 ! clean 1845 CALL var_clean(tl_var) 1846 1847 END FUNCTION grid__get_ew_overlap_mpp 1848 !------------------------------------------------------------------- 1849 !> @brief This subroutine check if there is north fold. 1850 !> 1851 !> @details 1852 !> check if maximum latitude greater than 88°N 1853 !> 1854 !> @author J.Paul 1855 !> - November, 2013- Initial Version 1856 !> 1857 !> @param[in] td_lat latitude variable structure 1858 !------------------------------------------------------------------- 1859 LOGICAL FUNCTION grid_is_north_fold(td_lat) 1860 IMPLICIT NONE 1861 ! Argument 1862 TYPE(TVAR), INTENT(IN) :: td_lat 1863 1864 ! local variable 1865 ! loop indices 1866 !---------------------------------------------------------------- 1867 1868 ! init 1869 grid_is_north_fold=.FALSE. 1870 1871 IF( .NOT. ASSOCIATED(td_lat%d_value) )THEN 1872 CALL logger_error("GRID IS NORTH FOLD: "//& 1873 & " no value associated to latitude") 1874 ELSE 1875 IF( MAXVAL(td_lat%d_value(:,:,:,:), & 1876 & td_lat%d_value(:,:,:,:)/= td_lat%d_fill) >= 88.0 )THEN 1877 1878 grid_is_north_fold=.TRUE. 1879 407 1880 ENDIF 408 1881 ENDIF 409 1882 410 END FUNCTION grid_get_perio 411 !> @endcode 1883 END FUNCTION grid_is_north_fold 412 1884 !------------------------------------------------------------------- 413 1885 !> @brief This subroutine check domain validity. … … 415 1887 !> @details 416 1888 !> If maximum latitude greater than 88°N, program will stop. 417 !> It is not able to manage north fold boundaryfor now.1889 !> @note Not able to manage north fold for now. 418 1890 ! 419 1891 !> @author J.Paul 420 !> - Nov, 2013- Initial Version 421 ! 422 !> @param[in] cd_coord : coordinate file 423 !> @param[in] id_imin : i-direction lower left point indice 424 !> @param[in] id_imax : i-direction upper right point indice 425 !> @param[in] id_jmin : j-direction lower left point indice 426 !> @param[in] id_jmax : j-direction upper right point indice 427 !> 428 !> @todo 429 !> - use domain instead of start count 430 !------------------------------------------------------------------- 431 !> @code 1892 !> - November, 2013- Initial Version 1893 !> @date October, 2014 1894 !> - work on mpp file structure instead of file structure 1895 ! 1896 !> @param[in] cd_coord coordinate file 1897 !> @param[in] id_imin i-direction lower left point indice 1898 !> @param[in] id_imax i-direction upper right point indice 1899 !> @param[in] id_jmin j-direction lower left point indice 1900 !> @param[in] id_jmax j-direction upper right point indice 1901 !------------------------------------------------------------------- 432 1902 SUBROUTINE grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax) 433 1903 IMPLICIT NONE 434 1904 ! Argument 435 TYPE(T FILE), INTENT(IN) :: td_coord1905 TYPE(TMPP) , INTENT(IN) :: td_coord 436 1906 INTEGER(i4), INTENT(IN) :: id_imin 437 1907 INTEGER(i4), INTENT(IN) :: id_imax … … 440 1910 441 1911 ! local variable 442 TYPE(TVAR) :: tl_var 443 444 TYPE(TFILE) :: tl_coord 445 446 TYPE(TMPP) :: tl_mppcoord 447 448 TYPE(TDOM) :: tl_dom 449 1912 TYPE(TVAR) :: tl_var 1913 1914 TYPE(TMPP) :: tl_coord 1915 1916 TYPE(TDOM) :: tl_dom 450 1917 ! loop indices 451 1918 !---------------------------------------------------------------- 452 1919 453 IF( id_jmin > = id_jmax)THEN1920 IF( id_jmin > id_jmax .OR. id_jmax == 0 )THEN 454 1921 455 1922 CALL logger_fatal("GRID CHECK DOM: invalid domain. "//& … … 457 1924 458 1925 ELSE 459 460 IF( td_coord%i_id == 0 )THEN461 CALL logger_error("GRID CHECK DOM: can not check domain. "//&462 & " file "//TRIM(td_coord%c_name)//" not opened." )463 ELSE464 1926 465 1927 IF( id_imin == id_imax .AND. td_coord%i_ew < 0 )THEN … … 469 1931 ENDIF 470 1932 471 !1- read domain 472 tl_coord=td_coord 473 CALL iom_open(tl_coord) 474 475 !1-1 compute domain 1933 ! copy structure 1934 tl_coord=mpp_copy(td_coord) 1935 1936 ! compute domain 476 1937 tl_dom=dom_init( tl_coord, & 477 & 478 & 1938 & id_imin, id_imax,& 1939 & id_jmin, id_jmax ) 479 1940 480 !1-2 close file 481 CALL iom_close(tl_coord) 482 483 !1-3 read variables on domain (ugly way to do it, have to work on it) 484 !1-3-1 init mpp structure 485 tl_mppcoord=mpp_init(tl_coord) 486 487 CALL file_clean(tl_coord) 488 489 !1-3-2 get processor to be used 490 CALL mpp_get_use( tl_mppcoord, tl_dom ) 491 492 !1-3-3 open mpp files 493 CALL iom_mpp_open(tl_mppcoord) 494 495 !1-3-4 read variable value on domain 496 tl_var=iom_mpp_read_var(tl_mppcoord,'latitude',td_dom=tl_dom) 497 498 !1-3-5 close mpp files 499 CALL iom_mpp_close(tl_mppcoord) 500 501 !1-3-6 clean structure 502 CALL mpp_clean(tl_mppcoord) 1941 ! open mpp files to be used 1942 CALL iom_dom_open(tl_coord, tl_dom) 1943 1944 ! read variable value on domain 1945 tl_var=iom_dom_read_var(tl_coord,'latitude',tl_dom) 1946 1947 ! close mpp files 1948 CALL iom_dom_close(tl_coord) 1949 1950 ! clean structure 1951 CALL mpp_clean(tl_coord) 503 1952 504 1953 IF( MAXVAL(tl_var%d_value(:,:,:,:), & … … 513 1962 514 1963 ! clean 1964 CALL dom_clean(tl_dom) 515 1965 CALL var_clean(tl_var) 516 1966 517 ENDIF518 519 520 1967 ENDIF 521 1968 522 1969 END SUBROUTINE grid_check_dom 523 !> @endcode524 1970 !------------------------------------------------------------------- 525 1971 !> @brief This function get closest coarse grid indices of fine grid domain. 526 1972 ! 527 1973 !> @details 528 !> 529 ! 1974 !> it use coarse and fine grid coordinates files. 1975 !> optionally, you could specify the array of refinment factor (default 1.) 1976 !> optionally, you could specify on which Arakawa grid point you want to 1977 !> work (default 'T') 1978 !> 530 1979 !> @author J.Paul 531 !> - Nov, 2013- Initial Version 532 ! 533 !> @param[in] td_coord0 : coarse grid coordinate structure 534 !> @param[in] td_coord1 : fine grid coordinate structure 535 !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 536 !> @todo 537 !> - use domain instead of start count 538 !------------------------------------------------------------------- 539 !> @code 540 FUNCTION grid_get_coarse_index_ff( td_coord0, td_coord1, & 541 & id_rho ) 1980 !> - November, 2013- Initial Version 1981 !> @date September, 2014 1982 !> - use grid point to read coordinates variable. 1983 !> @date October, 2014 1984 !> - work on mpp file structure instead of file structure 1985 !> 1986 !> @param[in] td_coord0 coarse grid coordinate mpp structure 1987 !> @param[in] td_coord1 fine grid coordinate mpp structure 1988 !> @param[in] id_rho array of refinment factor (default 1.) 1989 !> @param[in] cd_point Arakawa grid point (default 'T'). 1990 !> @return coarse grid indices(/(/imin0, imax0/), (/jmin0, jmax0/)/) 1991 !> 1992 !------------------------------------------------------------------- 1993 FUNCTION grid__get_coarse_index_ff( td_coord0, td_coord1, & 1994 & id_rho, cd_point ) 542 1995 IMPLICIT NONE 543 1996 ! Argument 544 TYPE(TFILE), INTENT(IN) :: td_coord0 545 TYPE(TFILE), INTENT(IN) :: td_coord1 546 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 1997 TYPE(TMPP) , INTENT(IN) :: td_coord0 1998 TYPE(TMPP) , INTENT(IN) :: td_coord1 1999 INTEGER(i4) , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 2000 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 547 2001 548 2002 ! function 549 INTEGER(i4), DIMENSION(2,2 ,2) :: grid_get_coarse_index_ff2003 INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_ff 550 2004 551 2005 ! local variable 2006 TYPE(TMPP) :: tl_coord0 2007 TYPE(TMPP) :: tl_coord1 2008 552 2009 TYPE(TVAR) :: tl_lon0 553 2010 TYPE(TVAR) :: tl_lat0 … … 555 2012 TYPE(TVAR) :: tl_lat1 556 2013 557 INTEGER(i4) , DIMENSION(:), ALLOCATABLE :: il_rho 558 559 INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 560 INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 561 INTEGER(i4), DIMENSION(2) :: il_xghost0 562 INTEGER(i4), DIMENSION(2) :: il_xghost1 2014 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 2015 2016 INTEGER(i4), DIMENSION(2,2) :: il_xghost0 2017 INTEGER(i4), DIMENSION(2,2) :: il_xghost1 563 2018 564 2019 INTEGER(i4) :: il_imin0 … … 567 2022 INTEGER(i4) :: il_jmax0 568 2023 569 INTEGER(i4) :: il_imin1 570 INTEGER(i4) :: il_imax1 571 INTEGER(i4) :: il_jmin1 572 INTEGER(i4) :: il_jmax1 2024 CHARACTER(LEN= 1) :: cl_point 2025 CHARACTER(LEN=lc) :: cl_name 573 2026 574 2027 ! loop indices … … 576 2029 577 2030 ! init 578 grid_ get_coarse_index_ff(:,:,:)=0579 580 ALLOCATE(il_rho(i g_ndim))2031 grid__get_coarse_index_ff(:,:)=0 2032 2033 ALLOCATE(il_rho(ip_maxdim)) 581 2034 il_rho(:)=1 582 2035 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 583 2036 584 IF( td_coord0%i_id == 0 .OR. td_coord1%i_id == 0 )THEN 585 CALL logger_error("GRID GET COARSE INDEX: can not get corase "//& 586 & "grid indices. file "//TRIM(td_coord0%c_name)//" and/or "//& 587 & TRIM(td_coord1%c_name)//" not opened." ) 2037 cl_point='T' 2038 IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 2039 2040 ! copy structure 2041 tl_coord0=mpp_copy(td_coord0) 2042 tl_coord1=mpp_copy(td_coord1) 2043 2044 IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. & 2045 & .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 2046 CALL logger_error("GRID GET COARSE INDEX: can not get coarse "//& 2047 & "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//& 2048 & " and/or "//TRIM(tl_coord1%c_name)//" not defined." ) 588 2049 ELSE 589 !1- Coarse grid 2050 ! Coarse grid 2051 ! get ghost cell factor on coarse grid 2052 il_xghost0(:,:)=grid_get_ghost( tl_coord0 ) 2053 2054 ! open mpp files 2055 CALL iom_mpp_open(tl_coord0) 2056 590 2057 ! read coarse longitue and latitude 591 tl_lon0=iom_read_var(td_coord0,'longitude') 592 tl_lat0=iom_read_var(td_coord0,'latitude') 593 594 ! get ghost cell factor on coarse grid 595 il_xghost0(:)=grid_get_ghost( tl_lon0, tl_lat0 ) 596 597 il_imin0=1+il_xghost0(1)*ig_ghost 598 il_jmin0=1+il_xghost0(2)*ig_ghost 599 600 il_imax0=tl_lon0%t_dim(1)%i_len-il_xghost0(1)*ig_ghost 601 il_jmax0=tl_lon0%t_dim(2)%i_len-il_xghost0(2)*ig_ghost 602 603 CALL var_clean(tl_lon0) 604 CALL var_clean(tl_lat0) 605 606 ! read coarse longitue and latitude without ghost cell 607 il_start(:)=(/il_imin0,il_jmin0,1,1/) 608 il_count(:)=(/il_imax0-il_imin0+1, & 609 & il_jmax0-il_jmin0+1, & 610 & tl_lon0%t_dim(3)%i_len, & 611 & tl_lon0%t_dim(4)%i_len /) 612 613 tl_lon0=iom_read_var(td_coord0,'longitude',il_start(:), il_count(:)) 614 tl_lat0=iom_read_var(td_coord0,'latitude' ,il_start(:), il_count(:)) 2058 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 2059 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 2060 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 2061 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 615 2062 616 !2- Fine grid 2063 CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 2064 CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 2065 2066 ! close mpp files 2067 CALL iom_mpp_close(tl_coord0) 2068 2069 ! Fine grid 2070 2071 ! get ghost cell factor on fine grid 2072 il_xghost1(:,:)=grid_get_ghost( tl_coord1 ) 2073 2074 ! open mpp files 2075 CALL iom_mpp_open(tl_coord1) 2076 617 2077 ! read fine longitue and latitude 618 tl_lon1=iom_read_var(td_coord1,'longitude') 619 tl_lat1=iom_read_var(td_coord1,'latitude') 620 621 ! get ghost cell factor on fine grid 622 il_xghost1(:)=grid_get_ghost( tl_lon1, tl_lat1 ) 623 624 il_imin1=1+il_xghost1(1)*ig_ghost 625 il_jmin1=1+il_xghost1(2)*ig_ghost 626 627 il_imax1=tl_lon1%t_dim(1)%i_len-il_xghost1(1)*ig_ghost 628 il_jmax1=tl_lon1%t_dim(2)%i_len-il_xghost1(2)*ig_ghost 629 630 CALL var_clean(tl_lon1) 631 CALL var_clean(tl_lat1) 632 633 ! read fine longitue and latitude without ghost cell 634 il_start(:)=(/il_imin1,il_jmin1,1,1/) 635 il_count(:)=(/il_imax1-il_imin1+1, & 636 & il_jmax1-il_jmin1+1, & 637 & tl_lon1%t_dim(3)%i_len, & 638 & tl_lon1%t_dim(4)%i_len /) 639 640 tl_lon1=iom_read_var(td_coord1,'longitude',il_start(:), il_count(:)) 641 642 tl_lat1=iom_read_var(td_coord1,'latitude' ,il_start(:), il_count(:)) 2078 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 2079 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 2080 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 2081 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 643 2082 644 !3- compute 645 646 grid_get_coarse_index_ff(:,:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 647 & tl_lon1,tl_lat1,& 648 & il_rho(:) ) 649 650 il_imin0=grid_get_coarse_index_ff(1,1,1)-il_xghost0(1)*ig_ghost 651 il_imax0=grid_get_coarse_index_ff(1,2,1)+il_xghost0(1)*ig_ghost 652 il_jmin0=grid_get_coarse_index_ff(2,1,1)-il_xghost0(2)*ig_ghost 653 il_jmax0=grid_get_coarse_index_ff(2,2,1)+il_xghost0(2)*ig_ghost 654 655 grid_get_coarse_index_ff(1,1,1)=il_imin0 656 grid_get_coarse_index_ff(1,2,1)=il_imax0 657 grid_get_coarse_index_ff(2,1,1)=il_jmin0 658 grid_get_coarse_index_ff(2,2,1)=il_jmax0 2083 CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 2084 CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 2085 2086 ! close mpp files 2087 CALL iom_mpp_close(tl_coord1) 2088 2089 ! compute 2090 grid__get_coarse_index_ff(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 2091 & tl_lon1,tl_lat1,& 2092 & il_rho(:) ) 2093 2094 ! add ghost cell to indices 2095 il_imin0=grid__get_coarse_index_ff(1,1)+il_xghost0(jp_I,1)*ip_ghost 2096 il_imax0=grid__get_coarse_index_ff(1,2)+il_xghost0(jp_I,1)*ip_ghost 2097 2098 il_jmin0=grid__get_coarse_index_ff(2,1)+il_xghost0(jp_J,1)*ip_ghost 2099 il_jmax0=grid__get_coarse_index_ff(2,2)+il_xghost0(jp_J,1)*ip_ghost 2100 2101 grid__get_coarse_index_ff(jp_I,1)=il_imin0 2102 grid__get_coarse_index_ff(jp_I,2)=il_imax0 2103 grid__get_coarse_index_ff(jp_J,1)=il_jmin0 2104 grid__get_coarse_index_ff(jp_J,2)=il_jmax0 659 2105 660 2106 CALL var_clean(tl_lon0) … … 665 2111 ENDIF 666 2112 667 END FUNCTION grid_get_coarse_index_ff 668 !> @endcode 2113 ! clean 2114 CALL mpp_clean(tl_coord0) 2115 CALL mpp_clean(tl_coord1) 2116 DEALLOCATE(il_rho) 2117 2118 END FUNCTION grid__get_coarse_index_ff 669 2119 !------------------------------------------------------------------- 670 2120 !> @brief This function get closest coarse grid indices of fine grid domain. 671 2121 ! 672 2122 !> @details 673 !> 674 ! 2123 !> it use coarse array of longitude and latitude and fine grid coordinates file. 2124 !> optionaly, you could specify the array of refinment factor (default 1.) 2125 !> optionally, you could specify on which Arakawa grid point you want to 2126 !> work (default 'T') 2127 !> 675 2128 !> @author J.Paul 676 !> - Nov, 2013- Initial Version 677 ! 678 !> @param[in] td_longitude0 : coarse grid longitude 679 !> @param[in] td_latitude0 : coarse grid latitude 680 !> @param[in] td_coord1 : fine grid coordinate structure 681 !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 682 !------------------------------------------------------------------- 683 !> @code 684 FUNCTION grid_get_coarse_index_cf( td_lon0, td_lat0, td_coord1, & 685 & id_rho ) 2129 !> - November, 2013- Initial Version 2130 !> @date September, 2014 2131 !> - use grid point to read coordinates variable. 2132 !> @date October, 2014 2133 !> - work on mpp file structure instead of file structure 2134 !> 2135 !> @param[in] td_longitude0 coarse grid longitude 2136 !> @param[in] td_latitude0 coarse grid latitude 2137 !> @param[in] td_coord1 fine grid coordinate mpp structure 2138 !> @param[in] id_rho array of refinment factor 2139 !> @param[in] cd_point Arakawa grid point (default 'T') 2140 !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/) 2141 !------------------------------------------------------------------- 2142 FUNCTION grid__get_coarse_index_cf( td_lon0, td_lat0, td_coord1, & 2143 & id_rho, cd_point ) 686 2144 IMPLICIT NONE 687 2145 ! Argument 688 TYPE(TVAR ), INTENT(IN) :: td_lon0 689 TYPE(TVAR ), INTENT(IN) :: td_lat0 690 TYPE(TFILE), INTENT(IN) :: td_coord1 691 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 2146 TYPE(TVAR ) , INTENT(IN) :: td_lon0 2147 TYPE(TVAR ) , INTENT(IN) :: td_lat0 2148 TYPE(TMPP ) , INTENT(IN) :: td_coord1 2149 INTEGER(i4) , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 2150 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 692 2151 693 2152 ! function 694 INTEGER(i4), DIMENSION(2,2 ,2) :: grid_get_coarse_index_cf2153 INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cf 695 2154 696 2155 ! local variable 2156 TYPE(TMPP) :: tl_coord1 2157 697 2158 TYPE(TVAR) :: tl_lon1 698 2159 TYPE(TVAR) :: tl_lat1 … … 700 2161 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 701 2162 702 INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 703 INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 704 INTEGER(i4), DIMENSION(2) :: il_xghost 705 706 INTEGER(i4) :: il_imin1 707 INTEGER(i4) :: il_imax1 708 INTEGER(i4) :: il_jmin1 709 INTEGER(i4) :: il_jmax1 2163 INTEGER(i4), DIMENSION(2,2) :: il_xghost 2164 2165 CHARACTER(LEN= 1) :: cl_point 2166 CHARACTER(LEN=lc) :: cl_name 710 2167 711 2168 ! loop indices … … 713 2170 714 2171 ! init 715 grid_ get_coarse_index_cf(:,:,:)=0716 717 ALLOCATE(il_rho(i g_ndim) )2172 grid__get_coarse_index_cf(:,:)=0 2173 2174 ALLOCATE(il_rho(ip_maxdim) ) 718 2175 il_rho(:)=1 719 2176 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 720 2177 721 IF( td_coord1%i_id == 0 )THEN 722 CALL logger_error("GRID GET COARSE INDEX: file "//& 723 & TRIM(td_coord1%c_name)//" not opened." ) 2178 ! copy structure 2179 tl_coord1=mpp_copy(td_coord1) 2180 2181 cl_point='T' 2182 IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 2183 2184 IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 2185 CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//& 2186 & "file "//TRIM(tl_coord1%c_name)//" not defined." ) 724 2187 725 2188 ELSE IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. & … … 731 2194 ELSE 732 2195 733 !1- Fine grid 2196 IF( TRIM(td_lon0%c_point)/='' )THEN 2197 cl_point=TRIM(td_lon0%c_point) 2198 ELSEIF( TRIM(td_lat0%c_point)/='' )THEN 2199 cl_point=TRIM(td_lat0%c_point) 2200 ENDIF 2201 2202 ! Fine grid 2203 ! get ghost cell factor on fine grid 2204 il_xghost(:,:)=grid_get_ghost( tl_coord1 ) 2205 2206 ! open mpp files 2207 CALL iom_mpp_open(tl_coord1) 2208 734 2209 ! read fine longitue and latitude 735 tl_lon1=iom_read_var(td_coord1,'longitude') 736 tl_lat1=iom_read_var(td_coord1,'latitude') 737 738 ! get ghost cell factor on fine grid 739 il_xghost(:)=grid_get_ghost( tl_lon1, tl_lat1 ) 740 741 il_imin1=1+il_xghost(1)*ig_ghost 742 il_jmin1=1+il_xghost(2)*ig_ghost 743 744 il_imax1=tl_lon1%t_dim(1)%i_len-il_xghost(1)*ig_ghost 745 il_jmax1=tl_lon1%t_dim(2)%i_len-il_xghost(2)*ig_ghost 746 747 CALL var_clean(tl_lon1) 748 CALL var_clean(tl_lat1) 749 750 ! read fine longitue and latitude without ghost cell 751 il_start(:)=(/il_imin1,il_jmin1,1,1/) 752 il_count(:)=(/il_imax1-il_imin1+1, & 753 & il_jmax1-il_jmin1+1, & 754 & tl_lon1%t_dim(3)%i_len, & 755 & tl_lon1%t_dim(4)%i_len /) 756 757 tl_lon1=iom_read_var(td_coord1,'longitude',il_start(:), il_count(:)) 758 tl_lat1=iom_read_var(td_coord1,'latitude' ,il_start(:), il_count(:)) 2210 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 2211 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 2212 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 2213 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 759 2214 760 !3- compute 761 grid_get_coarse_index_cf(:,:,:)=grid_get_coarse_index(td_lon0,td_lat0,& 762 & tl_lon1,tl_lat1,& 763 & il_rho(:) ) 764 2215 CALL grid_del_ghost(tl_lon1, il_xghost(:,:)) 2216 CALL grid_del_ghost(tl_lat1, il_xghost(:,:)) 2217 2218 ! close mpp files 2219 CALL iom_mpp_close(tl_coord1) 2220 2221 ! compute 2222 grid__get_coarse_index_cf(:,:)=grid_get_coarse_index(td_lon0,td_lat0,& 2223 & tl_lon1,tl_lat1,& 2224 & il_rho(:), cl_point ) 2225 2226 765 2227 CALL var_clean(tl_lon1) 766 2228 CALL var_clean(tl_lat1) … … 768 2230 ENDIF 769 2231 770 END FUNCTION grid_get_coarse_index_cf 771 !> @endcode 2232 DEALLOCATE(il_rho) 2233 CALL mpp_clean(tl_coord1) 2234 2235 END FUNCTION grid__get_coarse_index_cf 772 2236 !------------------------------------------------------------------- 773 2237 !> @brief This function get closest coarse grid indices of fine grid domain. 774 2238 ! 775 2239 !> @details 776 !> 777 !> @warning use ghost cell so can not be used on extracted domain without 778 !> ghost cell 779 ! 2240 !> it use coarse grid coordinates file and fine grid array of longitude and latitude. 2241 !> optionaly, you could specify the array of refinment factor (default 1.) 2242 !> optionally, you could specify on which Arakawa grid point you want to 2243 !> work (default 'T') 2244 !> 780 2245 !> @author J.Paul 781 !> - Nov, 2013- Initial Version 782 ! 783 !> @param[in] td_coord0 : coarse grid coordinate structure 784 !> @param[in] td_lon1 : fine grid longitude 785 !> @param[in] td_lat1 : fine grid latitude 786 !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 787 !------------------------------------------------------------------- 788 !> @code 789 FUNCTION grid_get_coarse_index_fc( td_coord0, td_lon1, td_lat1, & 790 & id_rho ) 2246 !> - November, 2013- Initial Version 2247 !> @date September, 2014 2248 !> - use grid point to read coordinates variable. 2249 !> @date October, 2014 2250 !> - work on mpp file structure instead of file structure 2251 !> 2252 !> @param[in] td_coord0 coarse grid coordinate mpp structure 2253 !> @param[in] td_lon1 fine grid longitude 2254 !> @param[in] td_lat1 fine grid latitude 2255 !> @param[in] id_rho array of refinment factor (default 1.) 2256 !> @param[in] cd_point Arakawa grid point (default 'T') 2257 !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/) 2258 !------------------------------------------------------------------- 2259 FUNCTION grid__get_coarse_index_fc( td_coord0, td_lon1, td_lat1, & 2260 & id_rho, cd_point ) 791 2261 IMPLICIT NONE 792 2262 ! Argument 793 TYPE(TFILE), INTENT(IN) :: td_coord0 794 TYPE(TVAR ), INTENT(IN) :: td_lon1 795 TYPE(TVAR ), INTENT(IN) :: td_lat1 796 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 2263 TYPE(TMPP ) , INTENT(IN) :: td_coord0 2264 TYPE(TVAR ) , INTENT(IN) :: td_lon1 2265 TYPE(TVAR ) , INTENT(IN) :: td_lat1 2266 INTEGER(i4) , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 2267 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 797 2268 798 2269 ! function 799 INTEGER(i4), DIMENSION(2,2 ,2) :: grid_get_coarse_index_fc2270 INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_fc 800 2271 801 2272 ! local variable 2273 TYPE(TMPP) :: tl_coord0 2274 802 2275 TYPE(TVAR) :: tl_lon0 803 2276 TYPE(TVAR) :: tl_lat0 … … 805 2278 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 806 2279 807 INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 808 INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 809 INTEGER(i4), DIMENSION(2) :: il_xghost 2280 INTEGER(i4), DIMENSION(2,2) :: il_xghost 810 2281 811 2282 INTEGER(i4) :: il_imin0 … … 814 2285 INTEGER(i4) :: il_jmax0 815 2286 2287 CHARACTER(LEN= 1) :: cl_point 2288 CHARACTER(LEN=lc) :: cl_name 816 2289 817 2290 ! loop indices … … 819 2292 820 2293 ! init 821 grid_ get_coarse_index_fc(:,:,:)=0822 823 ALLOCATE(il_rho(i g_ndim))2294 grid__get_coarse_index_fc(:,:)=0 2295 2296 ALLOCATE(il_rho(ip_maxdim)) 824 2297 il_rho(:)=1 825 2298 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 826 2299 827 IF( td_coord0%i_id == 0 )THEN 828 CALL logger_error("GRID GET COARSE INDEX: file "//& 829 & TRIM(td_coord0%c_name)//" not opened." ) 2300 cl_point='T' 2301 IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 2302 2303 ! copy structure 2304 tl_coord0=mpp_copy(td_coord0) 2305 2306 IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN 2307 CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//& 2308 & "file "//TRIM(tl_coord0%c_name)//" not defined." ) 830 2309 831 2310 ELSE IF( .NOT. ASSOCIATED(td_lon1%d_value) .OR. & … … 836 2315 837 2316 ELSE 2317 2318 IF( TRIM(td_lon1%c_point)/='' )THEN 2319 cl_point=TRIM(td_lon1%c_point) 2320 ELSEIF( TRIM(td_lat1%c_point)/='' )THEN 2321 cl_point=TRIM(td_lat1%c_point) 2322 ENDIF 2323 2324 ! get ghost cell factor on coarse grid 2325 il_xghost(:,:)=grid_get_ghost( tl_coord0 ) 2326 2327 ! open mpp files 2328 CALL iom_mpp_open(tl_coord0) 2329 838 2330 ! read coarse longitue and latitude 839 tl_lon0=iom_read_var(td_coord0,'longitude') 840 tl_lat0=iom_read_var(td_coord0,'latitude') 841 842 ! get ghost cell factor on coarse grid 843 il_xghost(:)=grid_get_ghost( tl_lon0, tl_lat0 ) 844 845 il_imin0=1+il_xghost(1)*ig_ghost 846 il_jmin0=1+il_xghost(2)*ig_ghost 847 848 il_imax0=tl_lon0%t_dim(1)%i_len-il_xghost(1)*ig_ghost 849 il_jmax0=tl_lon0%t_dim(2)%i_len-il_xghost(2)*ig_ghost 2331 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 2332 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 2333 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 2334 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 2335 2336 CALL grid_del_ghost(tl_lon0, il_xghost(:,:)) 2337 CALL grid_del_ghost(tl_lat0, il_xghost(:,:)) 2338 2339 ! close mpp files 2340 CALL iom_mpp_close(tl_coord0) 2341 2342 grid__get_coarse_index_fc(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 2343 & td_lon1,td_lat1,& 2344 & il_rho(:), cl_point ) 2345 2346 ! remove ghost cell 2347 il_imin0=grid__get_coarse_index_fc(1,1)+il_xghost(jp_I,1)*ip_ghost 2348 il_imax0=grid__get_coarse_index_fc(1,2)+il_xghost(jp_I,1)*ip_ghost 2349 2350 il_jmin0=grid__get_coarse_index_fc(2,1)+il_xghost(jp_J,1)*ip_ghost 2351 il_jmax0=grid__get_coarse_index_fc(2,2)+il_xghost(jp_J,1)*ip_ghost 2352 2353 grid__get_coarse_index_fc(1,1)=il_imin0 2354 grid__get_coarse_index_fc(1,2)=il_imax0 2355 grid__get_coarse_index_fc(2,1)=il_jmin0 2356 grid__get_coarse_index_fc(2,2)=il_jmax0 850 2357 851 2358 CALL var_clean(tl_lon0) 852 2359 CALL var_clean(tl_lat0) 853 2360 854 ! read coarse longitue and latitude without ghost cell 855 il_start(:)=(/il_imin0,il_jmin0,1,1/) 856 il_count(:)=(/il_imax0-il_imin0+1, & 857 & il_jmax0-il_jmin0+1, & 858 & tl_lon0%t_dim(3)%i_len, & 859 & tl_lon0%t_dim(4)%i_len /) 860 861 tl_lon0=iom_read_var(td_coord0,'longitude',il_start(:), il_count(:)) 862 tl_lat0=iom_read_var(td_coord0,'latitude' ,il_start(:), il_count(:)) 863 864 grid_get_coarse_index_fc(:,:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,& 865 & td_lon1,td_lat1,& 866 & il_rho(:) ) 867 868 ! remove ghost cell 869 il_imin0=grid_get_coarse_index_fc(1,1,1)+il_xghost(1)*ig_ghost 870 il_imax0=grid_get_coarse_index_fc(1,2,1)+il_xghost(1)*ig_ghost 871 il_jmin0=grid_get_coarse_index_fc(2,1,1)+il_xghost(2)*ig_ghost 872 il_jmax0=grid_get_coarse_index_fc(2,2,1)+il_xghost(2)*ig_ghost 873 874 grid_get_coarse_index_fc(1,1,1)=il_imin0 875 grid_get_coarse_index_fc(1,2,1)=il_imax0 876 grid_get_coarse_index_fc(2,1,1)=il_jmin0 877 grid_get_coarse_index_fc(2,2,1)=il_jmax0 878 879 CALL var_clean(tl_lon0) 880 CALL var_clean(tl_lat0) 881 882 ENDIF 883 884 END FUNCTION grid_get_coarse_index_fc 885 !> @endcode 2361 ENDIF 2362 2363 CALL mpp_clean(tl_coord0) 2364 DEALLOCATE(il_rho) 2365 2366 END FUNCTION grid__get_coarse_index_fc 886 2367 !------------------------------------------------------------------- 887 2368 !> @brief This function get closest coarse grid indices of fine grid domain. 888 2369 ! 889 2370 !> @details 890 !> 891 !> @warning use ghost cell so can not be used on extracted domain without 892 !> ghost cell 893 ! 2371 !> it use coarse and fine grid array of longitude and latitude. 2372 !> optionaly, you could specify the array of refinment factor (default 1.) 2373 !> optionally, you could specify on which Arakawa grid point you want to 2374 !> work (default 'T') 2375 !> 2376 !> @note do not use ghost cell 2377 !> 894 2378 !> @author J.Paul 895 !> - Nov, 2013- Initial Version 896 ! 897 !> @param[in] td_lon0 : coarse grid longitude 898 !> @param[in] td_lat0 : coarse grid latitude 899 !> @param[in] td_lon1 : fine grid longitude 900 !> @param[in] td_lat1 : fine grid latitude 901 !> @return coarse grid indices (/ (/imin0, imax0/), (/jmin0, jmax0/) /) 902 !> 903 !------------------------------------------------------------------- 904 !> @code 905 FUNCTION grid_get_coarse_index_cc( td_lon0, td_lat0, td_lon1, td_lat1, & 906 & id_rho ) 2379 !> - November, 2013- Initial Version 2380 !> @date September, 2014 2381 !> - check grid point 2382 !> - take into account EW overlap 2383 !> 2384 !> @param[in] td_lon0 coarse grid longitude 2385 !> @param[in] td_lat0 coarse grid latitude 2386 !> @param[in] td_lon1 fine grid longitude 2387 !> @param[in] td_lat1 fine grid latitude 2388 !> @param[in] id_rho array of refinment factor 2389 !> @param[in] cd_point Arakawa grid point ('T','U','V','F') 2390 !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/) 2391 !> 2392 !> @todo 2393 !> -check case boundary domain on overlap band 2394 !------------------------------------------------------------------- 2395 FUNCTION grid__get_coarse_index_cc( td_lon0, td_lat0, td_lon1, td_lat1, & 2396 & id_rho, cd_point ) 907 2397 IMPLICIT NONE 908 2398 ! Argument 909 TYPE(TVAR) , INTENT(IN) :: td_lon0 910 TYPE(TVAR) , INTENT(IN) :: td_lat0 911 TYPE(TVAR) , INTENT(IN) :: td_lon1 912 TYPE(TVAR) , INTENT(IN) :: td_lat1 913 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 2399 TYPE(TVAR) , INTENT(IN) :: td_lon0 2400 TYPE(TVAR) , INTENT(IN) :: td_lat0 2401 TYPE(TVAR) , INTENT(IN) :: td_lon1 2402 TYPE(TVAR) , INTENT(IN) :: td_lat1 2403 INTEGER(i4) , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 2404 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 914 2405 915 2406 ! function 916 INTEGER(i4), DIMENSION(2,2 ,2) :: grid_get_coarse_index_cc2407 INTEGER(i4), DIMENSION(2,2) :: grid__get_coarse_index_cc 917 2408 918 2409 ! local variable … … 927 2418 REAL(dp) :: dl_lat1_ur 928 2419 929 REAL(dp) :: dl_dlon930 REAL(dp) :: dl_dlat931 932 2420 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 933 2421 … … 954 2442 INTEGER(i4) :: il_jmax 955 2443 956 INTEGER(i4), DIMENSION(2,2) :: il_offset 957 2444 INTEGER(i4), DIMENSION(2,2) :: il_xghost0 2445 INTEGER(i4), DIMENSION(2,2) :: il_yghost0 2446 INTEGER(i4), DIMENSION(2,2) :: il_xghost1 2447 INTEGER(i4), DIMENSION(2,2) :: il_yghost1 2448 2449 TYPE(TVAR) :: tl_lon0 2450 TYPE(TVAR) :: tl_lat0 2451 TYPE(TVAR) :: tl_lon1 2452 TYPE(TVAR) :: tl_lat1 2453 2454 CHARACTER(LEN= 1) :: cl_point0 2455 CHARACTER(LEN= 1) :: cl_point1 2456 958 2457 ! loop indices 959 2458 INTEGER(i4) :: ji 960 2459 INTEGER(i4) :: jj 961 2460 !---------------------------------------------------------------- 962 963 2461 ! init 964 grid_ get_coarse_index_cc(:,:,:)=0965 966 ALLOCATE( il_rho(i g_ndim) )2462 grid__get_coarse_index_cc(:,:)=0 2463 2464 ALLOCATE( il_rho(ip_maxdim) ) 967 2465 il_rho(:)=1 968 2466 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 969 2467 2468 cl_point0='T' 2469 cl_point1='T' 2470 IF( PRESENT(cd_point) )THEN 2471 cl_point0=TRIM(fct_upper(cd_point)) 2472 cl_point1=TRIM(fct_upper(cd_point)) 2473 ENDIF 2474 970 2475 IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. & 971 2476 & .NOT. ASSOCIATED(td_lat0%d_value) .OR. & … … 976 2481 ELSE 977 2482 2483 IF( TRIM(td_lon0%c_point)/='' )THEN 2484 cl_point0=TRIM(td_lon0%c_point) 2485 ELSEIF( TRIM(td_lat0%c_point)/='' )THEN 2486 cl_point0=TRIM(td_lat0%c_point) 2487 ENDIF 2488 IF( TRIM(td_lon1%c_point)/='' )THEN 2489 cl_point1=TRIM(td_lon1%c_point) 2490 ELSEIF( TRIM(td_lat1%c_point)/='' )THEN 2491 cl_point1=TRIM(td_lat1%c_point) 2492 ENDIF 2493 IF( cl_point0 /= cl_point1 )THEN 2494 CALL logger_error("GRID GET COARSE INDEX: fine and coarse grid"//& 2495 & " coordinate not on same grid point.") 2496 ENDIF 2497 978 2498 IF( grid_is_global(td_lon1, td_lat1) )THEN 979 2499 980 2500 IF( grid_is_global(td_lon0, td_lat0) )THEN 981 2501 CALL logger_trace("GRID GET COARSE INDEX: fine grid is global ") 982 grid_ get_coarse_index_cc(:,:,1) = 1983 grid_ get_coarse_index_cc(:,:,2) = 02502 grid__get_coarse_index_cc(:,:) = 1 2503 grid__get_coarse_index_cc(:,:) = 0 984 2504 ELSE 985 2505 CALL logger_error("GRID GET COARSE INDEX: fine grid is "//& … … 989 2509 ELSE 990 2510 2511 il_xghost0(:,:)=grid_get_ghost( td_lon0 ) 2512 il_yghost0(:,:)=grid_get_ghost( td_lat0 ) 2513 IF( ANY(il_xghost0(:,:) /= il_yghost0(:,:)) )THEN 2514 CALL logger_error("GRID GET COARSE INDEX: coarse grid "//& 2515 & "coordinate do not share same ghost cell") 2516 ENDIF 2517 2518 tl_lon0=var_copy(td_lon0) 2519 tl_lat0=var_copy(td_lat0) 2520 CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 2521 CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 2522 991 2523 ! "global" coarse grid indice 992 2524 il_imin0=1 993 2525 il_jmin0=1 994 2526 995 il_imax0=t d_lon0%t_dim(1)%i_len996 il_jmax0=t d_lon0%t_dim(2)%i_len2527 il_imax0=tl_lon0%t_dim(1)%i_len 2528 il_jmax0=tl_lon0%t_dim(2)%i_len 997 2529 998 2530 ! get east west overlap for coarse grid 999 il_ew0= dom_get_ew_overlap(td_lon0)2531 il_ew0=tl_lon0%i_ew 1000 2532 IF( il_ew0 >= 0 )THEN 1001 2533 ! last point before overlap … … 1003 2535 ENDIF 1004 2536 2537 il_xghost1(:,:)=grid_get_ghost( td_lon1 ) 2538 il_yghost1(:,:)=grid_get_ghost( td_lat1 ) 2539 IF( ANY(il_xghost1(:,:) /= il_yghost1(:,:)) )THEN 2540 CALL logger_error("GRID GET COARSE INDEX: fine grid "//& 2541 & "coordinate do not share same ghost cell") 2542 ENDIF 2543 2544 tl_lon1=var_copy(td_lon1) 2545 tl_lat1=var_copy(td_lat1) 2546 CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 2547 CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 2548 1005 2549 ! "global" fine grid indice 1006 2550 il_imin1=1 1007 2551 il_jmin1=1 1008 2552 1009 il_imax1=t d_lon1%t_dim(1)%i_len1010 il_jmax1=t d_lon1%t_dim(2)%i_len1011 1012 ! get east west overlap for coarse grid1013 il_ew1= dom_get_ew_overlap(td_lon1)2553 il_imax1=tl_lon1%t_dim(1)%i_len 2554 il_jmax1=tl_lon1%t_dim(2)%i_len 2555 2556 ! get east west overlap for fine grid 2557 il_ew1=tl_lon1%i_ew 1014 2558 IF( il_ew1 >= 0 )THEN 1015 2559 ! last point before overlap … … 1019 2563 ! get indices for each corner 1020 2564 !1- search lower left corner indices 1021 dl_lon1_ll=td_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 1022 dl_lat1_ll=td_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 1023 1024 dl_dlon=ABS(td_lon1%d_value(il_imin1+1,il_jmin1 ,1,1)-dl_lon1_ll) 1025 dl_dlat=ABS(td_lat1%d_value(il_imin1 ,il_jmin1+1,1,1)-dl_lat1_ll) 1026 1027 ! CALL logger_debug("GRID GET COARSE INDEX: lon1 ll "//& 1028 ! & TRIM(fct_str(dl_lon1_ll)) ) 1029 ! CALL logger_debug("GRID GET COARSE INDEX: lat1 ll "//& 1030 ! & TRIM(fct_str(dl_lat1_ll)) ) 1031 ! 1032 ! CALL logger_debug("GRID GET COARSE INDEX: lon0 min "//& 1033 ! & TRIM(fct_str(minval(td_lon0%d_value(2:,2:,:,:)))) ) 1034 ! CALL logger_debug("GRID GET COARSE INDEX: lon0 max "//& 1035 ! & TRIM(fct_str(maxval(td_lon0%d_value(2:,2:,:,:)))) ) 1036 ! 1037 ! CALL logger_debug("GRID GET COARSE INDEX: lat0 min "//& 1038 ! & TRIM(fct_str(minval(td_lat0%d_value(2:,2:,:,:)))) ) 1039 ! CALL logger_debug("GRID GET COARSE INDEX: lat0 max "//& 1040 ! & TRIM(fct_str(maxval(td_lat0%d_value(2:,2:,:,:)))) ) 1041 2565 dl_lon1_ll=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 ) 2566 dl_lat1_ll=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 ) 2567 2568 IF( dl_lon1_ll == tl_lon1%d_fill .OR. & 2569 & dl_lat1_ll == tl_lat1%d_fill )THEN 2570 CALL logger_error("GRID GET COARSE INDEX: lower left corner "//& 2571 & "point is FillValue. remove ghost cell "//& 2572 & "before running grid_get_coarse_index.") 2573 ENDIF 1042 2574 ! look for closest point on coarse grid 1043 il_ill(:)= grid_get_closest(t d_lon0%d_value(il_imin0:il_imax0, &2575 il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 1044 2576 & il_jmin0:il_jmax0, & 1045 2577 & 1,1), & 1046 & t d_lat0%d_value(il_imin0:il_imax0, &2578 & tl_lat0%d_value(il_imin0:il_imax0, & 1047 2579 & il_jmin0:il_jmax0, & 1048 2580 & 1,1), & … … 1053 2585 jj = il_ill(2) 1054 2586 1055 IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dl_dlon*1.e-3 )THEN 1056 IF(td_lon0%d_value(ji,jj,1,1) > dl_lon1_ll ) il_ill(1)=il_ill(1)-1 2587 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ll) > dp_delta )THEN 2588 IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ll )THEN 2589 il_ill(1)=il_ill(1)-1 2590 IF( il_ill(1) <= 0 )THEN 2591 IF( tl_lon0%i_ew >= 0 )THEN 2592 il_ill(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 2593 ELSE 2594 CALL logger_error("GRID GET COARSE INDEX: error "//& 2595 & "computing lower left corner "//& 2596 & "index for longitude") 2597 ENDIF 2598 ENDIF 2599 ENDIF 1057 2600 ENDIF 1058 IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dl_dlat*1.e-3 )THEN 1059 IF(td_lat0%d_value(ji,jj,1,1) > dl_lat1_ll ) il_ill(2)=il_ill(2)-1 2601 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ll) > dp_delta )THEN 2602 IF(tl_lat0%d_value(ji,jj,1,1) > dl_lat1_ll )THEN 2603 il_ill(2)=il_ill(2)-1 2604 IF( il_ill(2)-1 <= 0 )THEN 2605 CALL logger_error("GRID GET COARSE INDEX: error "//& 2606 & "computing lower left corner "//& 2607 & "index for latitude") 2608 ENDIF 2609 ENDIF 1060 2610 ENDIF 1061 2611 1062 2612 !2- search upper left corner indices 1063 dl_lon1_ul=td_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 1064 dl_lat1_ul=td_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 1065 1066 dl_dlon=ABS(td_lon1%d_value(il_imin1+1,il_jmax1 ,1,1)-dl_lon1_ll) 1067 dl_dlat=ABS(td_lat1%d_value(il_imin1 ,il_jmax1-1,1,1)-dl_lat1_ll) 1068 2613 dl_lon1_ul=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 ) 2614 dl_lat1_ul=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 ) 2615 2616 IF( dl_lon1_ul == tl_lon1%d_fill .OR. & 2617 & dl_lat1_ul == tl_lat1%d_fill )THEN 2618 CALL logger_error("GRID GET COARSE INDEX: upper left corner "//& 2619 & "point is FillValue. remove ghost cell "//& 2620 & "running grid_get_coarse_index.") 2621 ENDIF 1069 2622 ! look for closest point on coarse grid 1070 il_iul(:)= grid_get_closest(t d_lon0%d_value(il_imin0:il_imax0, &2623 il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 1071 2624 & il_jmin0:il_jmax0, & 1072 2625 & 1,1), & 1073 & t d_lat0%d_value(il_imin0:il_imax0, &2626 & tl_lat0%d_value(il_imin0:il_imax0, & 1074 2627 & il_jmin0:il_jmax0, & 1075 2628 & 1,1), & … … 1080 2633 jj = il_iul(2) 1081 2634 1082 IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dl_dlon*1.e-3 )THEN 1083 IF(td_lon0%d_value(ji,jj,1,1) > dl_lon1_ul ) il_iul(1)=il_iul(1)-1 2635 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ul) > dp_delta )THEN 2636 IF(tl_lon0%d_value(ji,jj,1,1) > dl_lon1_ul )THEN 2637 il_iul(1)=il_iul(1)-1 2638 IF( il_iul(1) <= 0 )THEN 2639 IF( tl_lon0%i_ew >= 0 )THEN 2640 il_iul(1)=tl_lon0%t_dim(jp_I)%i_len-tl_lon0%i_ew 2641 ELSE 2642 CALL logger_error("GRID GET COARSE INDEX: error "//& 2643 & "computing upper left corner "//& 2644 & "index for longitude") 2645 ENDIF 2646 ENDIF 2647 ENDIF 1084 2648 ENDIF 1085 IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dl_dlat*1.e-3 )THEN 1086 IF(td_lat0%d_value(ji,jj,1,1) < dl_lat1_ul ) il_iul(2)=il_iul(2)+1 2649 2650 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ul) > dp_delta )THEN 2651 IF(tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ul )THEN 2652 il_iul(2)=il_iul(2)+1 2653 IF( il_ill(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 2654 CALL logger_error("GRID GET COARSE INDEX: error "//& 2655 & "computing upper left corner "//& 2656 & "index for latitude") 2657 ENDIF 2658 ENDIF 1087 2659 ENDIF 1088 2660 1089 2661 !3- search lower right corner indices 1090 dl_lon1_lr=td_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 1091 dl_lat1_lr=td_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 1092 1093 dl_dlon=ABS(td_lon1%d_value(il_imax1-1,il_jmin1 ,1,1)-dl_lon1_ll) 1094 dl_dlat=ABS(td_lat1%d_value(il_imax1 ,il_jmin1+1,1,1)-dl_lat1_ll) 1095 2662 dl_lon1_lr=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 ) 2663 dl_lat1_lr=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 ) 2664 2665 IF( dl_lon1_lr == tl_lon1%d_fill .OR. & 2666 & dl_lat1_lr == tl_lat1%d_fill )THEN 2667 CALL logger_error("GRID GET COARSE INDEX: lower right corner "//& 2668 & "point is FillValue. remove ghost cell "//& 2669 & "running grid_get_coarse_index.") 2670 ENDIF 1096 2671 ! look for closest point on coarse grid 1097 il_ilr(:)= grid_get_closest(t d_lon0%d_value(il_imin0:il_imax0, &2672 il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 1098 2673 & il_jmin0:il_jmax0, & 1099 2674 & 1,1), & 1100 & t d_lat0%d_value(il_imin0:il_imax0, &2675 & tl_lat0%d_value(il_imin0:il_imax0, & 1101 2676 & il_jmin0:il_jmax0, & 1102 2677 & 1,1), & … … 1106 2681 ji = il_ilr(1) 1107 2682 jj = il_ilr(2) 1108 IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dl_dlon*1.e-3 )THEN 1109 IF( td_lon0%d_value(ji,jj,1,1) < dl_lon1_lr ) il_ilr(1)=il_ilr(1)+1 2683 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_lr) > dp_delta )THEN 2684 IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_lr )THEN 2685 il_ilr(1)=il_ilr(1)+1 2686 IF( il_ilr(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 2687 IF( tl_lon0%i_ew >= 0 )THEN 2688 il_ilr(1)=tl_lon0%i_ew+1 2689 ELSE 2690 CALL logger_error("GRID GET COARSE INDEX: error "//& 2691 & "computing lower right corner "//& 2692 & "index for longitude") 2693 ENDIF 2694 ENDIF 2695 ENDIF 1110 2696 ENDIF 1111 IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dl_dlat*1.e-3 )THEN 1112 IF( td_lat0%d_value(ji,jj,1,1) > dl_lat1_lr ) il_ilr(2)=il_ilr(2)-1 2697 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_lr) > dp_delta )THEN 2698 IF( tl_lat0%d_value(ji,jj,1,1) > dl_lat1_lr )THEN 2699 il_ilr(2)=il_ilr(2)-1 2700 IF( il_ilr(2) <= 0 )THEN 2701 CALL logger_error("GRID GET COARSE INDEX: error "//& 2702 & "computing lower right corner "//& 2703 & "index for latitude") 2704 ENDIF 2705 ENDIF 1113 2706 ENDIF 1114 2707 1115 2708 !4- search upper right corner indices 1116 dl_lon1_ur=td_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 1117 dl_lat1_ur=td_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 1118 1119 dl_dlon=ABS(td_lon1%d_value(il_imax1-1,il_jmax1 ,1,1)-dl_lon1_ll) 1120 dl_dlat=ABS(td_lat1%d_value(il_imax1 ,il_jmax1-1,1,1)-dl_lat1_ll) 1121 2709 dl_lon1_ur=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 ) 2710 dl_lat1_ur=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 ) 2711 2712 IF( dl_lon1_ur == tl_lon1%d_fill .OR. & 2713 & dl_lat1_ur == tl_lat1%d_fill )THEN 2714 CALL logger_error("GRID GET COARSE INDEX: upper right corner "//& 2715 & "point is FillValue. remove ghost cell "//& 2716 & "running grid_get_coarse_index.") 2717 ENDIF 1122 2718 ! look for closest point on coarse grid 1123 il_iur(:)= grid_get_closest(t d_lon0%d_value(il_imin0:il_imax0, &2719 il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, & 1124 2720 & il_jmin0:il_jmax0, & 1125 2721 & 1,1), & 1126 & t d_lat0%d_value(il_imin0:il_imax0, &2722 & tl_lat0%d_value(il_imin0:il_imax0, & 1127 2723 & il_jmin0:il_jmax0, & 1128 2724 & 1,1), & … … 1132 2728 ji = il_iur(1) 1133 2729 jj = il_iur(2) 1134 IF( ABS(td_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dl_dlon*1.e-3 )THEN 1135 IF( td_lon0%d_value(ji,jj,1,1) < dl_lon1_ur ) il_iur(1)=il_iur(1)+1 2730 IF( ABS(tl_lon0%d_value(ji,jj,1,1)-dl_lon1_ur) > dp_delta )THEN 2731 IF( tl_lon0%d_value(ji,jj,1,1) < dl_lon1_ur )THEN 2732 il_iur(1)=il_iur(1)+1 2733 IF( il_iur(1) > tl_lon0%t_dim(jp_I)%i_len )THEN 2734 IF( tl_lon0%i_ew >= 0 )THEN 2735 il_iur(1)=tl_lon0%i_ew+1 2736 ELSE 2737 CALL logger_error("GRID GET COARSE INDEX: error "//& 2738 & "computing upper right corner "//& 2739 & "index for longitude") 2740 ENDIF 2741 ENDIF 2742 ENDIF 1136 2743 ENDIF 1137 IF( ABS(td_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dl_dlat*1.e-3 )THEN 1138 IF( td_lat0%d_value(ji,jj,1,1) < dl_lat1_ur ) il_iur(2)=il_iur(2)+1 2744 IF( ABS(tl_lat0%d_value(ji,jj,1,1)-dl_lat1_ur) > dp_delta )THEN 2745 IF( tl_lat0%d_value(ji,jj,1,1) < dl_lat1_ur )THEN 2746 il_iur(2)=il_iur(2)+1 2747 IF( il_iur(2) > tl_lat0%t_dim(jp_J)%i_len )THEN 2748 CALL logger_error("GRID GET COARSE INDEX: error "//& 2749 & "computing upper right corner "//& 2750 & "index for latitude") 2751 ENDIF 2752 ENDIF 1139 2753 ENDIF 1140 2754 … … 1144 2758 1145 2759 IF( il_imax <= il_ew0 )THEN 1146 il_imax = td_lon0%t_dim(1)%i_len - il_ew0 + il_imax 2760 !il_imin = 1 2761 il_imax = tl_lon0%t_dim(1)%i_len - il_ew0 + il_imax 1147 2762 ENDIF 1148 2763 1149 2764 il_jmin = il_jmin0-1+MIN(il_ill(2), il_ilr(2)) 1150 2765 il_jmax = il_jmin0-1+MAX(il_iul(2), il_iur(2)) 1151 1152 il_offset(:,:)= grid_get_fine_offset( td_lon0%d_value( :,:,1,1 ), &1153 & td_lat0%d_value( :,:,1,1 ), &1154 & il_imin, il_jmin, &1155 & il_imax, il_jmax, &1156 & td_lon1%d_value( :,:,1,1 ), &1157 & td_lat1%d_value( :,:,1,1 ), &1158 & il_rho(:) )1159 1160 grid_get_coarse_index_cc(1,1,2) = il_offset(1,1)1161 grid_get_coarse_index_cc(1,2,2) = il_offset(1,2)1162 1163 grid_get_coarse_index_cc(2,1,2) = il_offset(2,1)1164 grid_get_coarse_index_cc(2,2,2) = il_offset(2,2)1165 2766 1166 2767 ! special case if east west overlap … … 1170 2771 1171 2772 il_imin = 1 1172 il_imax = 1 1173 1174 grid_get_coarse_index_cc(1,1,2) = 0 1175 grid_get_coarse_index_cc(1,2,2) = 0 2773 il_imax = tl_lon0%t_dim(1)%i_len 2774 1176 2775 ENDIF 1177 1178 2776 ENDIF 1179 2777 1180 IF( il_imin == il_imax ) il_imax=td_lon0%t_dim(1)%i_len 1181 IF( il_jmin == il_jmax ) il_jmax=td_lon0%t_dim(2)%i_len 1182 1183 grid_get_coarse_index_cc(1,1,1) = il_imin 1184 grid_get_coarse_index_cc(1,2,1) = il_imax 1185 1186 grid_get_coarse_index_cc(2,1,1) = il_jmin 1187 grid_get_coarse_index_cc(2,2,1) = il_jmax 2778 grid__get_coarse_index_cc(1,1) = il_imin 2779 grid__get_coarse_index_cc(1,2) = il_imax 2780 2781 grid__get_coarse_index_cc(2,1) = il_jmin 2782 grid__get_coarse_index_cc(2,2) = il_jmax 1188 2783 1189 ENDIF 1190 1191 END FUNCTION grid_get_coarse_index_cc 1192 !> @endcode 2784 ! clean 2785 CALL var_clean(tl_lon1) 2786 CALL var_clean(tl_lat1) 2787 CALL var_clean(tl_lon0) 2788 CALL var_clean(tl_lat0) 2789 ENDIF 2790 2791 DEALLOCATE( il_rho ) 2792 2793 END FUNCTION grid__get_coarse_index_cc 1193 2794 !------------------------------------------------------------------- 1194 2795 !> @brief This function check if grid is global or not … … 1197 2798 ! 1198 2799 !> @author J.Paul 1199 !> - Nov, 2013- Initial Version 1200 ! 1201 !> @param[in] td_lon : longitude structure 1202 !> @param[in] td_lat : latitude structure 1203 !------------------------------------------------------------------- 1204 !> @code 2800 !> - November, 2013- Initial Version 2801 ! 2802 !> @param[in] td_lon longitude structure 2803 !> @param[in] td_lat latitude structure 2804 !------------------------------------------------------------------- 1205 2805 FUNCTION grid_is_global(td_lon, td_lat) 1206 2806 IMPLICIT NONE … … 1233 2833 IF( .NOT. ASSOCIATED(td_lon%d_value) .OR. & 1234 2834 & .NOT. ASSOCIATED(td_lat%d_value) )THEN 1235 CALL logger_error("GRID IS GLOBAL: n avalue associated to "//&2835 CALL logger_error("GRID IS GLOBAL: no value associated to "//& 1236 2836 & " longitude or latitude strucutre") 1237 2837 ELSE … … 1256 2856 1257 2857 END FUNCTION grid_is_global 1258 !> @endcode1259 1260 2858 !------------------------------------------------------------------- 1261 2859 !> @brief This function return coarse grid indices of the closest point 1262 2860 !> from fine grid point (lon1,lat1) 1263 2861 !> 1264 !1265 2862 !> @details 1266 ! 1267 !> @note overlap band should have been already removed from coarse grid table2863 !> 2864 !> @note overlap band should have been already removed from coarse grid array 1268 2865 !> of longitude and latitude, before running this function 1269 2866 !> 1270 2867 !> @author J.Paul 1271 !> - Nov , 2013- Initial Version1272 ! 1273 !> @param[in] dd_lon0 : coarse grid tableof longitude1274 !> @param[in] dd_lat0 : coarse grid tableof latitude1275 !> @param[in] dd_lon1 :fine grid longitude1276 !> @param[in] dd_lat1 :fine grid latitude2868 !> - November, 2013- Initial Version 2869 ! 2870 !> @param[in] dd_lon0 coarse grid array of longitude 2871 !> @param[in] dd_lat0 coarse grid array of latitude 2872 !> @param[in] dd_lon1 fine grid longitude 2873 !> @param[in] dd_lat1 fine grid latitude 1277 2874 !> @return coarse grid indices of closest point of fine grid point 1278 2875 !> 1279 !> @todo 1280 !------------------------------------------------------------------- 1281 !> @code 2876 !------------------------------------------------------------------- 1282 2877 FUNCTION grid_get_closest( dd_lon0, dd_lat0, dd_lon1, dd_lat1 ) 1283 2878 IMPLICIT NONE … … 1326 2921 IF( dd_lon1 < 0 ) dl_lon1 = dd_lon1 + 360. 1327 2922 1328 ! 1-first, use dichotomy to reduce domain2923 ! first, use dichotomy to reduce domain 1329 2924 il_iinf = 1 ; il_jinf = 1 1330 2925 il_isup = il_shape(1) ; il_jsup = il_shape(2) … … 1336 2931 ll_continue=.TRUE. 1337 2932 1338 ! 1-1look for meridian 0°/360°2933 ! look for meridian 0°/360° 1339 2934 il_jmid = il_jinf + INT(il_shape(2)/2) 1340 2935 il_ind(:) = MAXLOC( dl_lon0(:,il_jmid), dl_lon0(:,il_jmid) <= 360._dp ) … … 1378 2973 ENDIF 1379 2974 1380 ! 1-22975 ! 1381 2976 DO WHILE( ll_continue .AND. .NOT. ll_north ) 1382 2977 … … 1401 2996 1402 2997 ENDIF 1403 1404 2998 1405 2999 IF( dd_lat1 > dd_lat0(il_imid,il_jmid) )THEN … … 1430 3024 ENDDO 1431 3025 1432 ! 2-then find closest point by computing distances3026 ! then find closest point by computing distances 1433 3027 il_shape(1)= il_isup - il_iinf + 1 1434 3028 il_shape(2)= il_jsup - il_jinf + 1 … … 1449 3043 1450 3044 END FUNCTION grid_get_closest 1451 !> @endcode 1452 !------------------------------------------------------------------- 1453 !> @brief This function compute the distance between a point A and 1454 !> points of a grid 3045 !------------------------------------------------------------------- 3046 !> @brief This function compute the distance between a point A and grid points. 1455 3047 ! 1456 3048 !> @details 1457 3049 ! 1458 3050 !> @author J.Paul 1459 !> - Nov , 2013- Initial Version1460 ! 1461 !> @param[in] dd_lon : grid longitude table1462 !> @param[in] dd_lat : grid latitude table1463 !> @param[in] dd_lonA :longitude of point A1464 !> @param[in] dd_latA :latitude of point A1465 ! -------------------------------------------------------------------1466 ! > @code3051 !> - November, 2013- Initial Version 3052 ! 3053 !> @param[in] dd_lon grid longitude array 3054 !> @param[in] dd_lat grid latitude array 3055 !> @param[in] dd_lonA longitude of point A 3056 !> @param[in] dd_latA latitude of point A 3057 !> @return array of distance between point A and grid points. 3058 !------------------------------------------------------------------- 1467 3059 FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) 1468 3060 IMPLICIT NONE … … 1507 3099 IF( dd_lonA < 0 ) dl_lonA = dd_lonA + 360. 1508 3100 1509 dl_lonA = dd_lonA * d g_deg2rad1510 dl_latA = dd_latA * d g_deg2rad1511 1512 dl_lon(:,:) = dl_lon(:,:) * d g_deg2rad1513 dl_lat(:,:) = dd_lat(:,:) * d g_deg2rad3101 dl_lonA = dd_lonA * dp_deg2rad 3102 dl_latA = dd_latA * dp_deg2rad 3103 3104 dl_lon(:,:) = dl_lon(:,:) * dp_deg2rad 3105 dl_lat(:,:) = dd_lat(:,:) * dp_deg2rad 1514 3106 1515 3107 grid_distance(:,:)=NF90_FILL_DOUBLE … … 1518 3110 DO ji=1,il_shape(1) 1519 3111 IF( dl_lon(ji,jj) == dl_lonA .AND. & 1520 & dl_lat(ji,jj) == dl_l ATA )THEN3112 & dl_lat(ji,jj) == dl_laTA )THEN 1521 3113 grid_distance(ji,jj)=0.0 1522 3114 ELSE … … 1526 3118 IF( dl_tmp < -1.0 ) dl_tmp = -1.0 1527 3119 IF( dl_tmp > 1.0 ) dl_tmp = 1.0 1528 grid_distance(ji,jj)=ACOS(dl_tmp)*d g_rearth3120 grid_distance(ji,jj)=ACOS(dl_tmp)*dp_rearth 1529 3121 ENDIF 1530 3122 ENDDO … … 1535 3127 1536 3128 END FUNCTION grid_distance 1537 !> @endcode 1538 !------------------------------------------------------------------- 1539 !> @brief This function get fine grid offset. 3129 !------------------------------------------------------------------- 3130 !> @brief This function get offset between fine grid and coarse grid. 3131 ! 3132 !> @details 3133 !> optionally, you could specify on which Arakawa grid point you want to 3134 !> work (default 'T') 3135 !> offset value could be 0,1,..,rho-1 3136 ! 3137 !> @author J.Paul 3138 !> - September, 2014- Initial Version 3139 !> @date October, 2014 3140 !> - work on mpp file structure instead of file structure 3141 ! 3142 !> @param[in] td_coord0 coarse grid coordinate 3143 !> @param[in] id_imin0 coarse grid lower left corner i-indice of fine grid domain 3144 !> @param[in] id_jmin0 coarse grid lower left corner j-indice of fine grid domain 3145 !> @param[in] id_imax0 coarse grid upper right corner i-indice of fine grid domain 3146 !> @param[in] id_jmax0 coarse grid upper right corner j-indice of fine grid domain 3147 !> @param[in] td_coord1 fine grid coordinate 3148 !> @param[in] id_rho array of refinement factor 3149 !> @param[in] cd_point Arakawa grid point 3150 !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 3151 !------------------------------------------------------------------- 3152 FUNCTION grid__get_fine_offset_ff( td_coord0, & 3153 & id_imin0, id_jmin0, id_imax0, id_jmax0, & 3154 & td_coord1, id_rho, cd_point ) 3155 IMPLICIT NONE 3156 ! Argument 3157 TYPE(TMPP) , INTENT(IN) :: td_coord0 3158 TYPE(TMPP) , INTENT(IN) :: td_coord1 3159 3160 INTEGER(i4) , INTENT(IN) :: id_imin0 3161 INTEGER(i4) , INTENT(IN) :: id_jmin0 3162 INTEGER(i4) , INTENT(IN) :: id_imax0 3163 INTEGER(i4) , INTENT(IN) :: id_jmax0 3164 3165 INTEGER(i4) , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho 3166 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 3167 3168 ! function 3169 INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_ff 3170 3171 ! local variable 3172 INTEGER(i4) :: il_imin0 3173 INTEGER(i4) :: il_jmin0 3174 INTEGER(i4) :: il_imax0 3175 INTEGER(i4) :: il_jmax0 3176 3177 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 3178 3179 INTEGER(i4), DIMENSION(2,2) :: il_xghost0 3180 INTEGER(i4), DIMENSION(2,2) :: il_xghost1 3181 3182 CHARACTER(LEN= 1) :: cl_point 3183 CHARACTER(LEN=lc) :: cl_name 3184 3185 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 3186 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 3187 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 3188 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 3189 3190 TYPE(TVAR) :: tl_lon0 3191 TYPE(TVAR) :: tl_lat0 3192 TYPE(TVAR) :: tl_lon1 3193 TYPE(TVAR) :: tl_lat1 3194 3195 TYPE(TMPP) :: tl_coord0 3196 TYPE(TMPP) :: tl_coord1 3197 3198 ! loop indices 3199 !---------------------------------------------------------------- 3200 ! init 3201 grid__get_fine_offset_ff(:,:)=-1 3202 3203 ALLOCATE(il_rho(ip_maxdim)) 3204 il_rho(:)=1 3205 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 3206 3207 cl_point='T' 3208 IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 3209 3210 ! copy structure 3211 tl_coord0=mpp_copy(td_coord0) 3212 tl_coord1=mpp_copy(td_coord1) 3213 3214 IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. & 3215 & .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 3216 CALL logger_error("GRID GET FINE OFFSET: can not get coarse "//& 3217 & "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//& 3218 & " and/or "//TRIM(tl_coord1%c_name)//" not defined." ) 3219 ELSE 3220 !1- Coarse grid 3221 ! get ghost cell factor on coarse grid 3222 il_xghost0(:,:)=grid_get_ghost( tl_coord0 ) 3223 3224 ! open mpp files 3225 CALL iom_mpp_open(tl_coord0) 3226 3227 ! read coarse longitue and latitude 3228 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 3229 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3230 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 3231 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3232 3233 ! close mpp files 3234 CALL iom_mpp_close(tl_coord0) 3235 3236 CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 3237 CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 3238 3239 ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, & 3240 & tl_lon0%t_dim(jp_J)%i_len )) 3241 3242 dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1) 3243 3244 ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, & 3245 & tl_lat0%t_dim(jp_J)%i_len )) 3246 3247 dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1) 3248 3249 ! clean 3250 CALL var_clean(tl_lon0) 3251 CALL var_clean(tl_lat0) 3252 3253 ! adjust coarse grid indices 3254 il_imin0=id_imin0-il_xghost0(jp_I,1) 3255 il_imax0=id_imax0-il_xghost0(jp_I,1) 3256 3257 il_jmin0=id_jmin0-il_xghost0(jp_J,1) 3258 il_jmax0=id_jmax0-il_xghost0(jp_J,1) 3259 3260 !2- Fine grid 3261 ! get ghost cell factor on fine grid 3262 il_xghost1(:,:)=grid_get_ghost( tl_coord1 ) 3263 3264 ! open mpp files 3265 CALL iom_mpp_open(tl_coord1) 3266 3267 ! read fine longitue and latitude 3268 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 3269 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3270 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 3271 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3272 3273 ! close mpp files 3274 CALL iom_mpp_close(tl_coord1) 3275 3276 CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 3277 CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 3278 3279 ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, & 3280 & tl_lon1%t_dim(jp_J)%i_len )) 3281 3282 dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1) 3283 3284 ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, & 3285 & tl_lat1%t_dim(jp_J)%i_len )) 3286 3287 dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1) 3288 3289 ! clean 3290 CALL var_clean(tl_lon1) 3291 CALL var_clean(tl_lat1) 3292 3293 !3- compute 3294 grid__get_fine_offset_ff(:,:)=grid_get_fine_offset( & 3295 & dl_lon0(:,:), dl_lat0(:,:),& 3296 & il_imin0, il_jmin0, & 3297 & il_imax0, il_jmax0, & 3298 & dl_lon1(:,:), dl_lat1(:,:),& 3299 & id_rho(:) ) 3300 3301 DEALLOCATE(dl_lon0, dl_lat0) 3302 DEALLOCATE(dl_lon1, dl_lat1) 3303 ENDIF 3304 3305 ! clean 3306 CALL mpp_clean(tl_coord0) 3307 CALL mpp_clean(tl_coord1) 3308 DEALLOCATE(il_rho) 3309 3310 END FUNCTION grid__get_fine_offset_ff 3311 !------------------------------------------------------------------- 3312 !> @brief This function get offset between fine grid and coarse grid. 3313 ! 3314 !> @details 3315 !> optionally, you could specify on which Arakawa grid point you want to 3316 !> work (default 'T') 3317 !> offset value could be 0,1,..,rho-1 3318 ! 3319 !> @author J.Paul 3320 !> - September, 2014- Initial Version 3321 !> @date October, 2014 3322 !> - work on mpp file structure instead of file structure 3323 ! 3324 !> @param[in] dd_lon0 coarse grid longitude array 3325 !> @param[in] dd_lat0 coarse grid latitude array 3326 !> @param[in] id_imin0 coarse grid lower left corner i-indice of fine grid domain 3327 !> @param[in] id_jmin0 coarse grid lower left corner j-indice of fine grid domain 3328 !> @param[in] id_imax0 coarse grid upper right corner i-indice of fine grid domain 3329 !> @param[in] id_jmax0 coarse grid upper right corner j-indice of fine grid domain 3330 !> @param[in] td_coord1 fine grid coordinate 3331 !> @param[in] id_rho array of refinement factor 3332 !> @param[in] cd_point Arakawa grid point 3333 !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 3334 !------------------------------------------------------------------- 3335 FUNCTION grid__get_fine_offset_cf( dd_lon0, dd_lat0, & 3336 & id_imin0, id_jmin0, id_imax0, id_jmax0, & 3337 & td_coord1, id_rho, cd_point ) 3338 IMPLICIT NONE 3339 ! Argument 3340 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lon0 3341 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lat0 3342 TYPE(TMPP) , INTENT(IN) :: td_coord1 3343 3344 INTEGER(i4) , INTENT(IN) :: id_imin0 3345 INTEGER(i4) , INTENT(IN) :: id_jmin0 3346 INTEGER(i4) , INTENT(IN) :: id_imax0 3347 INTEGER(i4) , INTENT(IN) :: id_jmax0 3348 3349 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_rho 3350 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 3351 3352 ! function 3353 INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cf 3354 3355 ! local variable 3356 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 3357 3358 INTEGER(i4), DIMENSION(2,2) :: il_xghost1 3359 3360 CHARACTER(LEN= 1) :: cl_point 3361 CHARACTER(LEN=lc) :: cl_name 3362 3363 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 3364 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat1 3365 3366 TYPE(TVAR) :: tl_lon1 3367 TYPE(TVAR) :: tl_lat1 3368 3369 TYPE(TMPP) :: tl_coord1 3370 ! loop indices 3371 !---------------------------------------------------------------- 3372 ! init 3373 grid__get_fine_offset_cf(:,:)=-1 3374 3375 ALLOCATE(il_rho(ip_maxdim)) 3376 il_rho(:)=1 3377 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 3378 3379 cl_point='T' 3380 IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 3381 3382 ! copy structure 3383 tl_coord1=mpp_copy(td_coord1) 3384 3385 IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN 3386 CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//& 3387 & "file "//TRIM(tl_coord1%c_name)//" not defined." ) 3388 ELSE 3389 3390 ! Fine grid 3391 ! get ghost cell factor on fine grid 3392 il_xghost1(:,:)=grid_get_ghost( tl_coord1 ) 3393 3394 ! open mpp files 3395 CALL iom_mpp_open(tl_coord1) 3396 3397 ! read fine longitue and latitude 3398 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 3399 tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3400 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 3401 tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 3402 3403 ! close mpp files 3404 CALL iom_mpp_close(tl_coord1) 3405 3406 CALL grid_del_ghost(tl_lon1, il_xghost1(:,:)) 3407 CALL grid_del_ghost(tl_lat1, il_xghost1(:,:)) 3408 3409 ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, & 3410 & tl_lon1%t_dim(jp_J)%i_len )) 3411 3412 dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1) 3413 3414 ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, & 3415 & tl_lat1%t_dim(jp_J)%i_len )) 3416 3417 dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1) 3418 3419 ! clean 3420 CALL var_clean(tl_lon1) 3421 CALL var_clean(tl_lat1) 3422 3423 ! compute 3424 grid__get_fine_offset_cf(:,:)=grid_get_fine_offset( & 3425 & dd_lon0(:,:), dd_lat0(:,:),& 3426 & id_imin0, id_jmin0, & 3427 & id_imax0, id_jmax0, & 3428 & dl_lon1(:,:), dl_lat1(:,:),& 3429 & id_rho(:) ) 3430 3431 DEALLOCATE(dl_lon1, dl_lat1) 3432 ENDIF 3433 3434 ! clean 3435 CALL mpp_clean(tl_coord1) 3436 DEALLOCATE(il_rho) 3437 3438 END FUNCTION grid__get_fine_offset_cf 3439 !------------------------------------------------------------------- 3440 !> @brief This function get offset between fine grid and coarse grid. 3441 ! 3442 !> @details 3443 !> optionally, you could specify on which Arakawa grid point you want to 3444 !> work (default 'T') 3445 !> offset value could be 0,1,..,rho-1 3446 ! 3447 !> @author J.Paul 3448 !> - September, 2014- Initial Version 3449 !> @date October, 2014 3450 !> - work on mpp file structure instead of file structure 3451 ! 3452 !> @param[in] td_coord0 coarse grid coordinate 3453 !> @param[in] id_imin0 coarse grid lower left corner i-indice of fine grid domain 3454 !> @param[in] id_jmin0 coarse grid lower left corner j-indice of fine grid domain 3455 !> @param[in] id_imax0 coarse grid upper right corner i-indice of fine grid domain 3456 !> @param[in] id_jmax0 coarse grid upper right corner j-indice of fine grid domain 3457 !> @param[in] dd_lon1 fine grid longitude array 3458 !> @param[in] dd_lat1 fine grid latitude array 3459 !> @param[in] id_rho array of refinement factor 3460 !> @param[in] cd_point Arakawa grid point 3461 !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 3462 !------------------------------------------------------------------- 3463 FUNCTION grid__get_fine_offset_fc( td_coord0, & 3464 & id_imin0, id_jmin0, id_imax0, id_jmax0, & 3465 & dd_lon1, dd_lat1, & 3466 & id_rho, cd_point ) 3467 IMPLICIT NONE 3468 ! Argument 3469 TYPE(TMPP) , INTENT(IN) :: td_coord0 3470 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lon1 3471 REAL(dp) , DIMENSION(:,:), INTENT(IN) :: dd_lat1 3472 3473 INTEGER(i4) , INTENT(IN) :: id_imin0 3474 INTEGER(i4) , INTENT(IN) :: id_jmin0 3475 INTEGER(i4) , INTENT(IN) :: id_imax0 3476 INTEGER(i4) , INTENT(IN) :: id_jmax0 3477 3478 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_rho 3479 CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_point 3480 3481 ! function 3482 INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_fc 3483 3484 ! local variable 3485 INTEGER(i4) :: il_imin0 3486 INTEGER(i4) :: il_jmin0 3487 INTEGER(i4) :: il_imax0 3488 INTEGER(i4) :: il_jmax0 3489 3490 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 3491 3492 INTEGER(i4), DIMENSION(2,2) :: il_xghost0 3493 3494 CHARACTER(LEN= 1) :: cl_point 3495 CHARACTER(LEN=lc) :: cl_name 3496 3497 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon0 3498 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lat0 3499 3500 TYPE(TVAR) :: tl_lon0 3501 TYPE(TVAR) :: tl_lat0 3502 3503 TYPE(TMPP) :: tl_coord0 3504 ! loop indices 3505 !---------------------------------------------------------------- 3506 ! init 3507 grid__get_fine_offset_fc(:,:)=-1 3508 3509 ALLOCATE(il_rho(ip_maxdim)) 3510 il_rho(:)=1 3511 IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:) 3512 3513 cl_point='T' 3514 IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point)) 3515 3516 ! copy structure 3517 tl_coord0=mpp_copy(td_coord0) 3518 3519 IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN 3520 CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//& 3521 & "file "//TRIM(tl_coord0%c_name)//" not defined." ) 3522 ELSE 3523 !1- Coarse grid 3524 ! get ghost cell factor on coarse grid 3525 il_xghost0(:,:)=grid_get_ghost( tl_coord0 ) 3526 3527 ! open mpp files 3528 CALL iom_mpp_open(tl_coord0) 3529 3530 ! read coarse longitue and latitude 3531 WRITE(cl_name,*) 'longitude_'//TRIM(cl_point) 3532 tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3533 WRITE(cl_name,*) 'latitude_'//TRIM(cl_point) 3534 tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name)) 3535 3536 ! close mpp files 3537 CALL iom_mpp_close(tl_coord0) 3538 3539 CALL grid_del_ghost(tl_lon0, il_xghost0(:,:)) 3540 CALL grid_del_ghost(tl_lat0, il_xghost0(:,:)) 3541 3542 ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, & 3543 & tl_lon0%t_dim(jp_J)%i_len )) 3544 3545 dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1) 3546 3547 ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, & 3548 & tl_lat0%t_dim(jp_J)%i_len )) 3549 3550 dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1) 3551 3552 ! clean 3553 CALL var_clean(tl_lon0) 3554 CALL var_clean(tl_lat0) 3555 3556 ! adjust coarse grid indices 3557 il_imin0=id_imin0-il_xghost0(jp_I,1) 3558 il_imax0=id_imax0-il_xghost0(jp_I,1) 3559 3560 il_jmin0=id_jmin0-il_xghost0(jp_J,1) 3561 il_jmax0=id_jmax0-il_xghost0(jp_J,1) 3562 3563 3564 !3- compute 3565 grid__get_fine_offset_fc(:,:)=grid_get_fine_offset(& 3566 & dl_lon0(:,:), dl_lat0(:,:),& 3567 & il_imin0, il_jmin0, & 3568 & il_imax0, il_jmax0, & 3569 & dd_lon1(:,:), dd_lat1(:,:),& 3570 & id_rho(:) ) 3571 3572 DEALLOCATE(dl_lon0, dl_lat0) 3573 ENDIF 3574 3575 ! clean 3576 CALL mpp_clean(tl_coord0) 3577 DEALLOCATE(il_rho) 3578 3579 END FUNCTION grid__get_fine_offset_fc 3580 !------------------------------------------------------------------- 3581 !> @brief This function get offset between fine grid and coarse grid. 1540 3582 ! 1541 3583 !> @details … … 1543 3585 ! 1544 3586 !> @author J.Paul 1545 !> - Nov, 2013- Initial Version 1546 ! 1547 !> @param[in] dd_lon0 : coarse grid longitude table 1548 !> @param[in] dd_lat0 : coarse grid latitude table 1549 !> @param[in] dd_lon1 : fine grid longitude table 1550 !> @param[in] dd_lat1 : fine grid latitude table 1551 !> @param[in] id_imin0 : coarse grid lower left corner i-indice of fine grid domain 1552 !> @param[in] id_jmin0 : coarse grid lower left corner j-indice of fine grid domain 1553 !> @param[in] id_imax0 : coarse grid upper right corner i-indice of fine grid domain 1554 !> @param[in] id_jmax0 : coarse grid upper right corner j-indice of fine grid domain 1555 !> @param[in] id_rhoi : i-direction refinement factor 1556 !> @param[in] id_rhoj : j-direction refinement factor 1557 !> @return offset table (/ (/i_offset_left,i_offset_right!/),(/j_offset_lower,j_offset_upper/) /) 1558 !------------------------------------------------------------------- 1559 !> @code 1560 FUNCTION grid_get_fine_offset( dd_lon0, dd_lat0, & 1561 & id_imin0, id_jmin0, id_imax0, id_jmax0, & 1562 & dd_lon1, dd_lat1, id_rho ) 3587 !> - November, 2013 - Initial Version 3588 !> @date September, 2014 - rename from grid_get_fine_offset 3589 ! 3590 !> @param[in] dd_lon0 coarse grid longitude array 3591 !> @param[in] dd_lat0 coarse grid latitude array 3592 !> @param[in] id_imin0 coarse grid lower left corner i-indice of fine grid domain 3593 !> @param[in] id_jmin0 coarse grid lower left corner j-indice of fine grid domain 3594 !> @param[in] id_imax0 coarse grid upper right corner i-indice of fine grid domain 3595 !> @param[in] id_jmax0 coarse grid upper right corner j-indice of fine grid domain 3596 !> @param[in] dd_lon1 fine grid longitude array 3597 !> @param[in] dd_lat1 fine grid latitude array 3598 !> @param[in] id_rho array of refinement factor 3599 !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /) 3600 !------------------------------------------------------------------- 3601 FUNCTION grid__get_fine_offset_cc( dd_lon0, dd_lat0, & 3602 & id_imin0, id_jmin0, id_imax0, id_jmax0, & 3603 & dd_lon1, dd_lat1, id_rho ) 1563 3604 IMPLICIT NONE 1564 3605 ! Argument … … 1576 3617 1577 3618 ! function 1578 INTEGER(i4), DIMENSION(2,2) :: grid_ get_fine_offset3619 INTEGER(i4), DIMENSION(2,2) :: grid__get_fine_offset_cc 1579 3620 1580 3621 ! local variable … … 1584 3625 REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: dl_lon1 1585 3626 1586 REAL(dp) :: dl_dlon1587 REAL(dp) :: dl_dlat1588 1589 3627 ! loop indices 1590 3628 INTEGER(i4) :: ji … … 1616 3654 WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360. 1617 3655 1618 grid_get_fine_offset(:,:)=-1 1619 1620 ! look for i-direction left offset 1621 IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 1622 DO ji=1,id_rho(jp_I)+2 1623 dl_dlon=ABS(dl_lon1(ji+1,1)-dl_lon1(ji,1))*1.e-3 1624 IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) + dl_dlon )THEN 1625 grid_get_fine_offset(1,1)=(id_rho(jp_I)+1)-ji+MOD(id_rho(jp_I),2) 1626 EXIT 1627 ENDIF 1628 ENDDO 3656 ! init 3657 grid__get_fine_offset_cc(:,:)=-1 3658 3659 IF( il_shape1(1) > 1 )THEN 3660 3661 ! look for i-direction left offset 3662 IF( dl_lon1(1,1) < dl_lon0(id_imin0+1,id_jmin0) )THEN 3663 DO ji=1,id_rho(jp_I)+2 3664 IF( dl_lon1(ji,1) > dl_lon0(id_imin0+1,id_jmin0) - dp_delta )THEN 3665 grid__get_fine_offset_cc(1,1)=(id_rho(jp_I)+1)-ji 3666 EXIT 3667 ENDIF 3668 ENDDO 3669 ELSE 3670 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3671 & " not match fine grid lower left corner.") 3672 ENDIF 3673 3674 ! look for i-direction right offset 3675 IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 3676 DO ji=1,id_rho(jp_I)+2 3677 ii=il_shape1(1)-ji+1 3678 IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) + dp_delta )THEN 3679 grid__get_fine_offset_cc(1,2)=(id_rho(jp_I)+1)-ji 3680 EXIT 3681 ENDIF 3682 ENDDO 3683 ELSE 3684 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3685 & " not match fine grid lower right corner.") 3686 ENDIF 3687 1629 3688 ELSE 1630 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 1631 & " not match fine grid lower left corner.") 1632 ENDIF 1633 1634 ! look for i-direction right offset 1635 IF( dl_lon1(il_shape1(1),1) > dl_lon0(id_imax0-1,id_jmin0) )THEN 1636 DO ji=1,id_rho(jp_I)+2 1637 ii=il_shape1(1)-ji+1 1638 dl_dlon=ABS(dl_lon1(ii,1)-dl_lon1(ii-1,1))*1.e-3 1639 IF( dl_lon1(ii,1) < dl_lon0(id_imax0-1,id_jmin0) - dl_dlon )THEN 1640 grid_get_fine_offset(1,2)=(id_rho(jp_I)+1)-ji+MOD(id_rho(jp_I),2) 1641 EXIT 1642 ENDIF 1643 ENDDO 3689 grid__get_fine_offset_cc(1,:)=((id_rho(jp_I)-1)/2) 3690 ENDIF 3691 3692 IF( il_shape1(2) > 1 )THEN 3693 3694 ! look for j-direction lower offset 3695 IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN 3696 DO jj=1,id_rho(jp_J)+2 3697 IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) - dp_delta )THEN 3698 grid__get_fine_offset_cc(2,1)=(id_rho(jp_J)+1)-jj 3699 EXIT 3700 ENDIF 3701 ENDDO 3702 ELSE 3703 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3704 & " not match fine grid upper left corner.") 3705 ENDIF 3706 3707 ! look for j-direction upper offset 3708 IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 3709 DO jj=1,id_rho(jp_J)+2 3710 ij=il_shape1(2)-jj+1 3711 IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) + dp_delta )THEN 3712 grid__get_fine_offset_cc(2,2)=(id_rho(jp_J)+1)-jj 3713 EXIT 3714 ENDIF 3715 ENDDO 3716 ELSE 3717 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 3718 & " not match fine grid upper right corner.") 3719 ENDIF 1644 3720 ELSE 1645 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 1646 & " not match fine grid lower right corner.") 1647 ENDIF 1648 1649 ! look for j-direction lower offset 1650 IF( dd_lat1(1,1) < dd_lat0(id_imin0,id_jmin0+1) )THEN 1651 DO jj=1,id_rho(jp_J)+2 1652 dl_dlat=ABS(dd_lat1(1,jj+1)-dd_lat1(1,jj))*1.e-3 1653 IF( dd_lat1(1,jj) > dd_lat0(id_imin0,id_jmin0+1) + dl_dlat )THEN 1654 grid_get_fine_offset(2,1)=(id_rho(jp_J)+1)-jj+MOD(id_rho(jp_J),2) 1655 EXIT 1656 ENDIF 1657 ENDDO 1658 ELSE 1659 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 1660 & " not match fine grid upper left corner.") 1661 ENDIF 1662 1663 ! look for j-direction upper offset 1664 IF( dd_lat1(1,il_shape1(2)) > dd_lat0(id_imin0,id_jmax0-1) )THEN 1665 DO jj=1,id_rho(jp_J)+2 1666 ij=il_shape1(2)-jj+1 1667 dl_dlat=ABS(dd_lat1(1,ij)-dd_lat1(1,ij-1))*1.e-3 1668 IF( dd_lat1(1,ij) < dd_lat0(id_imin0,id_jmax0-1) - dl_dlat )THEN 1669 grid_get_fine_offset(2,2)=(id_rho(jp_J)+1)-jj+MOD(id_rho(jp_J),2) 1670 EXIT 1671 ENDIF 1672 ENDDO 1673 ELSE 1674 CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//& 1675 & " not match fine grid upper right corner.") 3721 grid__get_fine_offset_cc(2,:)=((id_rho(jp_J)-1)/2) 1676 3722 ENDIF 1677 3723 … … 1679 3725 DEALLOCATE( dl_lon1 ) 1680 3726 1681 END FUNCTION grid_get_fine_offset 1682 !> @endcode 1683 !------------------------------------------------------------------- 1684 !> @brief This function check if ghost cell are used or not, and return ghost 1685 !> cell factor (0,1) in i- and j-direction. 3727 END FUNCTION grid__get_fine_offset_cc 3728 !------------------------------------------------------------------- 3729 !> @brief This subroutine check fine and coarse grid coincidence. 1686 3730 ! 1687 3731 !> @details 1688 3732 ! 1689 3733 !> @author J.Paul 1690 !> - Nov, 2013- Initial Version 1691 ! 1692 !> @param[in] td_lon : grid longitude sturcture 1693 !> @param[in] td_lat : grid latitude structure 1694 !------------------------------------------------------------------- 1695 !> @code 1696 FUNCTION grid__get_ghost_ll( td_lon, td_lat ) 1697 IMPLICIT NONE 1698 ! Argument 1699 TYPE(TVAR), INTENT(IN) :: td_lon 1700 TYPE(TVAR), INTENT(IN) :: td_lat 1701 1702 ! function 1703 INTEGER(i4), DIMENSION(2) :: grid__get_ghost_ll 1704 1705 ! local variable 1706 INTEGER(i4) :: il_ew 1707 ! loop indices 1708 !---------------------------------------------------------------- 1709 ! init 1710 grid__get_ghost_ll(:)=0 1711 1712 IF( grid_is_global(td_lon, td_lat) )THEN 1713 grid__get_ghost_ll(:)=0 1714 ELSE 1715 grid__get_ghost_ll(2)=1 1716 1717 il_ew=td_lon%i_ew 1718 IF( il_ew < 0 )THEN 1719 grid__get_ghost_ll(1)=1 1720 ELSE 1721 grid__get_ghost_ll(1)=0 1722 ENDIF 1723 ENDIF 1724 1725 END FUNCTION grid__get_ghost_ll 1726 !> @endcode 1727 !------------------------------------------------------------------- 1728 !> @brief This function check if ghost cell are used or not, and return ghost 1729 !> cell factor (0,1) in i- and j-direction. 1730 ! 1731 !> @details 1732 ! 1733 !> @author J.Paul 1734 !> - Nov, 2013- Initial Version 1735 ! 1736 !> @param[in] td_file : file sturcture 1737 !------------------------------------------------------------------- 1738 !> @code 1739 FUNCTION grid__get_ghost_f( td_file ) 1740 IMPLICIT NONE 1741 ! Argument 1742 TYPE(TFILE), INTENT(IN) :: td_file 1743 1744 ! function 1745 INTEGER(i4), DIMENSION(2) :: grid__get_ghost_f 1746 1747 ! local variable 1748 TYPE(TVAR) :: tl_lon 1749 TYPE(TVAR) :: tl_lat 1750 1751 INTEGER(i4) :: il_lonid 1752 INTEGER(i4) :: il_latid 1753 ! loop indices 1754 INTEGER(i4) :: ji 1755 !---------------------------------------------------------------- 1756 ! init 1757 grid__get_ghost_f(:)=0 1758 1759 IF( td_file%i_id == 0 )THEN 1760 CALL logger_error("GRID GET GHOST: file "//& 1761 & TRIM(td_file%c_name)//" not opened." ) 1762 1763 ELSE 1764 1765 IF( ASSOCIATED(td_file%t_var) )THEN 1766 ! read coarse longitue and latitude 1767 il_lonid=var_get_id(td_file%t_var(:),'longitude') 1768 il_latid=var_get_id(td_file%t_var(:),'latitude') 1769 1770 print *,'file ',trim(td_file%c_name),td_file%i_ew 1771 DO ji=1,td_file%i_nvar 1772 print *,ji,trim(td_file%t_var(ji)%c_name),': ',td_file%t_var(ji)%i_ew 1773 ENDDO 1774 print *,'lonid ',il_lonid 1775 print *,'latid ',il_latid 1776 IF( il_lonid /=0 .AND. il_latid /= 0 )THEN 1777 tl_lon=iom_read_var(td_file,il_lonid) 1778 print *,'lon ',tl_lon%i_ew 1779 tl_lat=iom_read_var(td_file,il_latid) 1780 print *,'lat ',tl_lat%i_ew 1781 ! get ghost cell factor on coarse grid 1782 grid__get_ghost_f(:)=grid_get_ghost( tl_lon, tl_lat ) 1783 ELSE 1784 CALL logger_error("GRID GET GHOST: can not find "//& 1785 & "longitude or latitude "//& 1786 & "in file "//TRIM(td_file%c_name)) 1787 ENDIF 1788 ELSE 1789 CALL logger_error("GRID GET GHOST: no variable "//& 1790 & "associated to file "//TRIM(td_file%c_name)) 1791 ENDIF 1792 1793 ENDIF 1794 1795 END FUNCTION grid__get_ghost_f 1796 !> @endcode 1797 !------------------------------------------------------------------- 1798 !> @brief This subroutine check fine and coarse grid coincidence 1799 ! 1800 !> @details 1801 ! 1802 !> @author J.Paul 1803 !> - Nov, 2013- Initial Version 1804 ! 1805 !> @param[in] td_coord0 : coarse grid coordinate file structure 1806 !> @param[in] td_coord1 : fine grid coordinate file structure 1807 !> @param[in] id_imin0 : coarse grid lower left corner i-indice of fine grid domain 1808 !> @param[in] id_imax0 : coarse grid upper right corner i-indice of fine grid domain 1809 !> @param[in] id_jmin0 : coarse grid lower left corner j-indice of fine grid domain 1810 !> @param[in] id_jmax0 : coarse grid upper right corner j-indice of fine grid domain 1811 !> @param[in] id_rho : table of refinement factor 1812 !------------------------------------------------------------------- 1813 !> @code 3734 !> - November, 2013- Initial Version 3735 !> @date October, 2014 3736 !> - work on mpp file structure instead of file structure 3737 ! 3738 !> @param[in] td_coord0 coarse grid coordinate file structure 3739 !> @param[in] td_coord1 fine grid coordinate file structure 3740 !> @param[in] id_imin0 coarse grid lower left corner i-indice of fine grid domain 3741 !> @param[in] id_imax0 coarse grid upper right corner i-indice of fine grid domain 3742 !> @param[in] id_jmin0 coarse grid lower left corner j-indice of fine grid domain 3743 !> @param[in] id_jmax0 coarse grid upper right corner j-indice of fine grid domain 3744 !> @param[in] id_rho array of refinement factor (default 1) 3745 !------------------------------------------------------------------- 1814 3746 SUBROUTINE grid_check_coincidence( td_coord0, td_coord1, & 1815 3747 & id_imin0, id_imax0, & … … 1819 3751 1820 3752 ! Argument 1821 TYPE(T FILE), INTENT(IN) :: td_coord01822 TYPE(T FILE), INTENT(IN) :: td_coord11823 INTEGER(i4) , INTENT(IN) :: id_imin01824 INTEGER(i4) , INTENT(IN) :: id_imax01825 INTEGER(i4) , INTENT(IN) :: id_jmin01826 INTEGER(i4) , INTENT(IN) :: id_jmax03753 TYPE(TMPP) , INTENT(IN) :: td_coord0 3754 TYPE(TMPP) , INTENT(IN) :: td_coord1 3755 INTEGER(i4) , INTENT(IN) :: id_imin0 3756 INTEGER(i4) , INTENT(IN) :: id_imax0 3757 INTEGER(i4) , INTENT(IN) :: id_jmin0 3758 INTEGER(i4) , INTENT(IN) :: id_jmax0 1827 3759 INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho 1828 3760 … … 1852 3784 REAL(dp) :: dl_lat1p 1853 3785 1854 REAL(dp) :: dl_dlon1855 REAL(dp) :: dl_dlat1856 1857 3786 LOGICAL :: ll_coincidence 1858 3787 … … 1862 3791 TYPE(TVAR) :: tl_lat1 1863 3792 1864 TYPE(TFILE) :: tl_coord0 1865 1866 TYPE(TMPP) :: tl_mppcoord0 3793 TYPE(TMPP) :: tl_coord0 3794 TYPE(TMPP) :: tl_coord1 1867 3795 1868 3796 TYPE(TDOM) :: tl_dom0 … … 1875 3803 ll_coincidence=.TRUE. 1876 3804 1877 ! read coarse longitue and latitude on domain 1878 tl_coord0=td_coord0 1879 CALL iom_open(tl_coord0) 1880 1881 !2-1 compute domain 3805 ! copy structure 3806 tl_coord0=mpp_copy(td_coord0) 3807 3808 ! compute domain 1882 3809 tl_dom0=dom_init( tl_coord0, & 1883 3810 & id_imin0, id_imax0,& 1884 3811 & id_jmin0, id_jmax0 ) 1885 3812 1886 !2-2 close file 1887 CALL iom_close(tl_coord0) 1888 1889 !2-3 read variables on domain (ugly way to do it, have to work on it) 1890 !2-3-1 init mpp structure 1891 tl_mppcoord0=mpp_init(tl_coord0) 1892 1893 CALL file_clean(tl_coord0) 1894 1895 !2-3-2 get processor to be used 1896 CALL mpp_get_use( tl_mppcoord0, tl_dom0 ) 1897 1898 !2-3-3 open mpp files 1899 CALL iom_mpp_open(tl_mppcoord0) 1900 1901 !2-3-4 read variable value on domain 1902 tl_lon0=iom_mpp_read_var(tl_mppcoord0,'longitude',td_dom=tl_dom0) 1903 tl_lat0=iom_mpp_read_var(tl_mppcoord0,'latitude' ,td_dom=tl_dom0) 1904 1905 !2-3-5 close mpp files 1906 CALL iom_mpp_close(tl_mppcoord0) 1907 1908 !2-3-6 clean structure 1909 CALL mpp_clean(tl_mppcoord0) 3813 ! open mpp files 3814 CALL iom_dom_open(tl_coord0, tl_dom0) 3815 3816 ! read variable value on domain 3817 tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0) 3818 tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0) 3819 3820 ! close mpp files 3821 CALL iom_dom_close(tl_coord0) 3822 3823 ! clean structure 3824 CALL mpp_clean(tl_coord0) 3825 CALL dom_clean(tl_dom0) 3826 3827 ! copy structure 3828 tl_coord1=mpp_copy(td_coord1) 3829 3830 ! open mpp files 3831 CALL iom_mpp_open(tl_coord1) 1910 3832 1911 3833 ! read fine longitue and latitude 1912 tl_lon1=iom_ read_var(td_coord1,'longitude')1913 tl_lat1=iom_ read_var(td_coord1,'latitude')3834 tl_lon1=iom_mpp_read_var(tl_coord1,'longitude') 3835 tl_lat1=iom_mpp_read_var(tl_coord1,'latitude') 1914 3836 3837 ! close mpp files 3838 CALL iom_dom_close(tl_coord1) 3839 ! clean structure 3840 CALL mpp_clean(tl_coord1) 3841 1915 3842 CALL logger_debug("GRID CHECK COINCIDENCE:"//& 1916 3843 & " fine grid "//TRIM(td_coord1%c_name) ) … … 1918 3845 & " coarse grid "//TRIM(td_coord0%c_name) ) 1919 3846 1920 ! 1-check domain1921 ! 1-1check global grid3847 ! check domain 3848 ! check global grid 1922 3849 IF( .NOT. grid_is_global(tl_lon0, tl_lat0) )THEN 1923 3850 IF( grid_is_global(tl_lon1, tl_lat1) )THEN … … 1929 3856 1930 3857 ELSE 1931 !1-2 ew overlap1932 3858 il_ew1=tl_lon1%i_ew 1933 3859 IF( il_ew1 >= 0 )THEN 3860 ! ew overlap 1934 3861 1935 3862 il_ew0=tl_lon0%i_ew … … 1940 3867 ENDIF 1941 3868 1942 il_jmin1=1+i g_ghost1943 il_jmax1=tl_lon1%t_dim(2)%i_len-i g_ghost3869 il_jmin1=1+ip_ghost 3870 il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost 1944 3871 1945 3872 ll_coincidence=grid__check_lat(& 1946 3873 & tl_lat0%d_value(1,:,1,1),& 1947 & tl_lat1%d_value(1,il_jmin1:il_jmax1,1,1),& 1948 & id_rho(jp_J) ) 3874 & tl_lat1%d_value(1,il_jmin1:il_jmax1,1,1)) 1949 3875 1950 3876 ELSE 1951 ! 1-3other case1952 il_imin1=1+i g_ghost1953 il_jmin1=1+i g_ghost1954 1955 il_imax1=tl_lon1%t_dim(1)%i_len-i g_ghost1956 il_jmax1=tl_lon1%t_dim(2)%i_len-i g_ghost3877 ! other case 3878 il_imin1=1+ip_ghost 3879 il_jmin1=1+ip_ghost 3880 3881 il_imax1=tl_lon1%t_dim(1)%i_len-ip_ghost 3882 il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost 1957 3883 1958 3884 ll_coincidence=grid__check_corner(& … … 1967 3893 1968 3894 ENDIF 1969 3895 1970 3896 ENDIF 1971 3897 … … 1977 3903 ENDIF 1978 3904 1979 ! 2-check refinement factor3905 ! check refinement factor 1980 3906 ! select point in middle of fine grid 1981 3907 il_imid1=INT(tl_lon1%t_dim(1)%i_len*0.5) 1982 3908 il_jmid1=INT(tl_lon1%t_dim(2)%i_len*0.5) 1983 3909 1984 3910 dl_lon1=tl_lon1%d_value(il_imid1, il_jmid1,1,1) 1985 3911 dl_lat1=tl_lat1%d_value(il_imid1, il_jmid1,1,1) … … 2000 3926 ! look for closest fine grid point from selected coarse grid point 2001 3927 il_iind(:)=MAXLOC( tl_lon1%d_value(:,:,1,1), & 2002 & tl_lon1%d_value(:,:,1,1) <= dl_lon0 )3928 & tl_lon1%d_value(:,:,1,1) <= dl_lon0 ) 2003 3929 2004 3930 il_jind(:)=MAXLOC( tl_lat1%d_value(:,:,1,1), & … … 2016 3942 dl_lat1=tl_lat1%d_value(il_indF(1),il_indF(2),1,1) 2017 3943 2018 ! 2-1check i-direction refinement factor3944 ! check i-direction refinement factor 2019 3945 DO ji=1,MIN(3,il_imid1) 2020 3946 2021 3947 IF( il_indF(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN 2022 CALL logger_debug("GRID CHECK COINCIDENCE: tl_lon1%t_dim(1)%i_len "//TRIM(fct_str(tl_lon1%t_dim(1)%i_len)))2023 CALL logger_debug("GRID CHECK COINCIDENCE: il_indF(1)+ji*id_rhoi+1 "//TRIM(fct_str(il_indF(1)+ji*id_rho(jp_I)+1)))2024 CALL logger_debug("GRID CHECK COINCIDENCE: il_indF(1) "//TRIM(fct_str(il_indF(1))))2025 CALL logger_debug("GRID CHECK COINCIDENCE: id_rhoi "//TRIM(fct_str(id_rho(jp_I))))2026 3948 CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//& 2027 3949 & " to check i-direction refinement factor ") … … 2032 3954 2033 3955 dl_lon1p=tl_lon1%d_value(il_indF(1)+ji*id_rho(jp_I)+1,il_indF(2),1,1) 2034 2035 dl_dlon=ABS(dl_lon1p-dl_lon1)*1.e-32036 3956 2037 3957 SELECT CASE(MOD(id_rho(jp_I),2)) … … 2049 3969 CASE DEFAULT 2050 3970 2051 IF( ABS(dl_lon1 - dl_lon0) > d l_dlon)THEN3971 IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN 2052 3972 ll_coincidence=.FALSE. 2053 3973 CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& … … 2062 3982 ENDDO 2063 3983 2064 ! 2-2check j-direction refinement factor3984 ! check j-direction refinement factor 2065 3985 DO jj=1,MIN(3,il_jmid1) 2066 3986 … … 2074 3994 2075 3995 dl_lat1p=tl_lat1%d_value(il_indF(1),il_indF(2)+jj*id_rho(jp_J)+1,1,1) 2076 2077 dl_dlat=ABS(dl_lat1p-dl_lat1)*1.e-32078 3996 2079 3997 SELECT CASE(MOD(id_rho(jp_J),2)) … … 2091 4009 CASE DEFAULT 2092 4010 2093 IF( ABS(dl_lat1-dl_lat0) > d l_dlat)THEN4011 IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN 2094 4012 ll_coincidence=.FALSE. 2095 4013 CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//& … … 2104 4022 ENDDO 2105 4023 4024 ! clean 4025 CALL var_clean(tl_lon1) 4026 CALL var_clean(tl_lat1) 4027 CALL var_clean(tl_lon0) 4028 CALL var_clean(tl_lat0) 4029 2106 4030 IF( .NOT. ll_coincidence )THEN 2107 4031 CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//& … … 2111 4035 2112 4036 END SUBROUTINE grid_check_coincidence 2113 !> @endcode2114 4037 !------------------------------------------------------------------- 2115 4038 !> @brief This function check that fine grid is … … 2118 4041 !> @details 2119 4042 !> 2120 !> @note deltalon and delatlat are used only to avoid issue due to2121 !> cubic interpolation approximation on the firsts grid points2122 !2123 4043 !> @author J.Paul 2124 !> - Nov , 2013- Initial Version2125 ! 2126 !> @param[in] dd_lon0 : tableof coarse grid longitude2127 !> @param[in] dd_lat0 : tableof coarse grid latitude2128 !> @param[in] dd_lon1 : tableof fine grid longitude2129 !> @param[in] dd_lat1 : tableof fine grid latitude4044 !> - November, 2013- Initial Version 4045 ! 4046 !> @param[in] dd_lon0 array of coarse grid longitude 4047 !> @param[in] dd_lat0 array of coarse grid latitude 4048 !> @param[in] dd_lon1 array of fine grid longitude 4049 !> @param[in] dd_lat1 array of fine grid latitude 2130 4050 !> @return logical, fine grid is inside coarse grid 2131 4051 !------------------------------------------------------------------- 2132 !> @code2133 4052 FUNCTION grid__check_corner(dd_lon0, dd_lat0, & 2134 4053 & dd_lon1, dd_lat1 ) … … 2162 4081 REAL(dp) :: dl_lon1 2163 4082 REAL(dp) :: dl_lat1 2164 2165 REAL(dp) :: dl_dlon2166 REAL(dp) :: dl_dlat2167 4083 ! loop indices 2168 4084 !---------------------------------------------------------------- … … 2182 4098 2183 4099 ! check lower left corner 2184 dl_lon0 = dd_lon0(il_imin0, il_jmin0 2185 dl_lat0 = dd_lat0(il_imin0, il_jmin0 4100 dl_lon0 = dd_lon0(il_imin0, il_jmin0) 4101 dl_lat0 = dd_lat0(il_imin0, il_jmin0) 2186 4102 2187 4103 dl_lon1 = dd_lon1(il_imin1, il_jmin1) 2188 4104 dl_lat1 = dd_lat1(il_imin1, il_jmin1) 2189 4105 2190 dl_dlon=ABS(dd_lon1(il_imin1+1,il_jmin1 )-dl_lon1)*1.e-3 2191 dl_dlat=ABS(dd_lat1(il_imin1 ,il_jmin1+1)-dl_lat1)*1.e-3 2192 2193 IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 < dl_lon0 ) .OR. & 2194 & (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 < dl_lat0 ) )THEN 4106 4107 IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. & 4108 & (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0 ) )THEN 2195 4109 2196 4110 CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower left "//& … … 2207 4121 2208 4122 ! check upper left corner 2209 dl_lon0 = dd_lon0(il_imin0, il_jmax0 2210 dl_lat0 = dd_lat0(il_imin0, il_jmax0 4123 dl_lon0 = dd_lon0(il_imin0, il_jmax0) 4124 dl_lat0 = dd_lat0(il_imin0, il_jmax0) 2211 4125 2212 4126 dl_lon1 = dd_lon1(il_imin1, il_jmax1) 2213 4127 dl_lat1 = dd_lat1(il_imin1, il_jmax1) 2214 4128 2215 dl_dlon=ABS(dd_lon1(il_imin1+1,il_jmax1 )-dl_lon1)*1.e-3 2216 dl_dlat=ABS(dd_lat1(il_imin1 ,il_jmax1-1)-dl_lat1)*1.e-3 2217 2218 IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 < dl_lon0) .OR. & 2219 & (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 > dl_lat0) )THEN 4129 4130 IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0) .OR. & 4131 & (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN 2220 4132 2221 4133 CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper left "//& … … 2232 4144 2233 4145 ! check lower right corner 2234 dl_lon0 = dd_lon0(il_imax0, il_jmin0 2235 dl_lat0 = dd_lat0(il_imax0, il_jmin0 4146 dl_lon0 = dd_lon0(il_imax0, il_jmin0) 4147 dl_lat0 = dd_lat0(il_imax0, il_jmin0) 2236 4148 2237 4149 dl_lon1 = dd_lon1(il_imax1, il_jmin1) 2238 4150 dl_lat1 = dd_lat1(il_imax1, il_jmin1) 2239 4151 2240 dl_dlon=ABS(dd_lon1(il_imax1-1,il_jmin1 )-dl_lon1)*1.e-3 2241 dl_dlat=ABS(dd_lat1(il_imax1 ,il_jmin1+1)-dl_lat1)*1.e-3 2242 2243 IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 > dl_lon0) .OR. & 2244 & (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 < dl_lat0) )THEN 4152 4153 IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. & 4154 & (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0) )THEN 2245 4155 2246 4156 CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower right "//& 2247 & "corner not north west westof coarse grid (imax,jmin) ")4157 & "corner not north west of coarse grid (imax,jmin) ") 2248 4158 CALL logger_debug(" fine grid lower right ( "//& 2249 4159 & TRIM(fct_str(dl_lon1))//","//& … … 2257 4167 2258 4168 ! check upper right corner 2259 dl_lon0 = dd_lon0(il_imax0, il_jmax0 2260 dl_lat0 = dd_lat0(il_imax0, il_jmax0 4169 dl_lon0 = dd_lon0(il_imax0, il_jmax0) 4170 dl_lat0 = dd_lat0(il_imax0, il_jmax0) 2261 4171 2262 4172 dl_lon1 = dd_lon1(il_imax1, il_jmax1) 2263 4173 dl_lat1 = dd_lat1(il_imax1, il_jmax1) 2264 4174 2265 dl_dlon=ABS(dd_lon1(il_imax1-1,il_jmax1 )-dl_lon1)*1.e-3 2266 dl_dlat=ABS(dd_lat1(il_imax1 ,il_jmax1-1)-dl_lat1)*1.e-3 2267 2268 IF( (ABS(dl_lon1-dl_lon0)>dl_dlon) .AND. (dl_lon1 > dl_lon0) .OR. & 2269 & (ABS(dl_lat1-dl_lat0)>dl_dlat) .AND. (dl_lat1 > dl_lat0) )THEN 4175 IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. & 4176 & (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN 2270 4177 2271 4178 CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper right "//& … … 2288 4195 2289 4196 END FUNCTION grid__check_corner 2290 !> @endcode2291 4197 !------------------------------------------------------------------- 2292 4198 !> @brief This function check that fine grid latitude are … … 2296 4202 ! 2297 4203 !> @author J.Paul 2298 !> - Nov, 2013- Initial Version 2299 ! 2300 !> @param[in] dd_lat0 : table of coarse grid latitude 2301 !> @param[in] dd_lat1 : table of fine grid latitude 2302 !------------------------------------------------------------------- 2303 !> @code 2304 FUNCTION grid__check_lat(dd_lat0, dd_lat1, id_rhoj) 4204 !> - November, 2013- Initial Version 4205 ! 4206 !> @param[in] dd_lat0 array of coarse grid latitude 4207 !> @param[in] dd_lat1 array of fine grid latitude 4208 !------------------------------------------------------------------- 4209 FUNCTION grid__check_lat(dd_lat0, dd_lat1) 2305 4210 IMPLICIT NONE 2306 4211 ! Argument 2307 4212 REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat0 2308 4213 REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat1 2309 INTEGER(i4) , INTENT(IN) :: id_rhoj2310 4214 2311 4215 ! function … … 2321 4225 INTEGER(i4) :: il_jmin1 2322 4226 INTEGER(i4) :: il_jmax1 2323 2324 REAL(dp) :: dl_dlat2325 4227 ! loop indices 2326 4228 !---------------------------------------------------------------- … … 2333 4235 2334 4236 !1- check if fine grid inside coarse grid domain 2335 il_jmin0=1+1 ; il_jmax0=il_shape0(1)-1 2336 2337 il_jmin1=1+id_rhoj ; il_jmax1=il_shape1(1)-id_rhoj 2338 2339 dl_dlat=ABS(dd_lat1(il_jmin1+1)-dd_lat1(il_jmin1))*1.e-3 4237 il_jmin0=1 ; il_jmax0=il_shape0(1) 4238 il_jmin1=1 ; il_jmax1=il_shape1(1) 2340 4239 2341 4240 ! check lower left fine grid 2342 IF( ABS(dd_lat1(il_jmin1)-dd_lat0(il_jmin0)) > d l_dlat.AND. &4241 IF( ABS(dd_lat1(il_jmin1)-dd_lat0(il_jmin0)) > dp_delta .AND. & 2343 4242 & dd_lat1(il_jmin1) < dd_lat0(il_jmin0) )THEN 2344 4243 … … 2353 4252 ENDIF 2354 4253 2355 dl_dlat=ABS(dd_lat1(il_jmax1-1)-dd_lat1(il_jmax1))*1.e-32356 2357 4254 ! check upper left fine grid 2358 IF( ABS(dd_lat1(il_jmax1)-dd_lat0(il_jmax0)) > d l_dlat.AND. &4255 IF( ABS(dd_lat1(il_jmax1)-dd_lat0(il_jmax0)) > dp_delta .AND. & 2359 4256 & dd_lat1(il_jmax1) > dd_lat0(il_jmax0) )THEN 2360 4257 … … 2370 4267 2371 4268 END FUNCTION grid__check_lat 2372 !> @endcode2373 4269 !------------------------------------------------------------------- 2374 4270 !> @brief … … 2376 4272 !> 2377 4273 !> @author J.Paul 2378 !> - Nov, 2013-Initial version 2379 ! 2380 !> @param[inout] td_var : table of variable structure 2381 !> @param[in] id_ighost : i-direction ghost cell factor 2382 !> @param[in] id_jghost : j-direction ghost cell factor 2383 !------------------------------------------------------------------- 2384 !> @code 2385 SUBROUTINE grid_add_ghost(td_var, id_ighost, id_jghost) 4274 !> - November, 2013-Initial version 4275 ! 4276 !> @param[inout] td_var array of variable structure 4277 !> @param[in] id_ghost array of ghost cell factor 4278 !------------------------------------------------------------------- 4279 SUBROUTINE grid_add_ghost(td_var, id_ghost) 2386 4280 IMPLICIT NONE 2387 4281 ! Argument 2388 TYPE(TVAR) , INTENT(INOUT) :: td_var 2389 INTEGER(i4), INTENT(IN ) :: id_ighost 2390 INTEGER(i4), INTENT(IN ) :: id_jghost 4282 TYPE(TVAR) , INTENT(INOUT) :: td_var 4283 INTEGER(i4), DIMENSION(2,2), INTENT(IN ) :: id_ghost 2391 4284 2392 4285 ! local variable … … 2409 4302 2410 4303 ! copy variable 2411 tl_var= td_var4304 tl_var=var_copy(td_var) 2412 4305 2413 4306 CALL var_del_value(td_var) 2414 4307 2415 4308 ! compute indice to fill center 2416 il_imin=1+id_ ighost*ig_ghost2417 il_jmin=1+id_ jghost*ig_ghost2418 2419 il_imax= il_imin+tl_var%t_dim(1)%i_len-12420 il_jmax= il_jmin+tl_var%t_dim(2)%i_len-14309 il_imin=1+id_ghost(jp_I,1)*ip_ghost 4310 il_jmin=1+id_ghost(jp_J,1)*ip_ghost 4311 4312 il_imax=tl_var%t_dim(1)%i_len+id_ghost(jp_I,1)*ip_ghost 4313 il_jmax=tl_var%t_dim(2)%i_len+id_ghost(jp_J,1)*ip_ghost 2421 4314 2422 4315 ! compute new dimension 2423 td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len + 2*id_ighost*ig_ghost 2424 td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len + 2*id_jghost*ig_ghost 4316 td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len + & 4317 & SUM(id_ghost(jp_I,:))*ip_ghost 4318 td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len + & 4319 & SUM(id_ghost(jp_J,:))*ip_ghost 2425 4320 2426 4321 ALLOCATE(dl_value(td_var%t_dim(1)%i_len, & … … 2448 4343 2449 4344 END SUBROUTINE grid_add_ghost 2450 !> @endcode2451 4345 !------------------------------------------------------------------- 2452 4346 !> @brief … … 2454 4348 !> 2455 4349 !> @author J.Paul 2456 !> - Nov, 2013-Initial version 2457 ! 2458 !> @param[inout] td_var : table of variable structure 2459 !> @param[in] id_ighost : i-direction ghost cell factor 2460 !> @param[in] id_jghost : j-direction ghost cell factor 2461 !------------------------------------------------------------------- 2462 !> @code 2463 SUBROUTINE grid_del_ghost(td_var, id_ighost, id_jghost) 4350 !> - November, 2013-Initial version 4351 ! 4352 !> @param[inout] td_var array of variable structure 4353 !> @param[in] id_ghost array of ghost cell factor 4354 !------------------------------------------------------------------- 4355 SUBROUTINE grid_del_ghost(td_var, id_ghost) 2464 4356 IMPLICIT NONE 2465 4357 ! Argument 2466 TYPE(TVAR) , INTENT(INOUT) :: td_var 2467 INTEGER(i4), INTENT(IN ) :: id_ighost 2468 INTEGER(i4), INTENT(IN ) :: id_jghost 4358 TYPE(TVAR) , INTENT(INOUT) :: td_var 4359 INTEGER(i4), DIMENSION(2,2), INTENT(IN ) :: id_ghost 2469 4360 2470 4361 ! local variable … … 2483 4374 IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 2484 4375 2485 CALL logger_warn( " DEL GHOST: dimension change in variable "//&4376 CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//& 2486 4377 & TRIM(td_var%c_name) ) 2487 4378 2488 4379 ! copy variable 2489 tl_var= td_var4380 tl_var=var_copy(td_var) 2490 4381 2491 4382 CALL var_del_value(td_var) 2492 4383 2493 4384 ! compute indice to get center 2494 il_imin=1+id_ ighost*ig_ghost2495 il_jmin=1+id_ jghost*ig_ghost2496 2497 il_imax=tl_var%t_dim(1)%i_len-id_ ighost*ig_ghost2498 il_jmax=tl_var%t_dim(2)%i_len-id_ jghost*ig_ghost4385 il_imin=1+id_ghost(jp_I,1)*ip_ghost 4386 il_jmin=1+id_ghost(jp_J,1)*ip_ghost 4387 4388 il_imax=tl_var%t_dim(1)%i_len-id_ghost(jp_I,2)*ip_ghost 4389 il_jmax=tl_var%t_dim(2)%i_len-id_ghost(jp_J,2)*ip_ghost 2499 4390 2500 4391 ! compute new dimension 2501 td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len - 2*id_ighost*ig_ghost2502 td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len - 2*id_jghost*ig_ghost4392 td_var%t_dim(1)%i_len = il_imax - il_imin +1 4393 td_var%t_dim(2)%i_len = il_jmax - il_jmin +1 2503 4394 2504 4395 ALLOCATE(dl_value(td_var%t_dim(1)%i_len, & … … 2526 4417 2527 4418 END SUBROUTINE grid_del_ghost 2528 ! > @endcode2529 ! -------------------------------------------------------------------2530 !> @brief This subroutine fill small closed sea with fill value.4419 !------------------------------------------------------------------- 4420 !> @brief This function check if ghost cell are used or not, and return ghost 4421 !> cell factor (0,1) in horizontal plan. 2531 4422 ! 2532 4423 !> @details 2533 !> the minimum size (nbumber of point) of closed sea to be kept could be 2534 !> sepcify with id_minsize. 2535 !> By default only the biggest sea is preserve. 2536 ! 4424 !> check if domain is global, and if there is an East-West overlap. 4425 !> 2537 4426 !> @author J.Paul 2538 !> - Nov, 2013- Initial Version 2539 ! 2540 !> @param[inout] td_var : variable structure 2541 !> @param[in] id_mask : domain mask (from grid_split_domain) 2542 !> @param[in] id_minsize : minimum size of sea to be kept 2543 !------------------------------------------------------------------- 2544 !> @code 2545 SUBROUTINE grid_fill_small_dom(td_var, id_mask, id_minsize) 4427 !> - September, 2014- Initial Version 4428 ! 4429 !> @param[in] td_var variable sturcture 4430 !> @return array of ghost cell factor 4431 !------------------------------------------------------------------- 4432 FUNCTION grid__get_ghost_var( td_var ) 2546 4433 IMPLICIT NONE 2547 ! Argument 2548 TYPE(TVAR) , INTENT(INOUT) :: td_var 2549 INTEGER(i4), DIMENSION(:,:), INTENT(IN ), OPTIONAL :: id_mask 2550 INTEGER(i4), INTENT(IN ), OPTIONAL :: id_minsize 4434 ! Argument 4435 TYPE(TVAR), INTENT(IN) :: td_var 4436 4437 ! function 4438 INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_var 2551 4439 2552 4440 ! local variable 2553 INTEGER(i4) :: il_ndom 2554 INTEGER(i4) :: il_minsize 2555 INTEGER(i4), DIMENSION(2) :: il_shape 2556 INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 4441 INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim 2557 4442 2558 4443 ! loop indices 2559 INTEGER(i4) :: ji2560 INTEGER(i4) :: jk2561 INTEGER(i4) :: jl2562 4444 !---------------------------------------------------------------- 2563 2564 il_shape(:)=SHAPE(id_mask(:,:)) 2565 IF( ANY(il_shape(:) /= td_var%t_dim(1:2)%i_len) )THEN 2566 CALL logger_error("GRID FILL SMALL DOM: variable and mask "//& 2567 & "dimension differ") 4445 ! init 4446 grid__get_ghost_var(:,:)=0 4447 4448 IF( .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN 4449 CALL logger_error("GRID GET GHOST: "//TRIM(td_var%c_name)//" is not a suitable"//& 4450 & " variable to look for ghost cell (not 2D).") 2568 4451 ELSE 2569 2570 il_ndom=MINVAL(id_mask(:,:)) 2571 2572 ALLOCATE( il_tmp(il_shape(1),il_shape(2)) ) 2573 il_tmp(:,:)=0 2574 DO ji=-1,il_ndom,-1 2575 WHERE( id_mask(:,:)==ji ) 2576 il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 2577 END WHERE 2578 ENDDO 2579 2580 il_minsize=MAXVAL(il_tmp(:,:)) 2581 IF( PRESENT(id_minsize) ) il_minsize=id_minsize 2582 2583 DO jl=1,td_var%t_dim(4)%i_len 2584 DO jk=1,td_var%t_dim(3)%i_len 2585 WHERE( il_tmp(:,:) < il_minsize ) 2586 td_var%d_value(:,:,jk,jl)=td_var%d_fill 2587 END WHERE 2588 ENDDO 2589 ENDDO 2590 2591 DEALLOCATE( il_tmp ) 2592 2593 ENDIF 2594 2595 END SUBROUTINE grid_fill_small_dom 2596 !> @endcode 4452 IF( .NOT. ASSOCIATED(td_var%d_value) )THEN 4453 CALL logger_error("GRID GET GHOST: no value associated to "//TRIM(td_var%c_name)//& 4454 & ". can't look for ghost cell.") 4455 ELSE 4456 il_dim(:)=td_var%t_dim(:)%i_len 4457 4458 IF(ALL(td_var%d_value( 1 , : ,1,1)/=td_var%d_fill).AND.& 4459 & ALL(td_var%d_value(il_dim(1), : ,1,1)/=td_var%d_fill).AND.& 4460 & ALL(td_var%d_value( : , 1 ,1,1)/=td_var%d_fill).AND.& 4461 & ALL(td_var%d_value( : ,il_dim(2),1,1)/=td_var%d_fill))THEN 4462 ! no boundary closed 4463 CALL logger_warn("GRID GET GHOST: can't determined ghost cell. "//& 4464 & "there is no boundary closed for variable "//& 4465 & TRIM(td_var%c_name)) 4466 4467 ELSE 4468 ! check periodicity 4469 IF(ANY(td_var%d_value( 1 ,:,1,1)/=td_var%d_fill).OR.& 4470 & ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN 4471 ! East-West cyclic (1,4,6) 4472 CALL logger_info("GRID GET GHOST: East West cyclic") 4473 grid__get_ghost_var(jp_I,:)=0 4474 4475 IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 4476 ! South boundary not closed 4477 4478 CALL logger_debug("GRID GET GHOST: East_West cyclic") 4479 CALL logger_debug("GRID GET GHOST: South boundary not closed") 4480 CALL logger_error("GRID GET GHOST: should have been an "//& 4481 & "impossible case") 4482 4483 ELSE 4484 ! South boundary closed (1,4,6) 4485 CALL logger_info("GRID GET GHOST: South boundary closed") 4486 grid__get_ghost_var(jp_J,1)=1 4487 4488 IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN 4489 ! North boundary not closed (4,6) 4490 CALL logger_info("GRID GET GHOST: North boundary not closed") 4491 grid__get_ghost_var(jp_J,2)=0 4492 ELSE 4493 ! North boundary closed 4494 CALL logger_info("GRID GET GHOST: North boundary closed") 4495 grid__get_ghost_var(jp_J,2)=1 4496 ENDIF 4497 4498 ENDIF 4499 4500 ELSE 4501 ! East-West boundaries closed (0,2,3,5) 4502 CALL logger_info("GRID GET GHOST: East West boundaries closed") 4503 grid__get_ghost_var(jp_I,:)=1 4504 4505 IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN 4506 ! South boundary not closed (2) 4507 CALL logger_info("GRID GET GHOST: South boundary not closed") 4508 grid__get_ghost_var(jp_J,1)=0 4509 4510 IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 4511 ! North boundary not closed 4512 CALL logger_debug("GRID GET GHOST: East West boundaries "//& 4513 & "closed") 4514 CALL logger_debug("GRID GET GHOST: South boundary not closed") 4515 CALL logger_debug("GRID GET GHOST: North boundary not closed") 4516 CALL logger_error("GRID GET GHOST: should have been "//& 4517 & "an impossible case") 4518 ELSE 4519 ! North boundary closed 4520 grid__get_ghost_var(jp_J,2)=1 4521 ENDIF 4522 4523 ELSE 4524 ! South boundary closed (0,3,5) 4525 CALL logger_info("GRID GET GHOST: South boundary closed") 4526 grid__get_ghost_var(jp_J,1)=1 4527 4528 IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN 4529 ! North boundary not closed (3,5) 4530 CALL logger_info("GRID GET GHOST: North boundary not closed") 4531 grid__get_ghost_var(jp_J,2)=0 4532 ELSE 4533 ! North boundary closed 4534 CALL logger_info("GRID GET GHOST: North boundary closed") 4535 grid__get_ghost_var(jp_J,2)=1 4536 ENDIF 4537 4538 ENDIF 4539 4540 ENDIF 4541 4542 ENDIF 4543 4544 ENDIF 4545 ENDIF 4546 4547 END FUNCTION grid__get_ghost_var 4548 !------------------------------------------------------------------- 4549 !> @brief This function check if ghost cell are used or not, and return ghost 4550 !> cell factor (0,1) in i- and j-direction. 4551 ! 4552 !> @details 4553 !> get longitude an latitude array, then 4554 !> check if domain is global, and if there is an East-West overlap 4555 !> 4556 !> @author J.Paul 4557 !> - September, 2014 - Initial Version 4558 !> @date October, 2014 4559 !> - work on mpp file structure instead of file structure 4560 ! 4561 !> @param[in] td_file file sturcture 4562 !> @return array of ghost cell factor 4563 !------------------------------------------------------------------- 4564 FUNCTION grid__get_ghost_mpp( td_mpp ) 4565 IMPLICIT NONE 4566 ! Argument 4567 TYPE(TMPP), INTENT(IN) :: td_mpp 4568 4569 ! function 4570 INTEGER(i4), DIMENSION(2,2) :: grid__get_ghost_mpp 4571 4572 ! local variable 4573 !TYPE(TVAR) :: tl_lon 4574 !TYPE(TVAR) :: tl_lat 4575 4576 TYPE(TMPP) :: tl_mpp 4577 4578 !INTEGER(i4) :: il_lonid 4579 !INTEGER(i4) :: il_latid 4580 ! loop indices 4581 !---------------------------------------------------------------- 4582 ! init 4583 grid__get_ghost_mpp(:,:)=0 4584 4585 IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 4586 CALL logger_error("GRID GET GHOST: decomposition of mpp file "//& 4587 & TRIM(td_mpp%c_name)//" not defined." ) 4588 4589 ELSE 4590 4591 ! copy structure 4592 tl_mpp=mpp_copy(td_mpp) 4593 4594 IF( tl_mpp%i_perio < 0 )THEN 4595 ! compute NEMO periodicity index 4596 CALL grid_get_info(tl_mpp) 4597 ENDIF 4598 4599 SELECT CASE(tl_mpp%i_perio) 4600 CASE(0) 4601 grid__get_ghost_mpp(:,:)=1 4602 CASE(1) 4603 grid__get_ghost_mpp(jp_J,:)=1 4604 CASE(2) 4605 grid__get_ghost_mpp(jp_I,:)=1 4606 grid__get_ghost_mpp(jp_J,2)=1 4607 CASE(3,5) 4608 grid__get_ghost_mpp(jp_I,:)=1 4609 grid__get_ghost_mpp(jp_J,1)=1 4610 CASE(4,6) 4611 grid__get_ghost_mpp(jp_J,1)=1 4612 CASE DEFAULT 4613 END SELECT 4614 4615 ! clean 4616 CALL mpp_clean(tl_mpp) 4617 4618 ENDIF 4619 4620 END FUNCTION grid__get_ghost_mpp 2597 4621 !------------------------------------------------------------------- 2598 4622 !> @brief This subroutine compute closed sea domain. 2599 4623 ! 2600 4624 !> @details 2601 !> to each domain is associated a negative value id (from -1 to ...) 2602 ! 4625 !> to each domain is associated a negative value id (from -1 to ...)<br/> 4626 !> optionaly you could specify which level use (default 1) 4627 !> 2603 4628 !> @author J.Paul 2604 !> - Nov , 2013- Initial Version2605 ! 2606 !> @param[in] td_var :variable strucutre2607 !> @param[in] id_level :level4629 !> - November, 2013- Initial Version 4630 ! 4631 !> @param[in] td_var variable strucutre 4632 !> @param[in] id_level level 2608 4633 !> @return domain mask 2609 4634 !------------------------------------------------------------------- 2610 !> @code2611 4635 FUNCTION grid_split_domain(td_var, id_level) 2612 4636 IMPLICIT NONE … … 2692 4716 2693 4717 END FUNCTION grid_split_domain 2694 !> @endcode 2695 ! !------------------------------------------------------------------- 2696 ! !> @brief This function 2697 ! ! 2698 ! !> @details 2699 ! ! 2700 ! !> @author J.Paul 2701 ! !> - Nov, 2013- Initial Version 2702 ! ! 2703 ! !> @param[in] 2704 ! !------------------------------------------------------------------- 2705 ! !> @code 2706 ! FUNCTION grid_() 2707 ! IMPLICIT NONE 2708 ! ! Argument 2709 ! ! function 2710 ! ! local variable 2711 ! ! loop indices 2712 ! !---------------------------------------------------------------- 2713 ! 2714 ! END FUNCTION grid_ 2715 ! !> @endcode 2716 ! !------------------------------------------------------------------- 2717 ! !> @brief This subroutine 2718 ! ! 2719 ! !> @details 2720 ! ! 2721 ! !> @author J.Paul 2722 ! !> - Nov, 2013- Initial Version 2723 ! ! 2724 ! !> @param[in] 2725 ! !------------------------------------------------------------------- 2726 ! !> @code 2727 ! SUBROUTINE grid_() 2728 ! IMPLICIT NONE 2729 ! ! Argument 2730 ! ! local variable 2731 ! ! loop indices 2732 ! !---------------------------------------------------------------- 2733 ! 2734 ! END SUBROUTINE grid_ 2735 ! !> @endcode 4718 !------------------------------------------------------------------- 4719 !> @brief This subroutine fill small closed sea with fill value. 4720 !> 4721 !> @details 4722 !> the minimum size (nbumber of point) of closed sea to be kept could be 4723 !> sepcify with id_minsize. 4724 !> By default only the biggest sea is preserve. 4725 !> 4726 !> @author J.Paul 4727 !> - November, 2013- Initial Version 4728 !> 4729 !> @param[inout] td_var variable structure 4730 !> @param[in] id_mask domain mask (from grid_split_domain) 4731 !> @param[in] id_minsize minimum size of sea to be kept 4732 !------------------------------------------------------------------- 4733 SUBROUTINE grid_fill_small_dom(td_var, id_mask, id_minsize) 4734 IMPLICIT NONE 4735 ! Argument 4736 TYPE(TVAR) , INTENT(INOUT) :: td_var 4737 INTEGER(i4), DIMENSION(:,:), INTENT(IN ) :: id_mask 4738 INTEGER(i4), INTENT(IN ), OPTIONAL :: id_minsize 4739 4740 ! local variable 4741 INTEGER(i4) :: il_ndom 4742 INTEGER(i4) :: il_minsize 4743 INTEGER(i4), DIMENSION(2) :: il_shape 4744 INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp 4745 4746 ! loop indices 4747 INTEGER(i4) :: ji 4748 INTEGER(i4) :: jk 4749 INTEGER(i4) :: jl 4750 !---------------------------------------------------------------- 4751 4752 il_shape(:)=SHAPE(id_mask(:,:)) 4753 IF( ANY(il_shape(:) /= td_var%t_dim(1:2)%i_len) )THEN 4754 CALL logger_error("GRID FILL SMALL DOM: variable and mask "//& 4755 & "dimension differ") 4756 ELSE 4757 4758 il_ndom=MINVAL(id_mask(:,:)) 4759 4760 ALLOCATE( il_tmp(il_shape(1),il_shape(2)) ) 4761 il_tmp(:,:)=0 4762 DO ji=-1,il_ndom,-1 4763 WHERE( id_mask(:,:)==ji ) 4764 il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji 4765 END WHERE 4766 ENDDO 4767 4768 il_minsize=MAXVAL(il_tmp(:,:)) 4769 IF( PRESENT(id_minsize) ) il_minsize=id_minsize 4770 4771 DO jl=1,td_var%t_dim(4)%i_len 4772 DO jk=1,td_var%t_dim(3)%i_len 4773 WHERE( il_tmp(:,:) < il_minsize ) 4774 td_var%d_value(:,:,jk,jl)=td_var%d_fill 4775 END WHERE 4776 ENDDO 4777 ENDDO 4778 4779 DEALLOCATE( il_tmp ) 4780 4781 ENDIF 4782 4783 END SUBROUTINE grid_fill_small_dom 2736 4784 END MODULE grid 2737 4785
Note: See TracChangeset
for help on using the changeset viewer.