source: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_simulator.f90 @ 5435

Last change on this file since 5435 was 5312, checked in by abarral, 7 weeks ago

.f90 <-> .F90
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 9.5 KB
Line 
1! (c) British Crown Copyright 2008, the Met Office.
2! All rights reserved.
3! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
4! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_simulator.F90 $
5!
6! Redistribution and use in source and binary forms, with or without modification, are permitted
7! provided that the following conditions are met:
8!
9!     * Redistributions of source code must retain the above copyright notice, this list
10!       of conditions and the following disclaimer.
11!     * Redistributions in binary form must reproduce the above copyright notice, this list
12!       of conditions and the following disclaimer in the documentation and/or other materials
13!       provided with the distribution.
14!     * Neither the name of the Met Office nor the names of its contributors may be used
15!       to endorse or promote products derived from this software without specific prior written
16!       permission.
17!
18! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
19! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
20! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
21! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
24! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
25! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26
27!
28! History:
29! Jul 2007 - A. Bodas-Salcedo - Initial version
30! Jan 2013 - G. Cesana - Add new variables linked to the lidar cloud phase
31!
32
33INCLUDE "cosp_defs.h"
34MODULE MOD_COSP_SIMULATOR
35  USE MOD_COSP_CONSTANTS, ONLY: I_RADAR, I_LIDAR, I_ISCCP, I_MISR, I_MODIS, &
36                                I_RTTOV, I_STATS, tsim
37  USE MOD_COSP_TYPES
38  USE MOD_COSP_RADAR
39  USE MOD_COSP_LIDAR
40  USE MOD_COSP_ISCCP_SIMULATOR
41  USE MOD_COSP_MODIS_SIMULATOR
42  USE MOD_COSP_MISR_SIMULATOR
43!#ifdef RTTOV
44!  USE MOD_COSP_RTTOV_SIMULATOR
45!#endif
46  USE MOD_COSP_STATS
47  IMPLICIT NONE
48
49CONTAINS
50
51
52!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
53!--------------------- SUBROUTINE COSP_SIMULATOR ------------------
54!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
55!#ifdef RTTOV
56!SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
57!#else
58SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
59!#endif
60
61  ! Arguments
62  type(cosp_gridbox),intent(inout) :: gbx      ! Grid-box inputs
63  type(cosp_subgrid),intent(in) :: sgx      ! Subgrid inputs
64  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
65  type(cosp_config),intent(in)  :: cfg      ! Configuration options
66  type(cosp_vgrid),intent(in)   :: vgrid    ! Information on vertical grid of stats
67  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
68  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
69  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
70  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
71  type(cosp_modis),intent(inout)   :: modis   ! Output from MODIS simulator
72!#ifdef RTTOV
73!  type(cosp_rttov),intent(inout)    :: rttov    ! Output from RTTOV
74!#endif
75  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
76  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
77  ! Local variables
78  integer :: i,j,k,isim
79  logical :: inconsistent
80  ! Timing variables
81  integer :: t0,t1
82
83  t0 = 0
84  t1 = 0
85
86  inconsistent=.false.
87!   do k=1,gbx%Nhydro
88!   do j=1,gbx%Nlevels
89!   do i=1,gbx%Npoints
90!     if ((gbx%mr_hydro(i,j,k)>0.0).and.(gbx%Reff(i,j,k)<=0.0)) inconsistent=.true.
91!   enddo
92!   enddo
93!   enddo
94!  if (inconsistent)  print *, '%%%% COSP_SIMULATOR: inconsistency in mr_hydro and Reff'
95
96
97  !+++++++++ Radar model ++++++++++
98  isim = I_RADAR
99  if (cfg%Lradar_sim) then
100    call system_clock(t0)
101    call cosp_radar(gbx,sgx,sghydro,sgradar)
102    call system_clock(t1)
103    tsim(isim) = tsim(isim) + (t1 -t0)
104  endif
105
106  !+++++++++ Lidar model ++++++++++
107  isim = I_LIDAR
108  if (cfg%Llidar_sim) then
109    call system_clock(t0)
110    call cosp_lidar(gbx,sgx,sghydro,sglidar)
111    call system_clock(t1)
112    tsim(isim) = tsim(isim) + (t1 -t0)
113  endif
114
115  !+++++++++ ISCCP simulator ++++++++++
116  isim = I_ISCCP
117  if (cfg%Lisccp_sim) then
118    call system_clock(t0)
119    call cosp_isccp_simulator(gbx,sgx,isccp)
120    call system_clock(t1)
121    tsim(isim) = tsim(isim) + (t1 -t0)
122  endif
123
124  !+++++++++ MISR simulator ++++++++++
125  isim = I_MISR
126  if (cfg%Lmisr_sim) then
127    call system_clock(t0)
128    call cosp_misr_simulator(gbx,sgx,misr)
129    call system_clock(t1)
130    tsim(isim) = tsim(isim) + (t1 -t0)
131  endif
132
133  !+++++++++ MODIS simulator ++++++++++
134  isim = I_MODIS
135  if (cfg%Lmodis_sim) then
136    call system_clock(t0)
137    call cosp_modis_simulator(gbx,sgx,sghydro,isccp, modis)
138    call system_clock(t1)
139    tsim(isim) = tsim(isim) + (t1 -t0)
140  endif
141
142  !+++++++++ RTTOV ++++++++++
143  isim = I_RTTOV
144!#ifdef RTTOV
145!  if (cfg%Lrttov_sim) then
146!    call system_clock(t0)
147!    call cosp_rttov_simulator(gbx,rttov)
148!    call system_clock(t1)
149!    tsim(isim) = tsim(isim) + (t1 -t0)
150!  endif
151!#endif
152
153  !+++++++++++ Summary statistics +++++++++++
154  isim = I_STATS
155  if (cfg%Lstats) then
156    call system_clock(t0)
157    call cosp_stats(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar)
158    call system_clock(t1)
159    tsim(isim) = tsim(isim) + (t1 -t0)
160  endif
161
162  !+++++++++++ Change of units after computation of statistics +++++++++++
163  ! This avoids using UDUNITS in CMOR
164
165  ! Cloud fractions from 1 to %
166!  if (cfg%Lclcalipso) then
167!    where(stlidar%lidarcld /= R_UNDEF) stlidar%lidarcld = stlidar%lidarcld*100.0
168!  endif
169!  if (cfg%Lcltcalipso.OR.cfg%Lcllcalipso.OR.cfg%Lclmcalipso.OR.cfg%Lclhcalipso) then
170!    where(stlidar%cldlayer /= R_UNDEF) stlidar%cldlayer = stlidar%cldlayer*100.0
171!  endif
172  if (cfg%Lclcalipso2) then
173    where(stradar%lidar_only_freq_cloud /= R_UNDEF) stradar%lidar_only_freq_cloud = stradar%lidar_only_freq_cloud*100.0
174  endif
175
176  if (cfg%Lcltcalipsoliq.OR.cfg%Lcllcalipsoliq.OR.cfg%Lclmcalipsoliq.OR.cfg%Lclhcalipsoliq.OR. &
177      cfg%Lcltcalipsoice.OR.cfg%Lcllcalipsoice.OR.cfg%Lclmcalipsoice.OR.cfg%Lclhcalipsoice.OR. &
178      cfg%Lcltcalipsoun.OR.cfg%Lcllcalipsoun.OR.cfg%Lclmcalipsoun.OR.cfg%Lclhcalipsoun ) then
179    where(stlidar%cldlayerphase /= R_UNDEF) stlidar%cldlayerphase = stlidar%cldlayerphase*100.0
180  endif
181  if (cfg%Lclcalipsoliq.OR.cfg%Lclcalipsoice.OR.cfg%Lclcalipsoun) then
182    where(stlidar%lidarcldphase /= R_UNDEF) stlidar%lidarcldphase = stlidar%lidarcldphase*100.0
183  endif
184  if (cfg%Lclcalipsotmp.OR.cfg%Lclcalipsotmpliq.OR.cfg%Lclcalipsotmpice.OR.cfg%Lclcalipsotmpun) then
185    where(stlidar%lidarcldtmp /= R_UNDEF) stlidar%lidarcldtmp = stlidar%lidarcldtmp*100.0
186  endif
187
188  if (cfg%Lcltisccp) then
189     where(isccp%totalcldarea /= R_UNDEF) isccp%totalcldarea = isccp%totalcldarea*100.0
190  endif 
191  if (cfg%Lclisccp) then
192    where(isccp%fq_isccp /= R_UNDEF) isccp%fq_isccp = isccp%fq_isccp*100.0
193  endif
194
195  if (cfg%LclMISR) then
196    where(misr%fq_MISR /= R_UNDEF) misr%fq_MISR = misr%fq_MISR*100.0
197  endif
198
199  if (cfg%Lcltlidarradar) then
200    where(stradar%radar_lidar_tcc /= R_UNDEF) stradar%radar_lidar_tcc = stradar%radar_lidar_tcc*100.0
201  endif
202
203  if (cfg%Lclmodis) then
204    where(modis%Optical_Thickness_vs_Cloud_Top_Pressure /= R_UNDEF) modis%Optical_Thickness_vs_Cloud_Top_Pressure = &
205                                                      modis%Optical_Thickness_vs_Cloud_Top_Pressure*100.0
206  endif
207  if (cfg%Lcrimodis) then
208     where(modis%Optical_Thickness_vs_ReffICE /= R_UNDEF) modis%Optical_Thickness_vs_ReffICE = &
209                                                      modis%Optical_Thickness_vs_ReffICE*100.0
210  endif
211  if (cfg%Lcrlmodis) then
212     where(modis%Optical_Thickness_vs_ReffLIQ /= R_UNDEF) modis%Optical_Thickness_vs_ReffLIQ = &
213                                                      modis%Optical_Thickness_vs_ReffLIQ*100.0
214  endif
215
216  if (cfg%Lcltmodis) then
217    where(modis%Cloud_Fraction_Total_Mean /= R_UNDEF) modis%Cloud_Fraction_Total_Mean = modis%Cloud_Fraction_Total_Mean*100.0
218  endif
219  if (cfg%Lclwmodis) then
220     where(modis%Cloud_Fraction_Water_Mean /= R_UNDEF) modis%Cloud_Fraction_Water_Mean = modis%Cloud_Fraction_Water_Mean*100.0
221  endif
222  if (cfg%Lclimodis) then
223     where(modis%Cloud_Fraction_Ice_Mean /= R_UNDEF) modis%Cloud_Fraction_Ice_Mean = modis%Cloud_Fraction_Ice_Mean*100.0
224  endif
225
226  if (cfg%Lclhmodis) then
227     where(modis%Cloud_Fraction_High_Mean /= R_UNDEF) modis%Cloud_Fraction_High_Mean = modis%Cloud_Fraction_High_Mean*100.0
228  endif
229  if (cfg%Lclmmodis) then
230     where(modis%Cloud_Fraction_Mid_Mean /= R_UNDEF) modis%Cloud_Fraction_Mid_Mean = modis%Cloud_Fraction_Mid_Mean*100.0
231  endif
232  if (cfg%Lcllmodis) then
233     where(modis%Cloud_Fraction_Low_Mean /= R_UNDEF) modis%Cloud_Fraction_Low_Mean = modis%Cloud_Fraction_Low_Mean*100.0
234  endif
235
236  ! Change pressure from hPa to Pa.
237  if (cfg%Lboxptopisccp) then
238    where(isccp%boxptop /= R_UNDEF) isccp%boxptop = isccp%boxptop*100.0
239  endif
240  if (cfg%Lpctisccp) then
241    where(isccp%meanptop /= R_UNDEF) isccp%meanptop = isccp%meanptop*100.0
242  endif
243
244
245END SUBROUTINE COSP_SIMULATOR
246
247END MODULE MOD_COSP_SIMULATOR
Note: See TracBrowser for help on using the repository browser.