Context Navigation

cosp_modis_simulator.F90 @ 2666

Last change on this file since 2666 was 2432, checked in by idelkadi, 9 years ago
Correction : rajout de fichiers manquants pour les simulateurs Modis, Cloudsat, Misr et Isccp
File size: 22.2 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 15:08:38 +0100 (mer. 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	end type COSP_MODIS
68
69	contains
70	!------------------------------------------------------------------------------------------------
71	subroutine COSP_Modis_Simulator(gridBox, subCols, subcolHydro, isccpSim, modisSim)
72	! Arguments
73	type(cosp_gridbox), intent(in ) :: gridBox ! Gridbox info
74	type(cosp_subgrid), intent(in ) :: subCols ! subCol indicators of convective/stratiform
75	type(cosp_sghydro), intent(in ) :: subcolHydro ! subcol hydrometeor contens
76	type(cosp_isccp), intent(in ) :: isccpSim ! ISCCP simulator output
77	type(cosp_modis), intent( out) :: modisSim ! MODIS simulator subcol output
78
79	! ------------------------------------------------------------
80	! Local variables
81	! Leave space only for sunlit points
82
83	integer :: nPoints, nSubCols, nLevels, nSunlit, i, j, k
84
85	! Grid-mean quanties; dimensions nPoints, nLevels
86	real, &
87	dimension(count(gridBox%sunlit(:) > 0), gridBox%nLevels) :: &
88	temperature, pressureLayers
89	real, &
90	dimension(count(gridBox%sunlit(:) > 0), gridBox%nLevels + 1) :: &
91	pressureLevels
92
93	! Subcol quantities, dimension nPoints, nSubCols, nLevels
94	real, &
95	dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns, gridBox%nLevels) :: &
96	opticalThickness, cloudWater, cloudIce, waterSize, iceSize
97
98	! Vertically-integrated subcol quantities; dimensions nPoints, nSubcols
99	integer, &
100	dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: &
101	retrievedPhase
102	real, &
103	dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: &
104	isccpTau, isccpCloudTopPressure, retrievedCloudTopPressure, retrievedTau, retrievedSize
105
106	! Vertically-integrated results
107	real, dimension(count(gridBox%sunlit(:) > 0)) :: &
108	cfTotal, cfLiquid, cfIce, &
109	cfHigh, cfMid, cfLow, &
110	meanTauTotal, meanTauLiquid, meanTauIce, &
111	meanLogTauTotal, meanLogTauLiquid, meanLogTauIce , &
112	meanSizeLiquid, meanSizeIce, &
113	meanCloudTopPressure, &
114	meanLiquidWaterPath, meanIceWaterPath
115
116	real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numModisPressureBins) :: &
117	jointHistogram
118
119	integer, dimension(count(gridBox%sunlit(:) > 0)) :: sunlit
120	integer, dimension(count(gridBox%sunlit(:) <= 0)) :: notSunlit
121	! ------------------------------------------------------------
122
123	!
124	! Are there any sunlit points?
125	!
126	nSunlit = count(gridBox%sunlit(:) > 0)
127	if(nSunlit > 0) then
128	nLevels = gridBox%Nlevels
129	nPoints = gridBox%Npoints
130	nSubCols = subCols%Ncolumns
131	!
132	! This is a vector index indicating which points are sunlit
133	!
134	sunlit(:) = pack((/ (i, i = 1, nPoints ) /), mask = gridBox%sunlit(:) > 0)
135	notSunlit(:) = pack((/ (i, i = 1, nPoints ) /), mask = .not. gridBox%sunlit(:) > 0)
136
137	!
138	! Copy needed quantities, reversing vertical order and removing points with no sunlight
139	!
140	pressureLevels(:, 1) = 0.0 ! Top of model, following ISCCP sim
141	temperature(:, :) = gridBox%T (sunlit(:), nLevels:1:-1)
142	pressureLayers(:, :) = gridBox%p (sunlit(:), nLevels:1:-1)
143	pressureLevels(:, 2:) = gridBox%ph(sunlit(:), nLevels:1:-1)
144
145	!
146	! Subcolumn properties - first stratiform cloud...
147	!
148	where(subCols%frac_out(sunlit(:), :, :) == I_LSC)
149	!opticalThickness(:, :, :) = &
150	! spread(gridBox%dtau_s (sunlit(:), :), dim = 2, nCopies = nSubCols)
151	cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCLIQ)
152	waterSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_LSCLIQ)
153	cloudIce (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCICE)
154	iceSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_LSCICE)
155	elsewhere
156	opticalThickness(:, :, :) = 0.
157	cloudWater (:, :, :) = 0.
158	cloudIce (:, :, :) = 0.
159	waterSize (:, :, :) = 0.
160	iceSize (:, :, :) = 0.
161	end where
162
163	! Loop version of spread above - intrinsic doesn't work on certain platforms.
164	do k = 1, nLevels
165	do j = 1, nSubCols
166	do i = 1, nSunlit
167	if(subCols%frac_out(sunlit(i), j, k) == I_LSC) then
168	opticalThickness(i, j, k) = gridBox%dtau_s(sunlit(i), k)
169	else
170	opticalThickness(i, j, k) = 0.
171	end if
172	end do
173	end do
174	end do
175
176	!
177	! .. then add convective cloud...
178	!
179	where(subCols%frac_out(sunlit(:), :, :) == I_CVC)
180	!opticalThickness(:, :, :) = &
181	! spread(gridBox%dtau_c( sunlit(:), :), dim = 2, nCopies = nSubCols)
182	cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCLIQ)
183	waterSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_CVCLIQ)
184	cloudIce (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCICE)
185	iceSize (:, :, :) = subcolHydro%reff (sunlit(:), :, :, I_CVCICE)
186	end where
187
188	! Loop version of spread above - intrinsic doesn't work on certain platforms.
189	do k = 1, nLevels
190	do j = 1, nSubCols
191	do i = 1, nSunlit
192	if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
193	end do
194	end do
195	end do
196
197	!
198	! Reverse vertical order
199	!
200	opticalThickness(:, :, :) = opticalThickness(:, :, nLevels:1:-1)
201	cloudWater (:, :, :) = cloudWater (:, :, nLevels:1:-1)
202	waterSize (:, :, :) = waterSize (:, :, nLevels:1:-1)
203	cloudIce (:, :, :) = cloudIce (:, :, nLevels:1:-1)
204	iceSize (:, :, :) = iceSize (:, :, nLevels:1:-1)
205
206	isccpTau(:, :) = isccpSim%boxtau (sunlit(:), :)
207	isccpCloudTopPressure(:, :) = isccpSim%boxptop(sunlit(:), :)
208
209	do i = 1, nSunlit
210	call modis_L2_simulator(temperature(i, :), pressureLayers(i, :), pressureLevels(i, :), &
211	opticalThickness(i, :, :), cloudWater(i, :, :), cloudIce(i, :, :), &
212	waterSize(i, :, :), iceSize(i, :, :), &
213	isccpTau(i, :), isccpCloudTopPressure(i, :), &
214	retrievedPhase(i, :), retrievedCloudTopPressure(i, :), &
215	retrievedTau(i, :), retrievedSize(i, :))
216	end do
217	call modis_L3_simulator(retrievedPhase, &
218	retrievedCloudTopPressure, &
219	retrievedTau, retrievedSize, &
220	cfTotal, cfLiquid, cfIce, &
221	cfHigh, cfMid, cfLow, &
222	meanTauTotal, meanTauLiquid, meanTauIce, &
223	meanLogTauTotal, meanLogTauLiquid, meanLogTauIce, &
224	meanSizeLiquid, meanSizeIce, &
225	meanCloudTopPressure, &
226	meanLiquidWaterPath, meanIceWaterPath, &
227	jointHistogram)
228	!
229	! Copy results into COSP structure
230	!
231	modisSim%Cloud_Fraction_Total_Mean(sunlit(:)) = cfTotal(:)
232	modisSim%Cloud_Fraction_Water_Mean(sunlit(:)) = cfLiquid
233	modisSim%Cloud_Fraction_Ice_Mean (sunlit(:)) = cfIce
234
235	modisSim%Cloud_Fraction_High_Mean(sunlit(:)) = cfHigh
236	modisSim%Cloud_Fraction_Mid_Mean (sunlit(:)) = cfMid
237	modisSim%Cloud_Fraction_Low_Mean (sunlit(:)) = cfLow
238
239	modisSim%Optical_Thickness_Total_Mean(sunlit(:)) = meanTauTotal
240	modisSim%Optical_Thickness_Water_Mean(sunlit(:)) = meanTauLiquid
241	modisSim%Optical_Thickness_Ice_Mean (sunlit(:)) = meanTauIce
242
243	modisSim%Optical_Thickness_Total_LogMean(sunlit(:)) = meanLogTauTotal
244	modisSim%Optical_Thickness_Water_LogMean(sunlit(:)) = meanLogTauLiquid
245	modisSim%Optical_Thickness_Ice_LogMean (sunlit(:)) = meanLogTauIce
246
247	modisSim%Cloud_Particle_Size_Water_Mean(sunlit(:)) = meanSizeLiquid
248	modisSim%Cloud_Particle_Size_Ice_Mean (sunlit(:)) = meanSizeIce
249
250	modisSim%Cloud_Top_Pressure_Total_Mean(sunlit(:)) = meanCloudTopPressure
251
252	modisSim%Liquid_Water_Path_Mean(sunlit(:)) = meanLiquidWaterPath
253	modisSim%Ice_Water_Path_Mean (sunlit(:)) = meanIceWaterPath
254
255	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(sunlit(:), 2:numModisTauBins+1, :) = jointHistogram(:, :, :)
256	!
257	! Reorder pressure bins in joint histogram to go from surface to TOA
258	!
259	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:,:,:) = &
260	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, numModisPressureBins:1:-1)
261	if(nSunlit < nPoints) then
262	!
263	! Where it's night and we haven't done the retrievals the values are undefined
264	!
265	modisSim%Cloud_Fraction_Total_Mean(notSunlit(:)) = R_UNDEF
266	modisSim%Cloud_Fraction_Water_Mean(notSunlit(:)) = R_UNDEF
267	modisSim%Cloud_Fraction_Ice_Mean (notSunlit(:)) = R_UNDEF
268
269	modisSim%Cloud_Fraction_High_Mean(notSunlit(:)) = R_UNDEF
270	modisSim%Cloud_Fraction_Mid_Mean (notSunlit(:)) = R_UNDEF
271	modisSim%Cloud_Fraction_Low_Mean (notSunlit(:)) = R_UNDEF
272
273	modisSim%Optical_Thickness_Total_Mean(notSunlit(:)) = R_UNDEF
274	modisSim%Optical_Thickness_Water_Mean(notSunlit(:)) = R_UNDEF
275	modisSim%Optical_Thickness_Ice_Mean (notSunlit(:)) = R_UNDEF
276
277	modisSim%Optical_Thickness_Total_LogMean(notSunlit(:)) = R_UNDEF
278	modisSim%Optical_Thickness_Water_LogMean(notSunlit(:)) = R_UNDEF
279	modisSim%Optical_Thickness_Ice_LogMean (notSunlit(:)) = R_UNDEF
280
281	modisSim%Cloud_Particle_Size_Water_Mean(notSunlit(:)) = R_UNDEF
282	modisSim%Cloud_Particle_Size_Ice_Mean (notSunlit(:)) = R_UNDEF
283
284	modisSim%Cloud_Top_Pressure_Total_Mean(notSunlit(:)) = R_UNDEF
285
286	modisSim%Liquid_Water_Path_Mean(notSunlit(:)) = R_UNDEF
287	modisSim%Ice_Water_Path_Mean (notSunlit(:)) = R_UNDEF
288
289	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(notSunlit(:), :, :) = R_UNDEF
290	end if
291	else
292	!
293	! It's nightime everywhere - everything is undefined
294	!
295	modisSim%Cloud_Fraction_Total_Mean(:) = R_UNDEF
296	modisSim%Cloud_Fraction_Water_Mean(:) = R_UNDEF
297	modisSim%Cloud_Fraction_Ice_Mean (:) = R_UNDEF
298
299	modisSim%Cloud_Fraction_High_Mean(:) = R_UNDEF
300	modisSim%Cloud_Fraction_Mid_Mean (:) = R_UNDEF
301	modisSim%Cloud_Fraction_Low_Mean (:) = R_UNDEF
302
303	modisSim%Optical_Thickness_Total_Mean(:) = R_UNDEF
304	modisSim%Optical_Thickness_Water_Mean(:) = R_UNDEF
305	modisSim%Optical_Thickness_Ice_Mean (:) = R_UNDEF
306
307	modisSim%Optical_Thickness_Total_LogMean(:) = R_UNDEF
308	modisSim%Optical_Thickness_Water_LogMean(:) = R_UNDEF
309	modisSim%Optical_Thickness_Ice_LogMean (:) = R_UNDEF
310
311	modisSim%Cloud_Particle_Size_Water_Mean(:) = R_UNDEF
312	modisSim%Cloud_Particle_Size_Ice_Mean (:) = R_UNDEF
313
314	modisSim%Cloud_Top_Pressure_Total_Mean(:) = R_UNDEF
315
316	modisSim%Liquid_Water_Path_Mean(:) = R_UNDEF
317	modisSim%Ice_Water_Path_Mean (:) = R_UNDEF
318
319	modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
320	end if
321
322	end subroutine COSP_Modis_Simulator
323	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
324	!------------- SUBROUTINE CONSTRUCT_COSP_MODIS ------------------
325	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
326	SUBROUTINE CONSTRUCT_COSP_MODIS(cfg, nPoints, x)
327	type(cosp_config), intent(in) :: cfg ! Configuration options
328	integer, intent(in) :: Npoints ! Number of sampled points
329	type(cosp_MODIS), intent(out) :: x
330	!
331	! Allocate minumum storage if simulator not used
332	!
333	if (cfg%LMODIS_sim) then
334	x%nPoints = nPoints
335	else
336	x%Npoints = 1
337	endif
338
339	! --- Allocate arrays ---
340	allocate(x%Cloud_Fraction_Total_Mean(x%nPoints))
341	allocate(x%Cloud_Fraction_Water_Mean(x%nPoints))
342	allocate(x%Cloud_Fraction_Ice_Mean(x%nPoints))
343
344	allocate(x%Cloud_Fraction_High_Mean(x%nPoints))
345	allocate(x%Cloud_Fraction_Mid_Mean(x%nPoints))
346	allocate(x%Cloud_Fraction_Low_Mean(x%nPoints))
347
348	allocate(x%Optical_Thickness_Total_Mean(x%nPoints))
349	allocate(x%Optical_Thickness_Water_Mean(x%nPoints))
350	allocate(x%Optical_Thickness_Ice_Mean(x%nPoints))
351
352	allocate(x%Optical_Thickness_Total_LogMean(x%nPoints))
353	allocate(x%Optical_Thickness_Water_LogMean(x%nPoints))
354	allocate(x%Optical_Thickness_Ice_LogMean(x%nPoints))
355
356	allocate(x%Cloud_Particle_Size_Water_Mean(x%nPoints))
357	allocate(x%Cloud_Particle_Size_Ice_Mean(x%nPoints))
358
359	allocate(x%Cloud_Top_Pressure_Total_Mean(x%nPoints))
360
361	allocate(x%Liquid_Water_Path_Mean(x%nPoints))
362	allocate(x%Ice_Water_Path_Mean(x%nPoints))
363
364	allocate(x%Optical_Thickness_vs_Cloud_Top_Pressure(nPoints, numModisTauBins+1, numModisPressureBins))
365	x%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
366	END SUBROUTINE CONSTRUCT_COSP_MODIS
367
368	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
369	!------------- SUBROUTINE FREE_COSP_MODIS -----------------------
370	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
371	SUBROUTINE FREE_COSP_MODIS(x)
372	type(cosp_MODIS),intent(inout) :: x
373	!
374	! Free space used by cosp_modis variable.
375	!
376
377	if(associated(x%Cloud_Fraction_Total_Mean)) deallocate(x%Cloud_Fraction_Total_Mean)
378	if(associated(x%Cloud_Fraction_Water_Mean)) deallocate(x%Cloud_Fraction_Water_Mean)
379	if(associated(x%Cloud_Fraction_Ice_Mean )) deallocate(x%Cloud_Fraction_Ice_Mean)
380
381	if(associated(x%Cloud_Fraction_High_Mean)) deallocate(x%Cloud_Fraction_High_Mean)
382	if(associated(x%Cloud_Fraction_Mid_Mean )) deallocate(x%Cloud_Fraction_Mid_Mean)
383	if(associated(x%Cloud_Fraction_Low_Mean )) deallocate(x%Cloud_Fraction_Low_Mean)
384
385	if(associated(x%Optical_Thickness_Total_Mean)) deallocate(x%Optical_Thickness_Total_Mean)
386	if(associated(x%Optical_Thickness_Water_Mean)) deallocate(x%Optical_Thickness_Water_Mean)
387	if(associated(x%Optical_Thickness_Ice_Mean )) deallocate(x%Optical_Thickness_Ice_Mean)
388
389	if(associated(x%Optical_Thickness_Total_LogMean)) deallocate(x%Optical_Thickness_Total_LogMean)
390	if(associated(x%Optical_Thickness_Water_LogMean)) deallocate(x%Optical_Thickness_Water_LogMean)
391	if(associated(x%Optical_Thickness_Ice_LogMean )) deallocate(x%Optical_Thickness_Ice_LogMean)
392
393	if(associated(x%Cloud_Particle_Size_Water_Mean)) deallocate(x%Cloud_Particle_Size_Water_Mean)
394	if(associated(x%Cloud_Particle_Size_Ice_Mean )) deallocate(x%Cloud_Particle_Size_Ice_Mean)
395
396	if(associated(x%Cloud_Top_Pressure_Total_Mean )) deallocate(x%Cloud_Top_Pressure_Total_Mean )
397
398	if(associated(x%Liquid_Water_Path_Mean)) deallocate(x%Liquid_Water_Path_Mean )
399	if(associated(x%Ice_Water_Path_Mean )) deallocate(x%Ice_Water_Path_Mean )
400
401	if(associated(x%Optical_Thickness_vs_Cloud_Top_Pressure)) deallocate(x%Optical_Thickness_vs_Cloud_Top_Pressure )
402	END SUBROUTINE FREE_COSP_MODIS
403	! -----------------------------------------------------
404
405	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
406	!------------- SUBROUTINE COSP_MODIS_CPSECTION -----------------
407	!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
408	SUBROUTINE COSP_MODIS_CPSECTION(ix, iy, orig, copy)
409	integer, dimension(2), intent(in) :: ix, iy
410	type(cosp_modis), intent(in ) :: orig
411	type(cosp_modis), intent( out) :: copy
412	!
413	! Copy a set of grid points from one cosp_modis variable to another.
414	! Should test to be sure ix and iy refer to the same number of grid points
415	!
416	integer :: orig_start, orig_end, copy_start, copy_end
417
418	orig_start = ix(1); orig_end = ix(2)
419	copy_start = iy(1); copy_end = iy(2)
420
421	copy%Cloud_Fraction_Total_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Total_Mean(orig_start:orig_end)
422	copy%Cloud_Fraction_Water_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Water_Mean(orig_start:orig_end)
423	copy%Cloud_Fraction_Ice_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Ice_Mean (orig_start:orig_end)
424
425	copy%Cloud_Fraction_High_Mean(copy_start:copy_end) = orig%Cloud_Fraction_High_Mean(orig_start:orig_end)
426	copy%Cloud_Fraction_Mid_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Mid_Mean (orig_start:orig_end)
427	copy%Cloud_Fraction_Low_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Low_Mean (orig_start:orig_end)
428
429	copy%Optical_Thickness_Total_Mean(copy_start:copy_end) = orig%Optical_Thickness_Total_Mean(orig_start:orig_end)
430	copy%Optical_Thickness_Water_Mean(copy_start:copy_end) = orig%Optical_Thickness_Water_Mean(orig_start:orig_end)
431	copy%Optical_Thickness_Ice_Mean (copy_start:copy_end) = orig%Optical_Thickness_Ice_Mean (orig_start:orig_end)
432
433	copy%Optical_Thickness_Total_LogMean(copy_start:copy_end) = &
434	orig%Optical_Thickness_Total_LogMean(orig_start:orig_end)
435	copy%Optical_Thickness_Water_LogMean(copy_start:copy_end) = &
436	orig%Optical_Thickness_Water_LogMean(orig_start:orig_end)
437	copy%Optical_Thickness_Ice_LogMean (copy_start:copy_end) = &
438	orig%Optical_Thickness_Ice_LogMean (orig_start:orig_end)
439
440	copy%Cloud_Particle_Size_Water_Mean(copy_start:copy_end) = orig%Cloud_Particle_Size_Water_Mean(orig_start:orig_end)
441	copy%Cloud_Particle_Size_Ice_Mean (copy_start:copy_end) = orig%Cloud_Particle_Size_Ice_Mean (orig_start:orig_end)
442
443	copy%Cloud_Top_Pressure_Total_Mean(copy_start:copy_end) = orig%Cloud_Top_Pressure_Total_Mean(orig_start:orig_end)
444
445	copy%Liquid_Water_Path_Mean(copy_start:copy_end) = orig%Liquid_Water_Path_Mean(orig_start:orig_end)
446	copy%Ice_Water_Path_Mean (copy_start:copy_end) = orig%Ice_Water_Path_Mean (orig_start:orig_end)
447
448	copy%Optical_Thickness_vs_Cloud_Top_Pressure(copy_start:copy_end, :, :) = &
449	orig%Optical_Thickness_vs_Cloud_Top_Pressure(orig_start:orig_end, :, :)
450	END SUBROUTINE COSP_MODIS_CPSECTION
451	! -----------------------------------------------------
452
453	END MODULE MOD_COSP_Modis_Simulator

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

Download in other formats:

Original Format