source: trunk/MESOSCALE_DEV/SRC/ARWpost/src/module_arrays_old.f90 @ 207

Last change on this file since 207 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
Line 
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  ELSE IF (trim(cname) == 'P') THEN
108     allocate(P(west_east_dim,south_north_dim,bottom_top_dim))
109     P = real_array
110     have_P = .TRUE.
111  ELSE IF (trim(cname) == 'PB') THEN
112     allocate(PB(west_east_dim,south_north_dim,bottom_top_dim))
113     PB = real_array
114     have_PB = .TRUE.
115!  ELSE IF (trim(cname) == 'PTOT') THEN
116!     allocate(P(west_east_dim,south_north_dim,bottom_top_dim))
117!     allocate(PB(west_east_dim,south_north_dim,bottom_top_dim))
118!     P = 0.5*real_array
119!     PB = 0.5*real_array
120!     have_P = .TRUE.
121!     have_PB = .TRUE.
122
123  ELSE IF (trim(cname) == 'PSFC') THEN
124     allocate(PSFC(west_east_dim,south_north_dim))
125     PSFC = real_array(:,:,1)
126     have_PSFC = .TRUE.
127
128  ELSE IF (trim(cname) == 'MU') THEN
129     allocate(MU(west_east_dim,south_north_dim))
130     MU = real_array(:,:,1)
131     have_MU = .TRUE.
132  ELSE IF (trim(cname) == 'MUB') THEN
133     allocate(MUB(west_east_dim,south_north_dim))
134     MUB = real_array(:,:,1)
135     have_MUB = .TRUE.
136  ELSE IF (trim(cname) == 'ZNU') THEN
137     allocate(ZNU(bottom_top_dim))
138     ZNU = real_array(:,1,1)
139     have_ZNU = .TRUE.
140  ELSE IF (trim(cname) == 'ZNW') THEN
141     allocate(ZNW(bottom_top_dim+1))
142     ZNW = real_array(:,1,1)
143     have_ZNW = .TRUE.
144  ELSE IF (trim(cname) == 'P_TOP') THEN
145     PTOP = real_array(1,1,1)
146     have_PTOP = .TRUE.
147
148  ELSE IF (trim(cname) == 'PH') THEN
149     allocate(PH(west_east_dim,south_north_dim,bottom_top_dim))
150     PH = 0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))
151     have_PH = .TRUE.
152  ELSE IF (trim(cname) == 'PHB') THEN
153     allocate(PHB(west_east_dim,south_north_dim,bottom_top_dim))
154     PHB = 0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))!
155     have_PHB = .TRUE.
156!  ELSE IF (trim(cname) == 'PHTOT') THEN
157!     allocate(PH(west_east_dim,south_north_dim,bottom_top_dim))
158!     allocate(PHB(west_east_dim,south_north_dim,bottom_top_dim))       
159!!
160!! MARS caca: staggering problems
161!!
162!!     PH = 0.5*0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))
163!!     PHB = 0.5*0.5*(real_array(:,:,1:bottom_top_dim)+real_array(:,:,2:bottom_top_dim+1))
164!PH = 0.5*real_array
165!PHB = 0.5*real_array
166!     have_PH = .TRUE.
167!     have_PHB = .TRUE.
168
169  ELSE IF (trim(cname) == 'U' .or. trim(cname) == 'UU') THEN
170     IF (keep_wind_arrays) THEN
171       allocate(UUU(west_east_dim,south_north_dim,bottom_top_dim))
172       UUU = 0.5*(real_array(1:west_east_dim,:,:)+real_array(2:west_east_dim+1,:,:))
173       have_UUU = .TRUE.
174     END IF
175  ELSE IF (trim(cname) == 'V' .or. trim(cname) == 'VV') THEN
176     IF (keep_wind_arrays) THEN
177       allocate(VVV(west_east_dim,south_north_dim,bottom_top_dim))
178       VVV = 0.5*(real_array(:,1:south_north_dim,:)+real_array(:,2:south_north_dim+1,:))
179       have_VVV = .TRUE.
180     END IF
181
182  ELSE IF (trim(cname) == 'TT' .or. trim(cname) == 'TK') THEN
183     allocate(TK(west_east_dim,south_north_dim,bottom_top_dim))
184     TK = real_array
185     have_TK = .TRUE.
186  ELSE IF (trim(cname) == 'T') THEN
187     allocate(T(west_east_dim,south_north_dim,bottom_top_dim))
188     T = real_array
189     have_T = .TRUE.
190
191  ELSE IF (trim(cname) == 'QVAPOR') THEN
192     allocate(QV(west_east_dim,south_north_dim,bottom_top_dim))
193     QV = real_array
194     have_QV = .TRUE.
195  ELSE IF (trim(cname) == 'QRAIN' .and. keep_moist_arrays ) THEN
196     allocate(QR(west_east_dim,south_north_dim,bottom_top_dim))
197     QR = real_array
198     have_QR = .TRUE.
199  ELSE IF (trim(cname) == 'QSNOW' .and. keep_moist_arrays ) THEN
200     allocate(QS(west_east_dim,south_north_dim,bottom_top_dim))
201     QS = real_array
202     have_QS = .TRUE.
203  ELSE IF (trim(cname) == 'QGRAUP' .and. keep_moist_arrays ) THEN
204     allocate(QG(west_east_dim,south_north_dim,bottom_top_dim))
205     QG = real_array
206     have_QG = .TRUE.
207  END IF
208 
209  END SUBROUTINE keep_arrays
210
211END MODULE module_arrays
Note: See TracBrowser for help on using the repository browser.