source: trunk/MESOSCALE_DEV/SRC/ARWpost/src/module_arrays.f90 @ 1068

Last change on this file since 1068 was 207, checked in by aslmd, 14 years ago

MESOSCALE: A GENERAL CLEAN-UP FOLLOWING UPDATING THE USER MANUAL. EVERYTHING ESSENTIAL IS IN MESOSCALE (much lighter than before). EVERYTHING FOR DEVELOPPERS OR EXPERTS IS IN MESOSCALE_DEV.
File size: 6.5 KB
RevLine 
[207]1!! Which arrays are we carrying around
2
3MODULE module_arrays
4
5  CONTAINS
6  SUBROUTINE clobber_arrays()
7
8  USE module_model_basics
9
10     IF (ALLOCATED(XLAT)) DEALLOCATE(XLAT)
11     have_XLAT = .FALSE.
12     IF (ALLOCATED(XLONG)) DEALLOCATE(XLONG)
13     have_XLONG = .FALSE.
14     IF (ALLOCATED(HGT)) DEALLOCATE(HGT)
15     have_HGT = .FALSE.
16
17     IF (ALLOCATED(U10)) DEALLOCATE(U10)
18     have_U10 = .FALSE.
19     IF (ALLOCATED(V10)) DEALLOCATE(V10)
20     have_V10 = .FALSE.
21
22     IF (ALLOCATED(PRES)) DEALLOCATE(PRES)
23     have_PRES = .FALSE.
24     IF (ALLOCATED(P)) DEALLOCATE(P)
25     have_P = .FALSE.
26     IF (ALLOCATED(PB)) DEALLOCATE(PB)
27     have_PB = .FALSE.
28     IF (ALLOCATED(PSFC)) DEALLOCATE(PSFC)
29     have_PSFC = .FALSE.
30
31     IF (ALLOCATED(MU)) DEALLOCATE(MU)
32     have_MU = .FALSE.
33     IF (ALLOCATED(MUB)) DEALLOCATE(MUB)
34     have_MUB = .FALSE.
35     IF (ALLOCATED(ZNU)) DEALLOCATE(ZNU)
36     have_ZNU = .FALSE.
37     IF (ALLOCATED(ZNW)) DEALLOCATE(ZNW)
38     have_ZNW = .FALSE.
39     
40     have_PTOP = .FALSE.
41
42     IF (ALLOCATED(PH)) DEALLOCATE(PH)
43     have_PH = .FALSE.
44     IF (ALLOCATED(PHB)) DEALLOCATE(PHB)
45     have_PHB = .FALSE.
46
47     IF (ALLOCATED(UUU)) DEALLOCATE(UUU)
48     have_UUU = .FALSE.
49     IF (ALLOCATED(VVV)) DEALLOCATE(VVV)
50     have_VVV = .FALSE.
51
52     IF (ALLOCATED(TK)) DEALLOCATE(TK)
53     have_TK = .FALSE.
54     IF (ALLOCATED(T)) DEALLOCATE(T)
55     have_T = .FALSE.
56
57     IF (ALLOCATED(QV)) DEALLOCATE(QV)
58     have_QV = .FALSE.
59     IF (ALLOCATED(QR)) DEALLOCATE(QR)
60     have_QR = .FALSE.
61     IF (ALLOCATED(QS)) DEALLOCATE(QS)
62     have_QS = .FALSE.
63     IF (ALLOCATED(QG)) DEALLOCATE(QG)
64     have_QG = .FALSE.
65
66  END SUBROUTINE clobber_arrays
67
68
69
70
71  SUBROUTINE keep_arrays(cname, real_array)
72
73  USE gridinfo_module
74  USE module_model_basics
75
76! Arguments
77  character (len=128)             :: cname
78  real, pointer, dimension(:,:,:) :: real_array
79
80  IF (cname(1:4) == 'XLAT') THEN
81     allocate(XLAT(west_east_dim,south_north_dim))
82     XLAT = real_array(:,:,1)
83     have_XLAT = .TRUE.
84  ELSE IF (cname(1:5) == 'XLONG') THEN
85     allocate(XLONG(west_east_dim,south_north_dim))
86     XLONG = real_array(:,:,1)
87     have_XLONG = .TRUE.
88  ELSE IF (cname(1:3) == 'HGT') THEN
89     allocate(HGT(west_east_dim,south_north_dim))
90     HGT = real_array(:,:,1)
91     have_HGT = .TRUE.
92
93  ELSE IF (trim(cname) == 'U10' .and. keep_wind_arrays) THEN
94     allocate(U10(west_east_dim,south_north_dim))
95     U10 = real_array(:,:,1)
96     have_U10 = .TRUE.
97  ELSE IF (trim(cname) == 'V10' .and. keep_wind_arrays) THEN
98     allocate(V10(west_east_dim,south_north_dim))
99     V10 = real_array(:,:,1)
100     have_V10 = .TRUE.
101
102  ELSE IF (trim(cname) == 'PRES') THEN
103     allocate(PRES(west_east_dim,south_north_dim,bottom_top_dim))
104     PRES = real_array
105     have_PRES = .TRUE.
106!!
107!! MARS MARS
108!!
109!  ELSE IF (trim(cname) == 'P') THEN
110!     allocate(P(west_east_dim,south_north_dim,bottom_top_dim))
111!     P = real_array
112!     have_P = .TRUE.
113!  ELSE IF (trim(cname) == 'PB') THEN
114!     allocate(PB(west_east_dim,south_north_dim,bottom_top_dim))
115!     PB = real_array
116!     have_PB = .TRUE.
117  ELSE IF (trim(cname) == 'PTOT') THEN
118     allocate(P(west_east_dim,south_north_dim,bottom_top_dim))
119     allocate(PB(west_east_dim,south_north_dim,bottom_top_dim))
120     P = 0.5*real_array
121     PB = 0.5*real_array
122     have_P = .TRUE.
123     have_PB = .TRUE.
124
125  ELSE IF (trim(cname) == 'PSFC') THEN
126     allocate(PSFC(west_east_dim,south_north_dim))
127     PSFC = real_array(:,:,1)
128     have_PSFC = .TRUE.
129
130  ELSE IF (trim(cname) == 'MU') THEN
131     allocate(MU(west_east_dim,south_north_dim))
132     MU = real_array(:,:,1)
133     have_MU = .TRUE.
134  ELSE IF (trim(cname) == 'MUB') THEN
135     allocate(MUB(west_east_dim,south_north_dim))
136     MUB = real_array(:,:,1)
137     have_MUB = .TRUE.
138  ELSE IF (trim(cname) == 'ZNU') THEN
139     allocate(ZNU(bottom_top_dim))
140     ZNU = real_array(:,1,1)
141     have_ZNU = .TRUE.
142  ELSE IF (trim(cname) == 'ZNW') THEN
143     allocate(ZNW(bottom_top_dim+1))
144     ZNW = real_array(:,1,1)
145     have_ZNW = .TRUE.
146  ELSE IF (trim(cname) == 'P_TOP') THEN
147     PTOP = real_array(1,1,1)
148     have_PTOP = .TRUE.
149
150!!
151!! MARS MARS
152!!
153!  ELSE IF (trim(cname) == 'PH') THEN
154!     allocate(PH(west_east_dim,south_north_dim,bottom_top_dim))
155!     PH = 0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))
156!     have_PH = .TRUE.
157!  ELSE IF (trim(cname) == 'PHB') THEN
158!     allocate(PHB(west_east_dim,south_north_dim,bottom_top_dim))
159!     PHB = 0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))!
160!     have_PHB = .TRUE.
161  ELSE IF (trim(cname) == 'PHTOT') THEN
162     allocate(PH(west_east_dim,south_north_dim,bottom_top_dim))
163     allocate(PHB(west_east_dim,south_north_dim,bottom_top_dim))       
164     PH = 0.5*real_array
165     PHB = 0.5*real_array
166
167!PH = 0.5*0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))
168!PHB = 0.5*0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))
169
170     have_PH = .TRUE.
171     have_PHB = .TRUE. 
172
173  ELSE IF (trim(cname) == 'U' .or. trim(cname) == 'UU') THEN
174     IF (keep_wind_arrays) THEN
175       allocate(UUU(west_east_dim,south_north_dim,bottom_top_dim))
176       UUU = 0.5*(real_array(1:west_east_dim,:,:)+real_array(2:west_east_dim+1,:,:))
177       have_UUU = .TRUE.
178     END IF
179  ELSE IF (trim(cname) == 'V' .or. trim(cname) == 'VV') THEN
180     IF (keep_wind_arrays) THEN
181       allocate(VVV(west_east_dim,south_north_dim,bottom_top_dim))
182       VVV = 0.5*(real_array(:,1:south_north_dim,:)+real_array(:,2:south_north_dim+1,:))
183       have_VVV = .TRUE.
184     END IF
185
186  ELSE IF (trim(cname) == 'TT' .or. trim(cname) == 'TK') THEN
187     allocate(TK(west_east_dim,south_north_dim,bottom_top_dim))
188     TK = real_array
189     have_TK = .TRUE.
190  ELSE IF (trim(cname) == 'T') THEN
191     allocate(T(west_east_dim,south_north_dim,bottom_top_dim))
192     T = real_array
193     have_T = .TRUE.
194
195  ELSE IF (trim(cname) == 'QVAPOR') THEN
196     allocate(QV(west_east_dim,south_north_dim,bottom_top_dim))
197     QV = real_array
198     have_QV = .TRUE.
199  ELSE IF (trim(cname) == 'QRAIN' .and. keep_moist_arrays ) THEN
200     allocate(QR(west_east_dim,south_north_dim,bottom_top_dim))
201     QR = real_array
202     have_QR = .TRUE.
203  ELSE IF (trim(cname) == 'QSNOW' .and. keep_moist_arrays ) THEN
204     allocate(QS(west_east_dim,south_north_dim,bottom_top_dim))
205     QS = real_array
206     have_QS = .TRUE.
207  ELSE IF (trim(cname) == 'QGRAUP' .and. keep_moist_arrays ) THEN
208     allocate(QG(west_east_dim,south_north_dim,bottom_top_dim))
209     QG = real_array
210     have_QG = .TRUE.
211  END IF
212 
213  END SUBROUTINE keep_arrays
214
215END MODULE module_arrays
Note: See TracBrowser for help on using the repository browser.