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