source: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_modis_simulator.f90 @ 5423

Last change on this file since 5423 was 5268, checked in by abarral, 2 months ago

.f90 <-> .F90 depending on cpp key use
File size: 24.4 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!
34MODULE 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 
71contains
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    x%Optical_Thickness_vs_ReffLIQ(:, :, :) = R_UNDEF
391    x%Optical_Thickness_vs_ReffICE(:, :, :) = R_UNDEF
392
393  END SUBROUTINE CONSTRUCT_COSP_MODIS
394
395  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
396  !------------- SUBROUTINE FREE_COSP_MODIS -----------------------
397  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
398  SUBROUTINE FREE_COSP_MODIS(x)
399    type(cosp_MODIS),intent(inout) :: x
400    !
401    ! Free space used by cosp_modis variable.
402    !
403   
404    if(associated(x%Cloud_Fraction_Total_Mean)) deallocate(x%Cloud_Fraction_Total_Mean)
405    if(associated(x%Cloud_Fraction_Water_Mean)) deallocate(x%Cloud_Fraction_Water_Mean)
406    if(associated(x%Cloud_Fraction_Ice_Mean  )) deallocate(x%Cloud_Fraction_Ice_Mean)
407   
408    if(associated(x%Cloud_Fraction_High_Mean)) deallocate(x%Cloud_Fraction_High_Mean)
409    if(associated(x%Cloud_Fraction_Mid_Mean )) deallocate(x%Cloud_Fraction_Mid_Mean)
410    if(associated(x%Cloud_Fraction_Low_Mean )) deallocate(x%Cloud_Fraction_Low_Mean)
411   
412    if(associated(x%Optical_Thickness_Total_Mean)) deallocate(x%Optical_Thickness_Total_Mean)
413    if(associated(x%Optical_Thickness_Water_Mean)) deallocate(x%Optical_Thickness_Water_Mean)
414    if(associated(x%Optical_Thickness_Ice_Mean  )) deallocate(x%Optical_Thickness_Ice_Mean)
415   
416    if(associated(x%Optical_Thickness_Total_LogMean)) deallocate(x%Optical_Thickness_Total_LogMean)
417    if(associated(x%Optical_Thickness_Water_LogMean)) deallocate(x%Optical_Thickness_Water_LogMean)
418    if(associated(x%Optical_Thickness_Ice_LogMean  )) deallocate(x%Optical_Thickness_Ice_LogMean)
419   
420    if(associated(x%Cloud_Particle_Size_Water_Mean)) deallocate(x%Cloud_Particle_Size_Water_Mean)
421    if(associated(x%Cloud_Particle_Size_Ice_Mean  )) deallocate(x%Cloud_Particle_Size_Ice_Mean)
422   
423    if(associated(x%Cloud_Top_Pressure_Total_Mean )) deallocate(x%Cloud_Top_Pressure_Total_Mean   )
424   
425    if(associated(x%Liquid_Water_Path_Mean)) deallocate(x%Liquid_Water_Path_Mean   )
426    if(associated(x%Ice_Water_Path_Mean   )) deallocate(x%Ice_Water_Path_Mean   )
427   
428    if(associated(x%Optical_Thickness_vs_Cloud_Top_Pressure)) deallocate(x%Optical_Thickness_vs_Cloud_Top_Pressure   )
429    if(associated(x%Optical_Thickness_vs_ReffIce)) deallocate(x%Optical_Thickness_vs_ReffIce)
430    if(associated(x%Optical_Thickness_vs_ReffLiq)) deallocate(x%Optical_Thickness_vs_ReffLiq)
431  END SUBROUTINE FREE_COSP_MODIS
432  ! -----------------------------------------------------
433
434  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
435  !------------- SUBROUTINE COSP_MODIS_CPSECTION -----------------
436  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
437  SUBROUTINE COSP_MODIS_CPSECTION(ix, iy, orig, copy)
438    integer, dimension(2), intent(in) :: ix, iy
439    type(cosp_modis),      intent(in   ) :: orig
440    type(cosp_modis),      intent(  out) :: copy
441    !
442    ! Copy a set of grid points from one cosp_modis variable to another.
443    !   Should test to be sure ix and iy refer to the same number of grid points
444    !
445    integer :: orig_start, orig_end, copy_start, copy_end
446   
447    orig_start = ix(1); orig_end = ix(2)
448    copy_start = iy(1); copy_end = iy(2)
449   
450    copy%Cloud_Fraction_Total_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Total_Mean(orig_start:orig_end)
451    copy%Cloud_Fraction_Water_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Water_Mean(orig_start:orig_end)
452    copy%Cloud_Fraction_Ice_Mean  (copy_start:copy_end) = orig%Cloud_Fraction_Ice_Mean  (orig_start:orig_end)
453   
454    copy%Cloud_Fraction_High_Mean(copy_start:copy_end) = orig%Cloud_Fraction_High_Mean(orig_start:orig_end)
455    copy%Cloud_Fraction_Mid_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Mid_Mean (orig_start:orig_end)
456    copy%Cloud_Fraction_Low_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Low_Mean (orig_start:orig_end)
457   
458    copy%Optical_Thickness_Total_Mean(copy_start:copy_end) = orig%Optical_Thickness_Total_Mean(orig_start:orig_end)
459    copy%Optical_Thickness_Water_Mean(copy_start:copy_end) = orig%Optical_Thickness_Water_Mean(orig_start:orig_end)
460    copy%Optical_Thickness_Ice_Mean  (copy_start:copy_end) = orig%Optical_Thickness_Ice_Mean  (orig_start:orig_end)
461   
462    copy%Optical_Thickness_Total_LogMean(copy_start:copy_end) = &
463                                                          orig%Optical_Thickness_Total_LogMean(orig_start:orig_end)
464    copy%Optical_Thickness_Water_LogMean(copy_start:copy_end) = &
465                                                          orig%Optical_Thickness_Water_LogMean(orig_start:orig_end)
466    copy%Optical_Thickness_Ice_LogMean  (copy_start:copy_end) = &
467                                                          orig%Optical_Thickness_Ice_LogMean  (orig_start:orig_end)
468
469    copy%Cloud_Particle_Size_Water_Mean(copy_start:copy_end) = orig%Cloud_Particle_Size_Water_Mean(orig_start:orig_end)
470    copy%Cloud_Particle_Size_Ice_Mean  (copy_start:copy_end) = orig%Cloud_Particle_Size_Ice_Mean  (orig_start:orig_end)
471
472    copy%Cloud_Top_Pressure_Total_Mean(copy_start:copy_end) = orig%Cloud_Top_Pressure_Total_Mean(orig_start:orig_end)
473   
474    copy%Liquid_Water_Path_Mean(copy_start:copy_end) = orig%Liquid_Water_Path_Mean(orig_start:orig_end)
475    copy%Ice_Water_Path_Mean   (copy_start:copy_end) = orig%Ice_Water_Path_Mean  (orig_start:orig_end)
476   
477    copy%Optical_Thickness_vs_Cloud_Top_Pressure(copy_start:copy_end, :, :) = &
478         orig%Optical_Thickness_vs_Cloud_Top_Pressure(orig_start:orig_end, :, :)
479    copy%Optical_Thickness_vs_ReffIce(copy_start:copy_end, :, :) = &
480         orig%Optical_Thickness_vs_ReffIce(orig_start:orig_end, :, :)
481    copy%Optical_Thickness_vs_ReffLiq(copy_start:copy_end, :, :) = &
482         orig%Optical_Thickness_vs_ReffLiq(orig_start:orig_end, :, :)
483
484  END SUBROUTINE COSP_MODIS_CPSECTION
485  ! -----------------------------------------------------
486
487END MODULE MOD_COSP_Modis_Simulator
Note: See TracBrowser for help on using the repository browser.