source: trunk/WRF.COMMON/WRFV3/dyn_exp/module_initialize_exp.F @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 4.5 KB
Line 
1!IDEAL:MODEL_LAYER:INITIALIZATION
2!
3
4!  This MODULE holds the routines which are used to perform various initializations
5!  for the individual domains. 
6
7!  This MODULE CONTAINS the following routines:
8
9!  initialize_field_test - 1. Set different fields to different constant
10!                             values.  This is only a test.  If the correct
11!                             domain is not found (based upon the "id")
12!                             then a fatal error is issued.               
13
14MODULE module_initialize
15
16   USE module_domain
17   USE module_state_description
18   USE module_model_constants
19   USE module_timing
20   USE module_configure
21
22
23CONTAINS
24
25   SUBROUTINE init_domain_exp ( grid &
26!
27# include <exp_dummy_args.inc>
28!
29)
30   IMPLICIT NONE
31
32   !  Input data.
33   TYPE (domain), POINTER :: grid
34
35# include <exp_dummy_decl.inc>
36
37   TYPE (grid_config_rec_type)              :: config_flags
38
39   !  Local data
40   INTEGER                             ::                       &
41                                  ids, ide, jds, jde, kds, kde, &
42                                  ims, ime, jms, jme, kms, kme, &
43                                  its, ite, jts, jte, kts, kte, &
44                                  i, j, k
45
46#define COPY_IN
47#include <exp_scalar_derefs.inc>
48
49   SELECT CASE ( model_data_order )
50         CASE ( DATA_ORDER_ZXY )
51   kds = grid%sd31 ; kde = grid%ed31 ;
52   ids = grid%sd32 ; ide = grid%ed32 ;
53   jds = grid%sd33 ; jde = grid%ed33 ;
54
55   kms = grid%sm31 ; kme = grid%em31 ;
56   ims = grid%sm32 ; ime = grid%em32 ;
57   jms = grid%sm33 ; jme = grid%em33 ;
58
59   kts = grid%sp31 ; kte = grid%ep31 ;   ! note that tile is entire patch
60   its = grid%sp32 ; ite = grid%ep32 ;   ! note that tile is entire patch
61   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
62         CASE ( DATA_ORDER_XYZ )
63   ids = grid%sd31 ; ide = grid%ed31 ;
64   jds = grid%sd32 ; jde = grid%ed32 ;
65   kds = grid%sd33 ; kde = grid%ed33 ;
66
67   ims = grid%sm31 ; ime = grid%em31 ;
68   jms = grid%sm32 ; jme = grid%em32 ;
69   kms = grid%sm33 ; kme = grid%em33 ;
70
71   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
72   jts = grid%sp32 ; jte = grid%ep32 ;   ! note that tile is entire patch
73   kts = grid%sp33 ; kte = grid%ep33 ;   ! note that tile is entire patch
74         CASE ( DATA_ORDER_XZY )
75   ids = grid%sd31 ; ide = grid%ed31 ;
76   kds = grid%sd32 ; kde = grid%ed32 ;
77   jds = grid%sd33 ; jde = grid%ed33 ;
78
79   ims = grid%sm31 ; ime = grid%em31 ;
80   kms = grid%sm32 ; kme = grid%em32 ;
81   jms = grid%sm33 ; jme = grid%em33 ;
82
83   its = grid%sp31 ; ite = grid%ep31 ;   ! note that tile is entire patch
84   kts = grid%sp32 ; kte = grid%ep32 ;   ! note that tile is entire patch
85   jts = grid%sp33 ; jte = grid%ep33 ;   ! note that tile is entire patch
86
87   END SELECT
88
89
90   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
91
92! set the boundaries of the X array
93    DO j = jts, jte
94      DO k = kts, kte
95        DO i = its, ite
96          IF ( i == ids .OR. i == ide-1 .OR. j == jds .OR. j == jde-1 ) THEN
97            x_1(i,k,j) = 1.
98            x_2(i,k,j) = 1.
99          ELSE
100            x_1(i,k,j) = 0.
101            x_2(i,k,j) = 0.
102          ENDIF
103        ENDDO
104      ENDDO
105    ENDDO
106
107#define COPY_OUT
108#include <exp_scalar_derefs.inc>
109
110   RETURN
111
112   END SUBROUTINE init_domain_exp
113   
114!-------------------------------------------------------------------
115! this is a wrapper for the solver-specific init_domain routines.
116! Also dereferences the grid variables and passes them down as arguments.
117! This is crucial, since the lower level routines may do message passing
118! and this will get fouled up on machines that insist on passing down
119! copies of assumed-shape arrays (by passing down as arguments, the
120! data are treated as assumed-size -- ie. f77 -- arrays and the copying
121! business is avoided).  Fie on the F90 designers.  Fie and a pox.
122
123   SUBROUTINE init_domain ( grid )
124
125   IMPLICIT NONE
126
127   !  Input data.
128   TYPE (domain), POINTER :: grid
129   !  Local data.
130   INTEGER :: idum1, idum2
131
132#ifdef DEREF_KLUDGE
133!  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
134   INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
135   INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
136   INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
137#endif
138
139#include "deref_kludge.h"
140
141   CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
142
143     CALL init_domain_exp( grid &
144!
145#include <actual_args.inc>
146!
147                        )
148
149   END SUBROUTINE init_domain
150
151   SUBROUTINE init_module_initialize
152   END SUBROUTINE init_module_initialize
153
154
155END MODULE module_initialize
Note: See TracBrowser for help on using the repository browser.