source: lmdz_wrf/trunk/WRFV3/frame/module_nesting.F @ 1414

Last change on this file since 1414 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 3.2 KB
Line 
1!WRF:DRIVER_LAYER:NESTING
2!
3
4
5MODULE 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
15CONTAINS
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
92END MODULE module_nesting
93
Note: See TracBrowser for help on using the repository browser.