- Timestamp:
- 2016-10-28T11:13:57+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid_hgr.f90
r7025 r7153 85 85 !> @date September, 2015 86 86 !> - J, Paul : rewrite to SIREN format from $Id: domhgr.F90 5506 2015-06-29 15:19:38Z clevy $ 87 !> @date October, 201 587 !> @date October, 2016 88 88 !> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling.. 89 !> - J, Paul : compute coriolis factor at f-point and at t-point 90 !> - J, Paul : do not use anymore special case for ORCA grid 89 91 !> 90 92 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 146 148 PUBLIC :: tg_e2f 147 149 148 PUBLIC :: tg_ff 150 PUBLIC :: tg_ff_t 151 PUBLIC :: tg_ff_f 149 152 150 153 PUBLIC :: tg_gcost … … 186 189 ! REAL(dp) :: d_ppe2_m 187 190 188 INTEGER(i4) :: i_cla191 ! INTEGER(i4) :: i_cla 189 192 190 CHARACTER(LEN=lc) :: c_cfg193 ! CHARACTER(LEN=lc) :: c_cfg 191 194 INTEGER(i4) :: i_cfg 192 INTEGER(i4) :: i_bench195 LOGICAL :: l_bench 193 196 194 197 END TYPE … … 227 230 TYPE(TVAR), SAVE :: tg_e2f 228 231 229 TYPE(TVAR), SAVE :: tg_ff 232 TYPE(TVAR), SAVE :: tg_ff_t 233 TYPE(TVAR), SAVE :: tg_ff_f 230 234 231 235 TYPE(TVAR), SAVE :: tg_gcost … … 249 253 !> @param[in] jpj 250 254 !------------------------------------------------------------------- 251 SUBROUTINE grid_hgr_init(jpi,jpj,jpk )255 SUBROUTINE grid_hgr_init(jpi,jpj,jpk,ld_domcfg) 252 256 IMPLICIT NONE 253 257 ! Argument … … 255 259 INTEGER(i4), INTENT(IN) :: jpj 256 260 INTEGER(i4), INTENT(IN) :: jpk 261 LOGICAL , INTENT(IN) :: ld_domcfg 257 262 258 263 REAL(dp), DIMENSION(jpi,jpj) :: dl_tmp2D … … 292 297 tg_e2f = var_init('e2f' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 293 298 294 tg_ff = var_init('ff' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 295 296 tg_gcost =var_init('gcost',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 297 tg_gcosu =var_init('gcosu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 298 tg_gcosv =var_init('gcosv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 299 tg_gcosf =var_init('gcosf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 300 301 tg_gsint =var_init('gsint',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 302 tg_gsinu =var_init('gsinu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 303 tg_gsinv =var_init('gsinv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 304 tg_gsinf =var_init('gsinf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 299 tg_ff_t = var_init('ff_t' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 300 tg_ff_f = var_init('ff_f' ,dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 301 302 IF( .NOT. ld_domcfg )THEN 303 tg_gcost =var_init('gcost',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 304 tg_gcosu =var_init('gcosu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 305 tg_gcosv =var_init('gcosv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 306 tg_gcosf =var_init('gcosf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 307 308 tg_gsint =var_init('gsint',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 309 tg_gsinu =var_init('gsinu',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 310 tg_gsinv =var_init('gsinv',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 311 tg_gsinf =var_init('gsinf',dl_tmp2D(:,:) , dd_fill=dp_fill, id_type=NF90_DOUBLE) 312 ENDIF 305 313 306 314 ! variable 3D … … 308 316 309 317 tg_tmask = var_init('tmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 310 tg_umask = var_init('umask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 311 tg_vmask = var_init('vmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 312 tg_fmask = var_init('fmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 318 IF( .NOT. ld_domcfg )THEN 319 tg_umask = var_init('umask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 320 tg_vmask = var_init('vmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 321 tg_fmask = var_init('fmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) 322 ENDIF 313 323 314 324 ! tg_wmask = var_init('wmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE) … … 324 334 !> 325 335 !------------------------------------------------------------------- 326 SUBROUTINE grid_hgr_clean( )336 SUBROUTINE grid_hgr_clean(ld_domcfg) 327 337 IMPLICIT NONE 328 338 ! Argument 339 LOGICAL , INTENT(IN) :: ld_domcfg 329 340 330 341 ! local variable … … 332 343 !---------------------------------------------------------------- 333 344 CALL var_clean(tg_ssmask ) 334 CALL var_clean(tg_tmask )335 CALL var_clean(tg_umask )336 CALL var_clean(tg_vmask )337 CALL var_clean(tg_fmask )338 345 339 346 CALL var_clean(tg_glamt) … … 357 364 CALL var_clean(tg_e2f ) 358 365 359 CALL var_clean(tg_ff ) 360 361 CALL var_clean(tg_gcost ) 362 CALL var_clean(tg_gcosu ) 363 CALL var_clean(tg_gcosv ) 364 CALL var_clean(tg_gcosf ) 365 366 CALL var_clean(tg_gsint ) 367 CALL var_clean(tg_gsinu ) 368 CALL var_clean(tg_gsinv ) 369 CALL var_clean(tg_gsinf ) 370 366 CALL var_clean(tg_ff_t ) 367 CALL var_clean(tg_ff_f ) 368 369 IF( .NOT. ld_domcfg )THEN 370 CALL var_clean(tg_gcost ) 371 CALL var_clean(tg_gcosu ) 372 CALL var_clean(tg_gcosv ) 373 CALL var_clean(tg_gcosf ) 374 375 CALL var_clean(tg_gsint ) 376 CALL var_clean(tg_gsinu ) 377 CALL var_clean(tg_gsinv ) 378 CALL var_clean(tg_gsinf ) 379 ENDIF 380 381 CALL var_clean(tg_tmask ) 382 IF( .NOT. ld_domcfg )THEN 383 CALL var_clean(tg_umask ) 384 CALL var_clean(tg_vmask ) 385 CALL var_clean(tg_fmask ) 386 ENDIF 371 387 END SUBROUTINE grid_hgr_clean 372 388 !------------------------------------------------------------------- … … 409 425 ! REAL(dp) :: dn_ppe2_m = NF90_FILL_DOUBLE 410 426 411 ! namcla412 INTEGER(i4) :: in_cla = 0427 ! ! namcla 428 ! INTEGER(i4) :: in_cla = 0 413 429 414 430 ! namgrd 415 CHARACTER(LEN=lc) :: cn_cfg = ''431 ! CHARACTER(LEN=lc) :: cn_cfg = '' 416 432 INTEGER(i4) :: in_cfg = 0 417 INTEGER(i4) :: in_bench = 0433 LOGICAL :: ln_bench = .FALSE. 418 434 419 435 !---------------------------------------------------------------- … … 433 449 ! & dn_ppe2_m !< meridional grid-spacing (degrees) 434 450 435 NAMELIST /namcla/ &436 & in_cla !< =1 cross land advection for exchanges through some straits (ORCA2)451 ! NAMELIST /namcla/ & 452 ! & in_cla !< =1 cross land advection for exchanges through some straits (ORCA2) 437 453 438 454 NAMELIST/namgrd/ & !< orca grid namelist 439 & cn_cfg, & !< name of the configuration (orca)455 ! & cn_cfg, & !< name of the configuration (orca) 440 456 & in_cfg, & !< resolution of the configuration (2,1,025..) 441 & in_bench !< benchmark parameter (in_mshhgr = 5 ).457 & ln_bench !< benchmark parameter (in_mshhgr = 5 ). 442 458 443 459 !---------------------------------------------------------------- … … 461 477 462 478 READ( il_fileid, NML = namhgr ) 463 READ( il_fileid, NML = namcla )464 READ( il_fileid, NML = namgrd )479 ! READ( il_fileid, NML = namcla ) 480 ! READ( il_fileid, NML = namgrd ) 465 481 466 482 CLOSE( il_fileid, IOSTAT=il_status ) … … 482 498 ! grid_hgr_nam%d_ppe2_m = dn_ppe2_m 483 499 484 grid_hgr_nam%i_cla = in_cla485 486 grid_hgr_nam%c_cfg = TRIM(cn_cfg)500 ! grid_hgr_nam%i_cla = in_cla 501 502 ! grid_hgr_nam%c_cfg = TRIM(cn_cfg) 487 503 grid_hgr_nam%i_cfg = in_cfg 488 grid_hgr_nam% i_bench = in_bench504 grid_hgr_nam%l_bench = ln_bench 489 505 490 506 ELSE … … 505 521 !> @param[in] jpj 506 522 !------------------------------------------------------------------- 507 SUBROUTINE grid_hgr_fill(td_nam,jpi,jpj )523 SUBROUTINE grid_hgr_fill(td_nam,jpi,jpj,ld_domcfg) 508 524 IMPLICIT NONE 509 525 ! Argument … … 511 527 INTEGER(i4), INTENT(IN) :: jpi 512 528 INTEGER(i4), INTENT(IN) :: jpj 529 LOGICAL , INTENT(IN) :: ld_domcfg 513 530 514 531 ! local variable … … 516 533 ! loop indices 517 534 !---------------------------------------------------------------- 518 CALL logger_info('GRI GHGR FILL : define the horizontal mesh from ithe'//&535 CALL logger_info('GRID HGR FILL : define the horizontal mesh from ithe'//& 519 536 & ' type of horizontal mesh mshhgr = '//TRIM(fct_str(td_nam%i_mshhgr))) 520 537 IF( td_nam%i_mshhgr == 1 )THEN … … 538 555 CASE(0) ! curvilinear coordinate on the sphere read in coordinate.nc file 539 556 540 CALL grid_hgr__fill_curv(td_nam ,jpi,jpj)557 CALL grid_hgr__fill_curv(td_nam)!,jpi,jpj) 541 558 542 559 CASE(1) ! geographical mesh on the sphere with regular grid-spacing … … 558 575 CASE DEFAULT 559 576 560 CALL logger_fatal('GRI GHGR FILL : bad flag value for mshhgr = '//&577 CALL logger_fatal('GRID HGR FILL : bad flag value for mshhgr = '//& 561 578 & TRIM(fct_str(td_nam%i_mshhgr))) 562 579 … … 567 584 568 585 ! create coriolis factor 569 CALL grid_hgr__fill_coriolis(td_nam,jpi ,jpj)586 CALL grid_hgr__fill_coriolis(td_nam,jpi)!,jpj) 570 587 571 588 ! Control of domain for symetrical condition … … 582 599 ! compute angles between model grid lines and the North direction 583 600 ! --------------------------------------------------------------- 584 CALL grid_hgr__angle(td_nam,jpi,jpj) 601 IF( .NOT. ld_domcfg )THEN 602 CALL grid_hgr__angle(td_nam,jpi,jpj) 603 ENDIF 585 604 586 605 END SUBROUTINE grid_hgr_fill … … 591 610 !> @author J.Paul 592 611 !> @date September, 2015 - Initial version 612 !> @date October, 2016 613 !> - do not use anymore special case for ORCA grid 593 614 !> 594 615 !> @param[in] td_nam 595 ! >@param[in] jpi596 ! >@param[in] jpj597 !------------------------------------------------------------------- 598 SUBROUTINE grid_hgr__fill_curv( td_nam ,jpi,jpj )616 ! @param[in] jpi 617 ! @param[in] jpj 618 !------------------------------------------------------------------- 619 SUBROUTINE grid_hgr__fill_curv( td_nam )!,jpi,jpj ) 599 620 IMPLICIT NONE 600 621 ! Argument 601 622 TYPE(TNAMH), INTENT(IN) :: td_nam 602 INTEGER(i4), INTENT(IN) :: jpi603 INTEGER(i4), INTENT(IN) :: jpj623 ! INTEGER(i4), INTENT(IN) :: jpi 624 ! INTEGER(i4), INTENT(IN) :: jpj 604 625 605 626 ! local variable 606 INTEGER(i4) :: ii0, ii1, ij0, ij1 ! temporary integers607 INTEGER(i4) :: isrow ! index for ORCA1 starting row627 ! INTEGER(i4) :: ii0, ii1, ij0, ij1 ! temporary integers 628 ! INTEGER(i4) :: isrow ! index for ORCA1 starting row 608 629 609 630 TYPE(TMPP) :: tl_coord … … 662 683 !! WARNING extended grid have to be correctly fill 663 684 664 !! special case for ORCA grid665 ! ORCA R2 configuration666 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN667 IF( td_nam%i_cla == 0 ) THEN668 !669 ! Gibraltar Strait (e2u = 20 km)670 ii0 = 139 ; ii1 = 140671 ij0 = 102 ; ij1 = 102672 ! e2u = 20 km673 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3674 CALL logger_info('orca_r2: Gibraltar : e2u reduced to 20 km')675 !676 ! Bab el Mandeb (e2u = 18 km)677 ii0 = 160 ; ii1 = 160678 ij0 = 88 ; ij1 = 88679 ! e1v = 18 km680 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 18.e3681 ! e2u = 30 km682 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3683 684 CALL logger_info('orca_r2: Bab el Mandeb: e2u reduced to 30 km')685 CALL logger_info('e1v reduced to 18 km')686 ENDIF687 ! Danish Straits688 ii0 = 145 ; ii1 = 146689 ij0 = 116 ; ij1 = 116690 ! e2u = 10 km691 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3692 CALL logger_info('orca_r2: Danish Straits : e2u reduced to 10 km')693 ENDIF694 695 ! ORCA R1 configuration696 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 1 ) THEN697 ! This dirty section will be suppressed by simplification process: all this will come back in input files698 ! Currently these hard-wired indices relate to configuration with699 ! extend grid (jpjglo=332)700 ! which had a grid-size of 362x292.701 702 isrow = 332 - jpj703 704 ! Gibraltar Strait (e2u = 20 km)705 ii0 = 282 ; ii1 = 283706 ij0 = 201 + isrow ; ij1 = 241 - isrow707 ! e2u = 20 km708 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3709 CALL logger_info('orca_r1: Gibraltar : e2u reduced to 20 km')710 711 ! Bhosporus Strait (e2u = 10 km)712 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u = 10 km)713 ij0 = 208 + isrow ; ij1 = 248 - isrow714 ! Bhosporus Strait (e2u = 10 km)715 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3716 CALL logger_info('orca_r1: Bhosporus : e2u reduced to 10 km')717 718 ! Lombok Strait (e1v = 13 km)719 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v = 13 km)720 ij0 = 124 + isrow ; ij1 = 165 - isrow721 ! Lombok Strait (e1v = 13 km)722 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3723 CALL logger_info('orca_r1: Lombok : e1v reduced to 10 km')724 725 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]726 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]727 ij0 = 124 + isrow ; ij1 = 165 - isrow728 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]729 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 8.e3730 CALL logger_info('orca_r1: Sumba : e1v reduced to 8 km')731 732 ! Ombai Strait (e1v = 13 km)733 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v = 13 km)734 ij0 = 124 + isrow ; ij1 = 165 - isrow735 ! Ombai Strait (e1v = 13 km)736 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3737 CALL logger_info('orca_r1: Ombai : e1v reduced to 13 km')738 739 ! Timor Passage (e1v = 20 km)740 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v = 20 km)741 ij0 = 124 + isrow ; ij1 = 145 - isrow742 ! Timor Passage (e1v = 20 km)743 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3744 CALL logger_info('orca_r1: Timor Passage : e1v reduced to 20 km')745 746 ! West Halmahera Strait (e1v = 30 km)747 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v = 30 km)748 ij0 = 141 + isrow ; ij1 = 182 - isrow749 ! West Halmahera Strait (e1v = 30 km)750 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3751 CALL logger_info('orca_r1: W Halmahera : e1v reduced to 30 km')752 753 ! East Halmahera Strait (e1v = 50 km)754 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v = 50 km)755 ij0 = 141 + isrow ; ij1 = 182 - isrow756 ! East Halmahera Strait (e1v = 50 km)757 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 50.e3758 CALL logger_info('orca_r1: E Halmahera : e1v reduced to 50 km')759 760 ENDIF761 762 ! ORCA R05 configuration763 IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 05 ) THEN764 765 ! Gibraltar Strait (e2u = 20 km)766 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u = 20 km)767 ij0 = 327 ; ij1 = 327768 ! Gibraltar Strait (e2u = 20 km)769 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3770 CALL logger_info('orca_r05: Reduced e2u at the Gibraltar Strait')771 !772 ! Bosphore Strait (e2u = 10 km)773 ii0 = 627 ; ii1 = 628 ! Bosphore Strait (e2u = 10 km)774 ij0 = 343 ; ij1 = 343775 ! Bosphore Strait (e2u = 10 km)776 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3777 CALL logger_info('orca_r05: Reduced e2u at the Bosphore Strait')778 !779 ! Sumba Strait (e2u = 40 km)780 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u = 40 km)781 ij0 = 232 ; ij1 = 232782 ! Sumba Strait (e2u = 40 km)783 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 40.e3784 CALL logger_info('orca_r05: Reduced e2u at the Sumba Strait')785 !786 ! Ombai Strait (e2u = 15 km)787 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u = 15 km)788 ij0 = 232 ; ij1 = 232789 ! Ombai Strait (e2u = 15 km)790 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 15.e3791 CALL logger_info('orca_r05: Reduced e2u at the Ombai Strait')792 !793 ! Palk Strait (e2u = 10 km)794 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u = 10 km)795 ij0 = 270 ; ij1 = 270796 ! Palk Strait (e2u = 10 km)797 tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3798 CALL logger_info('orca_r05: Reduced e2u at the Palk Strait')799 !800 ! Lombok Strait (e1v = 10 km)801 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v = 10 km)802 ij0 = 232 ; ij1 = 233803 ! Lombok Strait (e1v = 10 km)804 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3805 CALL logger_info('orca_r05: Reduced e1v at the Lombok Strait')806 !807 !808 ! Bab el Mandeb (e1v = 25 km)809 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v = 25 km)810 ij0 = 276 ; ij1 = 276811 ! Bab el Mandeb (e1v = 25 km)812 tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 25.e3813 CALL logger_info('orca_r05: Reduced e1v at the Bab el Mandeb')814 815 ENDIF685 ! !! special case for ORCA grid 686 ! ! ORCA R2 configuration 687 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN 688 ! IF( td_nam%i_cla == 0 ) THEN 689 ! ! 690 ! ! Gibraltar Strait (e2u = 20 km) 691 ! ii0 = 139 ; ii1 = 140 692 ! ij0 = 102 ; ij1 = 102 693 ! ! e2u = 20 km 694 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 695 ! CALL logger_info('orca_r2: Gibraltar : e2u reduced to 20 km') 696 ! ! 697 ! ! Bab el Mandeb (e2u = 18 km) 698 ! ii0 = 160 ; ii1 = 160 699 ! ij0 = 88 ; ij1 = 88 700 ! ! e1v = 18 km 701 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 18.e3 702 ! ! e2u = 30 km 703 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3 704 ! 705 ! CALL logger_info('orca_r2: Bab el Mandeb: e2u reduced to 30 km') 706 ! CALL logger_info('e1v reduced to 18 km') 707 ! ENDIF 708 ! ! Danish Straits 709 ! ii0 = 145 ; ii1 = 146 710 ! ij0 = 116 ; ij1 = 116 711 ! ! e2u = 10 km 712 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 713 ! CALL logger_info('orca_r2: Danish Straits : e2u reduced to 10 km') 714 ! ENDIF 715 ! 716 ! ! ORCA R1 configuration 717 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 1 ) THEN 718 ! ! This dirty section will be suppressed by simplification process: all this will come back in input files 719 ! ! Currently these hard-wired indices relate to configuration with 720 ! ! extend grid (jpjglo=332) 721 ! ! which had a grid-size of 362x292. 722 ! 723 ! isrow = 332 - jpj 724 ! 725 ! ! Gibraltar Strait (e2u = 20 km) 726 ! ii0 = 282 ; ii1 = 283 727 ! ij0 = 201 + isrow ; ij1 = 241 - isrow 728 ! ! e2u = 20 km 729 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 730 ! CALL logger_info('orca_r1: Gibraltar : e2u reduced to 20 km') 731 ! 732 ! ! Bhosporus Strait (e2u = 10 km) 733 ! ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u = 10 km) 734 ! ij0 = 208 + isrow ; ij1 = 248 - isrow 735 ! ! Bhosporus Strait (e2u = 10 km) 736 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 737 ! CALL logger_info('orca_r1: Bhosporus : e2u reduced to 10 km') 738 ! 739 ! ! Lombok Strait (e1v = 13 km) 740 ! ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v = 13 km) 741 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 742 ! ! Lombok Strait (e1v = 13 km) 743 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3 744 ! CALL logger_info('orca_r1: Lombok : e1v reduced to 10 km') 745 ! 746 ! ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 747 ! ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 748 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 749 ! ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on] 750 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 8.e3 751 ! CALL logger_info('orca_r1: Sumba : e1v reduced to 8 km') 752 ! 753 ! ! Ombai Strait (e1v = 13 km) 754 ! ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v = 13 km) 755 ! ij0 = 124 + isrow ; ij1 = 165 - isrow 756 ! ! Ombai Strait (e1v = 13 km) 757 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3 758 ! CALL logger_info('orca_r1: Ombai : e1v reduced to 13 km') 759 ! 760 ! ! Timor Passage (e1v = 20 km) 761 ! ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v = 20 km) 762 ! ij0 = 124 + isrow ; ij1 = 145 - isrow 763 ! ! Timor Passage (e1v = 20 km) 764 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 765 ! CALL logger_info('orca_r1: Timor Passage : e1v reduced to 20 km') 766 ! 767 ! ! West Halmahera Strait (e1v = 30 km) 768 ! ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v = 30 km) 769 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 770 ! ! West Halmahera Strait (e1v = 30 km) 771 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3 772 ! CALL logger_info('orca_r1: W Halmahera : e1v reduced to 30 km') 773 ! 774 ! ! East Halmahera Strait (e1v = 50 km) 775 ! ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v = 50 km) 776 ! ij0 = 141 + isrow ; ij1 = 182 - isrow 777 ! ! East Halmahera Strait (e1v = 50 km) 778 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 50.e3 779 ! CALL logger_info('orca_r1: E Halmahera : e1v reduced to 50 km') 780 ! 781 ! ENDIF 782 ! 783 ! ! ORCA R05 configuration 784 ! IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 05 ) THEN 785 ! 786 ! ! Gibraltar Strait (e2u = 20 km) 787 ! ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u = 20 km) 788 ! ij0 = 327 ; ij1 = 327 789 ! ! Gibraltar Strait (e2u = 20 km) 790 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3 791 ! CALL logger_info('orca_r05: Reduced e2u at the Gibraltar Strait') 792 ! ! 793 ! ! Bosphore Strait (e2u = 10 km) 794 ! ii0 = 627 ; ii1 = 628 ! Bosphore Strait (e2u = 10 km) 795 ! ij0 = 343 ; ij1 = 343 796 ! ! Bosphore Strait (e2u = 10 km) 797 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 798 ! CALL logger_info('orca_r05: Reduced e2u at the Bosphore Strait') 799 ! ! 800 ! ! Sumba Strait (e2u = 40 km) 801 ! ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u = 40 km) 802 ! ij0 = 232 ; ij1 = 232 803 ! ! Sumba Strait (e2u = 40 km) 804 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 40.e3 805 ! CALL logger_info('orca_r05: Reduced e2u at the Sumba Strait') 806 ! ! 807 ! ! Ombai Strait (e2u = 15 km) 808 ! ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u = 15 km) 809 ! ij0 = 232 ; ij1 = 232 810 ! ! Ombai Strait (e2u = 15 km) 811 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 15.e3 812 ! CALL logger_info('orca_r05: Reduced e2u at the Ombai Strait') 813 ! ! 814 ! ! Palk Strait (e2u = 10 km) 815 ! ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u = 10 km) 816 ! ij0 = 270 ; ij1 = 270 817 ! ! Palk Strait (e2u = 10 km) 818 ! tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 819 ! CALL logger_info('orca_r05: Reduced e2u at the Palk Strait') 820 ! ! 821 ! ! Lombok Strait (e1v = 10 km) 822 ! ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v = 10 km) 823 ! ij0 = 232 ; ij1 = 233 824 ! ! Lombok Strait (e1v = 10 km) 825 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 10.e3 826 ! CALL logger_info('orca_r05: Reduced e1v at the Lombok Strait') 827 ! ! 828 ! ! 829 ! ! Bab el Mandeb (e1v = 25 km) 830 ! ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v = 25 km) 831 ! ij0 = 276 ; ij1 = 276 832 ! ! Bab el Mandeb (e1v = 25 km) 833 ! tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 25.e3 834 ! CALL logger_info('orca_r05: Reduced e1v at the Bab el Mandeb') 835 ! 836 ! ENDIF 816 837 817 838 END SUBROUTINE grid_hgr__fill_curv … … 1071 1092 ze1 = 106000. / FLOAT(td_nam%i_cfg) 1072 1093 ! benchmark: forced the resolution to be about 100 km 1073 IF( td_nam% i_bench /= 0) ze1 = 106000.e01094 IF( td_nam%l_bench ) ze1 = 106000.e0 1074 1095 zsin_alpha = - SQRT( 2. ) / 2. 1075 1096 zcos_alpha = SQRT( 2. ) / 2. 1076 1097 ze1deg = ze1 / (dp_rearth * dp_deg2rad) 1077 ! benchmark: keep the lat/+lon at the right in_cfg resolution1078 IF( td_nam%i_bench /= 0 ) ze1deg = ze1deg / FLOAT(td_nam%i_cfg)1079 1098 dl_glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpj-2 ) 1080 1099 dl_gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpj-2 ) … … 1134 1153 !> @author J.Paul 1135 1154 !> @date September, 2015 - Initial version 1155 !> @date October, 2016 1156 !> - compute coriolis factor at f-point and at t-point 1136 1157 !> 1137 1158 !> @param[in] td_nam 1138 1159 !> @param[in] jpi 1139 ! >@param[in] jpj1140 !------------------------------------------------------------------- 1141 SUBROUTINE grid_hgr__fill_coriolis(td_nam,jpi ,jpj)1160 ! @param[in] jpj 1161 !------------------------------------------------------------------- 1162 SUBROUTINE grid_hgr__fill_coriolis(td_nam,jpi)!,jpj) 1142 1163 IMPLICIT NONE 1143 1164 ! Argument 1144 1165 TYPE(TNAMH), INTENT(IN) :: td_nam 1145 1166 INTEGER(i4), INTENT(IN) :: jpi 1146 INTEGER(i4), INTENT(IN) :: jpj1167 ! INTEGER(i4), INTENT(IN) :: jpj 1147 1168 1148 1169 ! local variable … … 1159 1180 CASE ( 0, 1, 4 ) ! mesh on the sphere 1160 1181 1161 tg_ff%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphif%d_value(:,:,1,1)) 1182 tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphif%d_value(:,:,1,1)) 1183 tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphit%d_value(:,:,1,1)) ! at t-point 1162 1184 1163 1185 CASE ( 2 ) ! f-plane at ppgphi0 1164 1186 1165 tg_ff%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 ) 1187 tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 ) 1188 tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 ) 1166 1189 CALL logger_info('f-plane: Coriolis parameter = constant = '//& 1167 & TRIM(fct_str(tg_ff %d_value(1,1,1,1))) )1190 & TRIM(fct_str(tg_ff_f%d_value(1,1,1,1))) ) 1168 1191 1169 1192 CASE ( 3 ) ! beta-plane … … 1178 1201 zf0 = 2. * dp_omega * SIN( dp_deg2rad * zphi0 ) 1179 1202 ! f = f0 +beta* y ( y=0 at south) 1180 tg_ff%d_value(:,:,1,1) = zf0 + zbeta * tg_gphif%d_value(:,:,1,1) * 1.e3 1203 tg_ff_f%d_value(:,:,1,1) = zf0 + zbeta * tg_gphif%d_value(:,:,1,1) * 1.e3 1204 tg_ff_t%d_value(:,:,1,1) = zf0 + zbeta * tg_gphit%d_value(:,:,1,1) * 1.e3 1181 1205 1182 1206 CASE ( 5 ) ! beta-plane and rotated domain (gyre configuration) … … 1190 1214 1191 1215 ! f = f0 +beta* y ( y=0 at south) 1192 tg_ff%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphif%d_value(:,:,1,1) - zphi0 ) * dp_deg2rad * dp_rearth ) 1216 tg_ff_f%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphif%d_value(:,:,1,1) - zphi0 ) & 1217 & * dp_deg2rad * dp_rearth ) 1218 tg_ff_t%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphit%d_value(:,:,1,1) - zphi0 ) & 1219 & * dp_deg2rad * dp_rearth ) 1193 1220 1194 1221 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.
