1 | !! Which arrays are we carrying around |
---|
2 | |
---|
3 | MODULE 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 | |
---|
215 | END MODULE module_arrays |
---|