module_nesting.F

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