| 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 , kid ) |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | TYPE(domain) , INTENT(IN) :: parent |
|---|
| 20 | INTEGER, INTENT(OUT) :: nestid , kid |
|---|
| 21 | ! Local data |
|---|
| 22 | INTEGER :: parent_id |
|---|
| 23 | INTEGER :: rent |
|---|
| 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 | TYPE (WRFU_Time) :: nest_start, nest_stop |
|---|
| 28 | !#define STUB_FOR_NOW |
|---|
| 29 | #ifndef STUB_FOR_NOW |
|---|
| 30 | nestid = 0 |
|---|
| 31 | kid = 0 |
|---|
| 32 | nests_to_open = .false. |
|---|
| 33 | CALL nl_get_max_dom( 1, max_dom ) |
|---|
| 34 | DO nestid = 2, max_dom |
|---|
| 35 | IF ( .NOT. active_domain( nestid ) ) THEN |
|---|
| 36 | CALL nl_get_parent_id( nestid, parent_id ) ! from namelist |
|---|
| 37 | IF ( parent_id .EQ. parent%id ) THEN |
|---|
| 38 | CALL nl_get_start_year(nestid,s_yr) ; CALL nl_get_end_year(nestid,e_yr) |
|---|
| 39 | CALL nl_get_start_month(nestid,s_mm) ; CALL nl_get_end_month(nestid,e_mm) |
|---|
| 40 | CALL nl_get_start_day(nestid,s_dd) ; CALL nl_get_end_day(nestid,e_dd) |
|---|
| 41 | CALL nl_get_start_hour(nestid,s_h) ; CALL nl_get_end_hour(nestid,e_h) |
|---|
| 42 | CALL nl_get_start_minute(nestid,s_m) ; CALL nl_get_end_minute(nestid,e_m) |
|---|
| 43 | CALL nl_get_start_second(nestid,s_s) ; CALL nl_get_end_second(nestid,e_s) |
|---|
| 44 | 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) |
|---|
| 45 | 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) |
|---|
| 46 | IF ( nest_start .LE. domain_get_current_time(head_grid) .AND. & |
|---|
| 47 | nest_stop .GT. domain_get_current_time(head_grid) ) THEN |
|---|
| 48 | DO kid = 1 , max_nests |
|---|
| 49 | IF ( .NOT. ASSOCIATED ( parent%nests(kid)%ptr ) ) THEN |
|---|
| 50 | active_domain( nestid ) = .true. |
|---|
| 51 | nests_to_open = .true. |
|---|
| 52 | RETURN |
|---|
| 53 | END IF |
|---|
| 54 | END DO |
|---|
| 55 | END IF |
|---|
| 56 | END IF |
|---|
| 57 | END IF |
|---|
| 58 | END DO |
|---|
| 59 | #else |
|---|
| 60 | nestid = 0 |
|---|
| 61 | kid = 0 |
|---|
| 62 | nests_to_open = .false. |
|---|
| 63 | #endif |
|---|
| 64 | RETURN |
|---|
| 65 | END FUNCTION nests_to_open |
|---|
| 66 | |
|---|
| 67 | ! Descend tree rooted at grid and set sibling pointers for |
|---|
| 68 | ! grids that overlap. We need some kind of global point space |
|---|
| 69 | ! for working this out. |
|---|
| 70 | |
|---|
| 71 | SUBROUTINE set_overlaps ( grid ) |
|---|
| 72 | IMPLICIT NONE |
|---|
| 73 | TYPE (domain), INTENT(INOUT) :: grid |
|---|
| 74 | ! stub |
|---|
| 75 | END SUBROUTINE set_overlaps |
|---|
| 76 | |
|---|
| 77 | SUBROUTINE init_module_nesting |
|---|
| 78 | active_domain = .FALSE. |
|---|
| 79 | END SUBROUTINE init_module_nesting |
|---|
| 80 | |
|---|
| 81 | END MODULE module_nesting |
|---|
| 82 | |
|---|
