Context Navigation

cosp_modis_simulator.F90 @ 2898

Last change on this file since 2898 was 2713, checked in by idelkadi, 8 years ago
Mise a jour du simulateur COSP. Passage de la version 1.4.0 a la version 1.4.1 (Version suggeree pour CFMIP3/CMIP6)
File size: 24.3 KB

Line
1	! (c) 2009, Regents of the Unversity of Colorado
2	! Author: Robert Pincus, Cooperative Institute for Research in the Environmental Sciences
3	! All rights reserved.
4	! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
5	! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_modis_simulator.F90 $
6	!
7	! Redistribution and use in source and binary forms, with or without modification, are permitted
8	! provided that the following conditions are met:
9	!
10	! * Redistributions of source code must retain the above copyright notice, this list
11	! of conditions and the following disclaimer.
12	! * Redistributions in binary form must reproduce the above copyright notice, this list
13	! of conditions and the following disclaimer in the documentation and/or other materials
14	! provided with the distribution.
15	! * Neither the name of the Met Office nor the names of its contributors may be used
16	! to endorse or promote products derived from this software without specific prior written
17	! permission.
18	!
19	! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
20	! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
21	! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
22	! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23	! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
24	! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
25	! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
26	! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27	!
28
29	!
30	! History:
31	! May 2009 - Robert Pincus - Initial version
32	! Dec 2009 - Robert Pincus - Tiny revisions
33	!
34	MODULE MOD_COSP_Modis_Simulator
35	USE MOD_COSP_CONSTANTS
36	USE MOD_COSP_TYPES
37	use mod_modis_sim, numModisTauBins => numTauHistogramBins, &
38	numModisPressureBins => numPressureHistogramBins, &
39	MODIS_TAU => nominalTauHistogramCenters, &
40	MODIS_TAU_BNDS => nominalTauHistogramBoundaries, &
41	MODIS_PC => nominalPressureHistogramCenters, &
42	MODIS_PC_BNDS => nominalPressureHistogramBoundaries
43	implicit none
44	!------------------------------------------------------------------------------------------------
45	! Public type
46	!
47	! Summary statistics from MODIS retrievals
48	type COSP_MODIS
49	! Dimensions
50	integer :: Npoints ! Number of gridpoints
51
52	!
53	! Grid means; dimension nPoints
54	!
55	real, dimension(:), pointer :: &
56	Cloud_Fraction_Total_Mean, Cloud_Fraction_Water_Mean, Cloud_Fraction_Ice_Mean, &
57	Cloud_Fraction_High_Mean, Cloud_Fraction_Mid_Mean, Cloud_Fraction_Low_Mean, &
58	Optical_Thickness_Total_Mean, Optical_Thickness_Water_Mean, Optical_Thickness_Ice_Mean, &
59	Optical_Thickness_Total_LogMean, Optical_Thickness_Water_LogMean, Optical_Thickness_Ice_LogMean, &
60	Cloud_Particle_Size_Water_Mean, Cloud_Particle_Size_Ice_Mean, &
61	Cloud_Top_Pressure_Total_Mean, &
62	Liquid_Water_Path_Mean, Ice_Water_Path_Mean
63	!
64	! Also need the ISCCP-type optical thickness/cloud top pressure histogram
65	!
66	real, dimension(:, :, :), pointer :: Optical_Thickness_vs_Cloud_Top_Pressure
67	real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffICE
68	real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffLIQ
69	end type COSP_MODIS
70
71	contains
72	!------------------------------------------------------------------------------------------------
73	subroutine COSP_Modis_Simulator(gridBox, subCols, subcolHydro, isccpSim, modisSim)
74	! Arguments
75	type(cosp_gridbox), intent(in ) :: gridBox ! Gridbox info
76	type(cosp_subgrid), intent(in ) :: subCols ! subCol indicators of convective/stratiform
77	type(cosp_sghydro), intent(in ) :: subcolHydro ! subcol hydrometeor contens
78	type(cosp_isccp), intent(in ) :: isccpSim ! ISCCP simulator output
79	type(cosp_modis), intent( out) :: modisSim ! MODIS simulator subcol output
80
81	! ------------------------------------------------------------
82	! Local variables
83	! Leave space only for sunlit points
84
85	integer :: nPoints, nSubCols, nLevels, nSunlit, i, j, k
86
87	! Grid-mean quanties; dimensions nPoints, nLevels
88	real, &
89	dimension(count(gridBox%sunlit(:) > 0), gridBox%nLevels) :: &
90	temperature, pressureLayers
91	real, &
92	dimension(count(gridBox%sunlit(:) > 0), gridBox%nLevels + 1) :: &
93	pressureLevels
94
95	! Subcol quantities, dimension nPoints, nSubCols, nLevels
96	real, &
97	dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns, gridBox%nLevels) :: &
98	opticalThickness, cloudWater, cloudIce, waterSize, iceSize
99
100	! Vertically-integrated subcol quantities; dimensions nPoints, nSubcols
101	integer, &
102	dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: &
103	retrievedPhase
104	real, &
105	dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: &
106	isccpTau, isccpCloudTopPressure, retrievedCloudTopPressure, retrievedTau, retrievedSize
107
108	! Vertically-integrated results
109	real, dimension(count(gridBox%sunlit(:) > 0)) :: &
110	cfTotal, cfLiquid, cfIce, &
111	cfHigh, cfMid, cfLow, &
112	meanTauTotal, meanTauLiquid, meanTauIce, &
113	meanLogTauTotal, meanLogTauLiquid, meanLogTauIce , &
114	meanSizeLiquid, meanSizeIce, &
115	meanCloudTopPressure, &
116	meanLiquidWaterPath, meanIceWaterPath
117
118	real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numModisPressureBins) :: &
119	jointHistogram
120	real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffIceBins) :: &
121	jointHistogram2
122	real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffLiqBins) :: &
123	jointHistogram3
124
125	integer, dimension(count(gridBox%sunlit(:) > 0)) :: sunlit
126	integer, dimension(count(gridBox%sunlit(:) <= 0)) :: notSunlit
127	! ------------------------------------------------------------
128
129	!
130	! Are there any sunlit points?
131	!
132	nSunlit = count(gridBox%sunlit(:) > 0)
133	if(nSunlit > 0) then
134	nLevels = gridBox%Nlevels
135	nPoints = gridBox%Npoints
136	nSubCols = subCols%Ncolumns
137	!
138	! This is a vector index indicating which points are sunlit
139	!
140	sunlit(:) = pack((/ (i, i = 1, nPoints ) /), mask = gridBox%sunlit(:) > 0)
141	notSunlit(:) = pack((/ (i, i = 1, nPoints ) /), mask = .not. gridBox%sunlit(:) > 0)
142
143	!
144	! Copy needed quantities, reversing vertical order and removing points with no sunlight
145	!
146	pressureLevels(:, 1) = 0.0 ! Top of model, following ISCCP sim
147	temperature(:, :) = gridBox%T (sunlit(:), nLevels:1:-1)
148	pressureLayers(:, :) = gridBox%p (sunlit(:), nLevels:1:-1)
149	pressureLevels(:, 2:) = gridBox%ph(sunlit(:), nLevels:1:-1)
150
151	!
152	! Subcolumn properties - first stratiform cloud...
153	!
154	where(subCols%frac_out(sunlit(:), :, :) == I_LSC)
155	!opticalThickness(:, :, :) = &
156	! spread(gridBox%dtau_s (sunlit(:), :), dim = 2, nCopies = nSubCols)
157	cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCLIQ)
158	waterSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_LSCLIQ)
159	cloudIce (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCICE)
160	iceSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_LSCICE)
161	elsewhere
162	opticalThickness(:, :, :) = 0.
163	cloudWater (:, :, :) = 0.
164	cloudIce (:, :, :) = 0.
165	waterSize (:, :, :) = 0.
166	iceSize (:, :, :) = 0.
167	end where
168
169	! Loop version of spread above - intrinsic doesn't work on certain platforms.
170	do k = 1, nLevels
171	do j = 1, nSubCols
172	do i = 1, nSunlit
173	if(subCols%frac_out(sunlit(i), j, k) == I_LSC) then
174	opticalThickness(i, j, k) = gridBox%dtau_s(sunlit(i), k)
175	else
176	opticalThickness(i, j, k) = 0.
177	end if
178	end do
179	end do
180	end do
181
182	!
183	! .. then add convective cloud...
184	!
185	where(subCols%frac_out(sunlit(:), :, :) == I_CVC)
186	!opticalThickness(:, :, :) = &
187	! spread(gridBox%dtau_c( sunlit(:), :), dim = 2, nCopies = nSubCols)
188	cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCLIQ)
189	waterSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_CVCLIQ)
190	cloudIce (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCICE)
191	iceSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_CVCICE)
192	end where
193
194	! Loop version of spread above - intrinsic doesn't work on certain platforms.
195	do k = 1, nLevels
196	do j = 1, nSubCols
197	do i = 1, nSunlit
198	if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
199	end do
200	end do
201	end do
202
203	!
204	! Reverse vertical order
205	!
206	opticalThickness(:, :, :) = opticalThickness(:, :, nLevels:1:-1)
207	cloudWater (:, :, :) = cloudWater (:, :, nLevels:1:-1)
208	waterSize (:, :, :) = waterSize (:, :, nLevels:1:-1)
209	cloudIce (:, :, :) = cloudIce (:, :, nLevels:1:-1)
210	iceSize (:, :, :) = iceSize (:, :, nLevels:1:-1)
211
212	isccpTau(:, :) = isccpSim%boxtau (sunlit(:), :)
213	isccpCloudTopPressure(:, :) = isccpSim%boxptop(sunlit(:), :)
214
215	do i = 1, nSunlit
216	call modis_L2_simulator(temperature(i, :), pressureLayers(i, :), pressureLevels(i, :), &
217	opticalThickness(i, :, :), cloudWater(i, :, :), cloudIce(i, :, :), &
218	waterSize(i, :, :), iceSize(i, :, :), &
219	isccpTau(i, :), isccpCloudTopPressure(i, :), &
220	retrievedPhase(i, :), retrievedCloudTopPressure(i, :), &
221	retrievedTau(i, :), retrievedSize(i, :))
222	end do
223
224	! DJS2015: Call L3 modis simulator used by cospv2.0
225	! call modis_L3_simulator(retrievedPhase, &
226	! retrievedCloudTopPressure, &
227	! retrievedTau, retrievedSize, &
228	! cfTotal, cfLiquid, cfIce, &
229	! cfHigh, cfMid, cfLow, &
230	! meanTauTotal, meanTauLiquid, meanTauIce, &
231	! meanLogTauTotal, meanLogTauLiquid, meanLogTauIce, &
232	! meanSizeLiquid, meanSizeIce, &
233	! meanCloudTopPressure, &
234	! meanLiquidWaterPath, meanIceWaterPath, &
235	! jointHistogram)
236	call modis_column(nSunlit,nSubcols,retrievedPhase,retrievedCloudTopPressure, &
237	retrievedTau,retrievedSize,cfTotal,cfLiquid,cfIce,cfHigh, &
238	cfMid,cfLow,meanTauTotal,meanTauLiquid,meanTauIce, &
239	meanLogTauTotal,meanLogTauLiquid,meanLogTauIce, &
240	meanSizeLiquid,meanSizeIce,meanCloudTopPressure, &
241	meanLiquidWaterPath, meanIceWaterPath, &
242	jointHistogram,jointHistogram2,jointHistogram3)
243	! DJS2015: END
244
245	!
246	! Copy results into COSP structure
247	!
248	modisSim%Cloud_Fraction_Total_Mean(sunlit(:)) = cfTotal(:)
249	modisSim%Cloud_Fraction_Water_Mean(sunlit(:)) = cfLiquid
250	modisSim%Cloud_Fraction_Ice_Mean (sunlit(:)) = cfIce
251
252	modisSim%Cloud_Fraction_High_Mean(sunlit(:)) = cfHigh
253	modisSim%Cloud_Fraction_Mid_Mean (sunlit(:)) = cfMid
254	modisSim%Cloud_Fraction_Low_Mean (sunlit(:)) = cfLow
255
256	modisSim%Optical_Thickness_Total_Mean(sunlit(:)) = meanTauTotal
257	modisSim%Optical_Thickness_Water_Mean(sunlit(:)) = meanTauLiquid
258	modisSim%Optical_Thickness_Ice_Mean (sunlit(:)) = meanTauIce
259
260	modisSim%Optical_Thickness_Total_LogMean(sunlit(:)) = meanLogTauTotal
261	modisSim%Optical_Thickness_Water_LogMean(sunlit(:)) = meanLogTauLiquid
262	modisSim%Optical_Thickness_Ice_LogMean (sunlit(:)) = meanLogTauIce
263
264	modisSim%Cloud_Particle_Size_Water_Mean(sunlit(:)) = meanSizeLiquid
265	modisSim%Cloud_Particle_Size_Ice_Mean (sunlit(:)) = meanSizeIce
266
267	modisSim%Cloud_Top_Pressure_Total_Mean(sunlit(:)) = meanCloudTopPressure
268
269	modisSim%Liquid_Water_Path_Mean(sunlit(:)) = meanLiquidWaterPath
270	modisSim%Ice_Water_Path_Mean (sunlit(:)) = meanIceWaterPath
271
272	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(sunlit(:), 2:numModisTauBins+1, :) = jointHistogram(:, :, :)
273	modisSim%Optical_Thickness_vs_ReffICE(sunlit(:),2:numModisTauBins+1,:) = jointHistogram2(:, :, :)
274	modisSim%Optical_Thickness_vs_ReffLIQ(sunlit(:),2:numModisTauBins+1,:) = jointHistogram3(:, :, :)
275	!
276	! Reorder pressure bins in joint histogram to go from surface to TOA
277	!
278	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:,:,:) = modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, numModisPressureBins:1:-1)
279	if(nSunlit < nPoints) then
280	!
281	! Where it's night and we haven't done the retrievals the values are undefined
282	!
283	modisSim%Cloud_Fraction_Total_Mean(notSunlit(:)) = R_UNDEF
284	modisSim%Cloud_Fraction_Water_Mean(notSunlit(:)) = R_UNDEF
285	modisSim%Cloud_Fraction_Ice_Mean (notSunlit(:)) = R_UNDEF
286
287	modisSim%Cloud_Fraction_High_Mean(notSunlit(:)) = R_UNDEF
288	modisSim%Cloud_Fraction_Mid_Mean (notSunlit(:)) = R_UNDEF
289	modisSim%Cloud_Fraction_Low_Mean (notSunlit(:)) = R_UNDEF
290
291	modisSim%Optical_Thickness_Total_Mean(notSunlit(:)) = R_UNDEF
292	modisSim%Optical_Thickness_Water_Mean(notSunlit(:)) = R_UNDEF
293	modisSim%Optical_Thickness_Ice_Mean (notSunlit(:)) = R_UNDEF
294
295	modisSim%Optical_Thickness_Total_LogMean(notSunlit(:)) = R_UNDEF
296	modisSim%Optical_Thickness_Water_LogMean(notSunlit(:)) = R_UNDEF
297	modisSim%Optical_Thickness_Ice_LogMean (notSunlit(:)) = R_UNDEF
298
299	modisSim%Cloud_Particle_Size_Water_Mean(notSunlit(:)) = R_UNDEF
300	modisSim%Cloud_Particle_Size_Ice_Mean (notSunlit(:)) = R_UNDEF
301
302	modisSim%Cloud_Top_Pressure_Total_Mean(notSunlit(:)) = R_UNDEF
303
304	modisSim%Liquid_Water_Path_Mean(notSunlit(:)) = R_UNDEF
305	modisSim%Ice_Water_Path_Mean (notSunlit(:)) = R_UNDEF
306
307	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(notSunlit(:), :, :) = R_UNDEF
308	modisSim%Optical_Thickness_vs_ReffICE(notSunlit(:), :, :) = R_UNDEF
309	modisSim%Optical_Thickness_vs_ReffLIQ(notSunlit(:), :, :) = R_UNDEF
310	end if
311	else
312	!
313	! It's nightime everywhere - everything is undefined
314	!
315	modisSim%Cloud_Fraction_Total_Mean(:) = R_UNDEF
316	modisSim%Cloud_Fraction_Water_Mean(:) = R_UNDEF
317	modisSim%Cloud_Fraction_Ice_Mean (:) = R_UNDEF
318
319	modisSim%Cloud_Fraction_High_Mean(:) = R_UNDEF
320	modisSim%Cloud_Fraction_Mid_Mean (:) = R_UNDEF
321	modisSim%Cloud_Fraction_Low_Mean (:) = R_UNDEF
322
323	modisSim%Optical_Thickness_Total_Mean(:) = R_UNDEF
324	modisSim%Optical_Thickness_Water_Mean(:) = R_UNDEF
325	modisSim%Optical_Thickness_Ice_Mean (:) = R_UNDEF
326
327	modisSim%Optical_Thickness_Total_LogMean(:) = R_UNDEF
328	modisSim%Optical_Thickness_Water_LogMean(:) = R_UNDEF
329	modisSim%Optical_Thickness_Ice_LogMean (:) = R_UNDEF
330
331	modisSim%Cloud_Particle_Size_Water_Mean(:) = R_UNDEF
332	modisSim%Cloud_Particle_Size_Ice_Mean (:) = R_UNDEF
333
334	modisSim%Cloud_Top_Pressure_Total_Mean(:) = R_UNDEF
335
336	modisSim%Liquid_Water_Path_Mean(:) = R_UNDEF
337	modisSim%Ice_Water_Path_Mean (:) = R_UNDEF
338
339	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
340	modisSim%Optical_Thickness_vs_ReffICE(:, :, :) = R_UNDEF
341	modisSim%Optical_Thickness_vs_ReffLIQ(:, :, :) = R_UNDEF
342	end if
343
344	end subroutine COSP_Modis_Simulator
345	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
346	!------------- SUBROUTINE CONSTRUCT_COSP_MODIS ------------------
347	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
348	SUBROUTINE CONSTRUCT_COSP_MODIS(cfg, nPoints, x)
349	type(cosp_config), intent(in) :: cfg ! Configuration options
350	integer, intent(in) :: Npoints ! Number of sampled points
351	type(cosp_MODIS), intent(out) :: x
352	!
353	! Allocate minumum storage if simulator not used
354	!
355	if (cfg%LMODIS_sim) then
356	x%nPoints = nPoints
357	else
358	x%Npoints = 1
359	endif
360
361	! --- Allocate arrays ---
362	allocate(x%Cloud_Fraction_Total_Mean(x%nPoints))
363	allocate(x%Cloud_Fraction_Water_Mean(x%nPoints))
364	allocate(x%Cloud_Fraction_Ice_Mean(x%nPoints))
365
366	allocate(x%Cloud_Fraction_High_Mean(x%nPoints))
367	allocate(x%Cloud_Fraction_Mid_Mean(x%nPoints))
368	allocate(x%Cloud_Fraction_Low_Mean(x%nPoints))
369
370	allocate(x%Optical_Thickness_Total_Mean(x%nPoints))
371	allocate(x%Optical_Thickness_Water_Mean(x%nPoints))
372	allocate(x%Optical_Thickness_Ice_Mean(x%nPoints))
373
374	allocate(x%Optical_Thickness_Total_LogMean(x%nPoints))
375	allocate(x%Optical_Thickness_Water_LogMean(x%nPoints))
376	allocate(x%Optical_Thickness_Ice_LogMean(x%nPoints))
377
378	allocate(x%Cloud_Particle_Size_Water_Mean(x%nPoints))
379	allocate(x%Cloud_Particle_Size_Ice_Mean(x%nPoints))
380
381	allocate(x%Cloud_Top_Pressure_Total_Mean(x%nPoints))
382
383	allocate(x%Liquid_Water_Path_Mean(x%nPoints))
384	allocate(x%Ice_Water_Path_Mean(x%nPoints))
385
386	allocate(x%Optical_Thickness_vs_Cloud_Top_Pressure(nPoints, numModisTauBins+1, numModisPressureBins))
387	allocate(x%Optical_Thickness_vs_ReffICE(nPoints, numModisTauBins+1, numModisReffIceBins))
388	allocate(x%Optical_Thickness_vs_ReffLIQ(nPoints, numModisTauBins+1, numModisReffLiqBins))
389	x%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
390	END SUBROUTINE CONSTRUCT_COSP_MODIS
391
392	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
393	!------------- SUBROUTINE FREE_COSP_MODIS -----------------------
394	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
395	SUBROUTINE FREE_COSP_MODIS(x)
396	type(cosp_MODIS),intent(inout) :: x
397	!
398	! Free space used by cosp_modis variable.
399	!
400
401	if(associated(x%Cloud_Fraction_Total_Mean)) deallocate(x%Cloud_Fraction_Total_Mean)
402	if(associated(x%Cloud_Fraction_Water_Mean)) deallocate(x%Cloud_Fraction_Water_Mean)
403	if(associated(x%Cloud_Fraction_Ice_Mean )) deallocate(x%Cloud_Fraction_Ice_Mean)
404
405	if(associated(x%Cloud_Fraction_High_Mean)) deallocate(x%Cloud_Fraction_High_Mean)
406	if(associated(x%Cloud_Fraction_Mid_Mean )) deallocate(x%Cloud_Fraction_Mid_Mean)
407	if(associated(x%Cloud_Fraction_Low_Mean )) deallocate(x%Cloud_Fraction_Low_Mean)
408
409	if(associated(x%Optical_Thickness_Total_Mean)) deallocate(x%Optical_Thickness_Total_Mean)
410	if(associated(x%Optical_Thickness_Water_Mean)) deallocate(x%Optical_Thickness_Water_Mean)
411	if(associated(x%Optical_Thickness_Ice_Mean )) deallocate(x%Optical_Thickness_Ice_Mean)
412
413	if(associated(x%Optical_Thickness_Total_LogMean)) deallocate(x%Optical_Thickness_Total_LogMean)
414	if(associated(x%Optical_Thickness_Water_LogMean)) deallocate(x%Optical_Thickness_Water_LogMean)
415	if(associated(x%Optical_Thickness_Ice_LogMean )) deallocate(x%Optical_Thickness_Ice_LogMean)
416
417	if(associated(x%Cloud_Particle_Size_Water_Mean)) deallocate(x%Cloud_Particle_Size_Water_Mean)
418	if(associated(x%Cloud_Particle_Size_Ice_Mean )) deallocate(x%Cloud_Particle_Size_Ice_Mean)
419
420	if(associated(x%Cloud_Top_Pressure_Total_Mean )) deallocate(x%Cloud_Top_Pressure_Total_Mean )
421
422	if(associated(x%Liquid_Water_Path_Mean)) deallocate(x%Liquid_Water_Path_Mean )
423	if(associated(x%Ice_Water_Path_Mean )) deallocate(x%Ice_Water_Path_Mean )
424
425	if(associated(x%Optical_Thickness_vs_Cloud_Top_Pressure)) deallocate(x%Optical_Thickness_vs_Cloud_Top_Pressure )
426	if(associated(x%Optical_Thickness_vs_ReffIce)) deallocate(x%Optical_Thickness_vs_ReffIce)
427	if(associated(x%Optical_Thickness_vs_ReffLiq)) deallocate(x%Optical_Thickness_vs_ReffLiq)
428	END SUBROUTINE FREE_COSP_MODIS
429	! -----------------------------------------------------
430
431	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
432	!------------- SUBROUTINE COSP_MODIS_CPSECTION -----------------
433	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
434	SUBROUTINE COSP_MODIS_CPSECTION(ix, iy, orig, copy)
435	integer, dimension(2), intent(in) :: ix, iy
436	type(cosp_modis), intent(in ) :: orig
437	type(cosp_modis), intent( out) :: copy
438	!
439	! Copy a set of grid points from one cosp_modis variable to another.
440	! Should test to be sure ix and iy refer to the same number of grid points
441	!
442	integer :: orig_start, orig_end, copy_start, copy_end
443
444	orig_start = ix(1); orig_end = ix(2)
445	copy_start = iy(1); copy_end = iy(2)
446
447	copy%Cloud_Fraction_Total_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Total_Mean(orig_start:orig_end)
448	copy%Cloud_Fraction_Water_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Water_Mean(orig_start:orig_end)
449	copy%Cloud_Fraction_Ice_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Ice_Mean (orig_start:orig_end)
450
451	copy%Cloud_Fraction_High_Mean(copy_start:copy_end) = orig%Cloud_Fraction_High_Mean(orig_start:orig_end)
452	copy%Cloud_Fraction_Mid_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Mid_Mean (orig_start:orig_end)
453	copy%Cloud_Fraction_Low_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Low_Mean (orig_start:orig_end)
454
455	copy%Optical_Thickness_Total_Mean(copy_start:copy_end) = orig%Optical_Thickness_Total_Mean(orig_start:orig_end)
456	copy%Optical_Thickness_Water_Mean(copy_start:copy_end) = orig%Optical_Thickness_Water_Mean(orig_start:orig_end)
457	copy%Optical_Thickness_Ice_Mean (copy_start:copy_end) = orig%Optical_Thickness_Ice_Mean (orig_start:orig_end)
458
459	copy%Optical_Thickness_Total_LogMean(copy_start:copy_end) = &
460	orig%Optical_Thickness_Total_LogMean(orig_start:orig_end)
461	copy%Optical_Thickness_Water_LogMean(copy_start:copy_end) = &
462	orig%Optical_Thickness_Water_LogMean(orig_start:orig_end)
463	copy%Optical_Thickness_Ice_LogMean (copy_start:copy_end) = &
464	orig%Optical_Thickness_Ice_LogMean (orig_start:orig_end)
465
466	copy%Cloud_Particle_Size_Water_Mean(copy_start:copy_end) = orig%Cloud_Particle_Size_Water_Mean(orig_start:orig_end)
467	copy%Cloud_Particle_Size_Ice_Mean (copy_start:copy_end) = orig%Cloud_Particle_Size_Ice_Mean (orig_start:orig_end)
468
469	copy%Cloud_Top_Pressure_Total_Mean(copy_start:copy_end) = orig%Cloud_Top_Pressure_Total_Mean(orig_start:orig_end)
470
471	copy%Liquid_Water_Path_Mean(copy_start:copy_end) = orig%Liquid_Water_Path_Mean(orig_start:orig_end)
472	copy%Ice_Water_Path_Mean (copy_start:copy_end) = orig%Ice_Water_Path_Mean (orig_start:orig_end)
473
474	copy%Optical_Thickness_vs_Cloud_Top_Pressure(copy_start:copy_end, :, :) = &
475	orig%Optical_Thickness_vs_Cloud_Top_Pressure(orig_start:orig_end, :, :)
476	copy%Optical_Thickness_vs_ReffIce(copy_start:copy_end, :, :) = &
477	orig%Optical_Thickness_vs_ReffIce(orig_start:orig_end, :, :)
478	copy%Optical_Thickness_vs_ReffLiq(copy_start:copy_end, :, :) = &
479	orig%Optical_Thickness_vs_ReffLiq(orig_start:orig_end, :, :)
480
481	END SUBROUTINE COSP_MODIS_CPSECTION
482	! -----------------------------------------------------
483
484	END MODULE MOD_COSP_Modis_Simulator

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format