| 1 | !WRF:DRIVER_LAYER:NESTING |
|---|
| 2 | ! |
|---|
| 3 | |
|---|
| 4 | |
|---|
| 5 | MODULE module_nesting |
|---|
| 6 | |
|---|
| 7 | USE module_machine |
|---|
| 8 | USE module_driver_constants |
|---|
| 9 | USE module_domain |
|---|
| 10 | USE module_configure |
|---|
| 11 | USE module_utility |
|---|
| 12 | |
|---|
| 13 | LOGICAL, DIMENSION( max_domains ) :: active_domain |
|---|
| 14 | |
|---|
| 15 | CONTAINS |
|---|
| 16 | |
|---|
| 17 | LOGICAL FUNCTION nests_to_open ( parent , nestid_ret , kid_ret ) |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | TYPE(domain) , INTENT(IN) :: parent |
|---|
| 20 | INTEGER, INTENT(OUT) :: nestid_ret , kid_ret |
|---|
| 21 | ! Local data |
|---|
| 22 | INTEGER :: parent_id |
|---|
| 23 | INTEGER :: nestid, kid |
|---|
| 24 | INTEGER :: s_yr,s_mm,s_dd,s_h,s_m,s_s,rc |
|---|
| 25 | INTEGER :: e_yr,e_mm,e_dd,e_h,e_m,e_s |
|---|
| 26 | INTEGER :: max_dom |
|---|
| 27 | LOGICAL :: grid_allowed |
|---|
| 28 | TYPE (WRFU_Time) :: nest_start, nest_stop |
|---|
| 29 | !#define STUB_FOR_NOW |
|---|
| 30 | #ifndef STUB_FOR_NOW |
|---|
| 31 | nestid_ret = 0 |
|---|
| 32 | kid_ret = 0 |
|---|
| 33 | nests_to_open = .false. |
|---|
| 34 | CALL nl_get_max_dom( 1, max_dom ) |
|---|
| 35 | #if (NMM_CORE == 1) |
|---|
| 36 | # if (NMM_NEST == 0) |
|---|
| 37 | IF ( max_dom > 1 ) THEN |
|---|
| 38 | CALL wrf_error_fatal( 'WRF-NMM compiled without nesting; set max_dom to 1 in namelist.input' ) |
|---|
| 39 | END IF |
|---|
| 40 | # endif |
|---|
| 41 | #endif |
|---|
| 42 | DO nestid = 2, max_dom |
|---|
| 43 | CALL nl_get_grid_allowed( nestid, grid_allowed ) |
|---|
| 44 | IF ( .NOT. active_domain( nestid ) .AND. grid_allowed ) THEN |
|---|
| 45 | CALL nl_get_parent_id( nestid, parent_id ) ! from namelist |
|---|
| 46 | IF ( parent_id .EQ. parent%id ) THEN |
|---|
| 47 | CALL nl_get_start_year(nestid,s_yr) ; CALL nl_get_end_year(nestid,e_yr) |
|---|
| 48 | CALL nl_get_start_month(nestid,s_mm) ; CALL nl_get_end_month(nestid,e_mm) |
|---|
| 49 | CALL nl_get_start_day(nestid,s_dd) ; CALL nl_get_end_day(nestid,e_dd) |
|---|
| 50 | CALL nl_get_start_hour(nestid,s_h) ; CALL nl_get_end_hour(nestid,e_h) |
|---|
| 51 | CALL nl_get_start_minute(nestid,s_m) ; CALL nl_get_end_minute(nestid,e_m) |
|---|
| 52 | CALL nl_get_start_second(nestid,s_s) ; CALL nl_get_end_second(nestid,e_s) |
|---|
| 53 | CALL WRFU_TimeSet( nest_start,YY=s_yr,MM=s_mm,DD=s_dd,H=s_h,M=s_m,S=s_s,rc=rc) |
|---|
| 54 | CALL WRFU_TimeSet( nest_stop,YY=e_yr,MM=e_mm,DD=e_dd,H=e_h,M=e_m,S=e_s,rc=rc) |
|---|
| 55 | IF ( nest_start .LE. domain_get_current_time(head_grid) .AND. & |
|---|
| 56 | nest_stop .GT. domain_get_current_time(head_grid) ) THEN |
|---|
| 57 | DO kid = 1 , max_nests |
|---|
| 58 | IF ( .NOT. ASSOCIATED ( parent%nests(kid)%ptr ) ) THEN |
|---|
| 59 | active_domain( nestid ) = .true. |
|---|
| 60 | nestid_ret = nestid |
|---|
| 61 | kid_ret = kid |
|---|
| 62 | nests_to_open = .TRUE. |
|---|
| 63 | RETURN |
|---|
| 64 | END IF |
|---|
| 65 | END DO |
|---|
| 66 | END IF |
|---|
| 67 | END IF |
|---|
| 68 | END IF |
|---|
| 69 | END DO |
|---|
| 70 | #else |
|---|
| 71 | nestid_ret = 0 |
|---|
| 72 | kid_ret = 0 |
|---|
| 73 | nests_to_open = .FALSE. |
|---|
| 74 | #endif |
|---|
| 75 | RETURN |
|---|
| 76 | END FUNCTION nests_to_open |
|---|
| 77 | |
|---|
| 78 | ! Descend tree rooted at grid and set sibling pointers for |
|---|
| 79 | ! grids that overlap. We need some kind of global point space |
|---|
| 80 | ! for working this out. |
|---|
| 81 | |
|---|
| 82 | SUBROUTINE set_overlaps ( grid ) |
|---|
| 83 | IMPLICIT NONE |
|---|
| 84 | TYPE (domain), INTENT(INOUT) :: grid |
|---|
| 85 | ! stub |
|---|
| 86 | END SUBROUTINE set_overlaps |
|---|
| 87 | |
|---|
| 88 | SUBROUTINE init_module_nesting |
|---|
| 89 | active_domain = .FALSE. |
|---|
| 90 | END SUBROUTINE init_module_nesting |
|---|
| 91 | |
|---|
| 92 | END MODULE module_nesting |
|---|
| 93 | |
|---|
