[1262] | 1 | ! (c) British Crown Copyright 2008, the Met Office. |
---|
| 2 | ! All rights reserved. |
---|
[2428] | 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 $ |
---|
[1262] | 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 |
---|
[2428] | 30 | ! Jan 2013 - G. Cesana - Add new variables linked to the lidar cloud phase |
---|
[1262] | 31 | ! |
---|
| 32 | |
---|
[2428] | 33 | #include "cosp_defs.h" |
---|
[1262] | 34 | MODULE MOD_COSP_SIMULATOR |
---|
[2428] | 35 | USE MOD_COSP_CONSTANTS, ONLY: I_RADAR, I_LIDAR, I_ISCCP, I_MISR, I_MODIS, & |
---|
| 36 | I_RTTOV, I_STATS, tsim |
---|
[1262] | 37 | USE MOD_COSP_TYPES |
---|
| 38 | USE MOD_COSP_RADAR |
---|
| 39 | USE MOD_COSP_LIDAR |
---|
| 40 | USE MOD_COSP_ISCCP_SIMULATOR |
---|
[2428] | 41 | USE MOD_COSP_MODIS_SIMULATOR |
---|
[1262] | 42 | USE MOD_COSP_MISR_SIMULATOR |
---|
[2428] | 43 | !#ifdef RTTOV |
---|
| 44 | ! USE MOD_COSP_RTTOV_SIMULATOR |
---|
| 45 | !#endif |
---|
[1262] | 46 | USE MOD_COSP_STATS |
---|
| 47 | IMPLICIT NONE |
---|
| 48 | |
---|
| 49 | CONTAINS |
---|
| 50 | |
---|
| 51 | |
---|
| 52 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
| 53 | !--------------------- SUBROUTINE COSP_SIMULATOR ------------------ |
---|
| 54 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
[2428] | 55 | !#ifdef RTTOV |
---|
| 56 | !SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) |
---|
| 57 | !#else |
---|
| 58 | SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) |
---|
| 59 | !#endif |
---|
[1262] | 60 | |
---|
| 61 | ! Arguments |
---|
[2428] | 62 | type(cosp_gridbox),intent(inout) :: gbx ! Grid-box inputs |
---|
[1262] | 63 | type(cosp_subgrid),intent(in) :: sgx ! Subgrid inputs |
---|
| 64 | type(cosp_sghydro),intent(in) :: sghydro ! Subgrid info for hydrometeors |
---|
[2428] | 65 | type(cosp_config),intent(in) :: cfg ! Configuration options |
---|
[1262] | 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 |
---|
[2428] | 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 |
---|
[1262] | 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 |
---|
[2428] | 78 | integer :: i,j,k,isim |
---|
| 79 | logical :: inconsistent |
---|
| 80 | ! Timing variables |
---|
| 81 | integer :: t0,t1 |
---|
[1262] | 82 | |
---|
[2428] | 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 |
---|
[1262] | 99 | if (cfg%Lradar_sim) then |
---|
[2428] | 100 | call system_clock(t0) |
---|
[1262] | 101 | call cosp_radar(gbx,sgx,sghydro,sgradar) |
---|
[2428] | 102 | call system_clock(t1) |
---|
| 103 | tsim(isim) = tsim(isim) + (t1 -t0) |
---|
[1262] | 104 | endif |
---|
[2428] | 105 | |
---|
[1262] | 106 | !+++++++++ Lidar model ++++++++++ |
---|
[2428] | 107 | isim = I_LIDAR |
---|
[1262] | 108 | if (cfg%Llidar_sim) then |
---|
[2428] | 109 | call system_clock(t0) |
---|
[1262] | 110 | call cosp_lidar(gbx,sgx,sghydro,sglidar) |
---|
[2428] | 111 | call system_clock(t1) |
---|
| 112 | tsim(isim) = tsim(isim) + (t1 -t0) |
---|
[1262] | 113 | endif |
---|
| 114 | |
---|
| 115 | !+++++++++ ISCCP simulator ++++++++++ |
---|
[2428] | 116 | isim = I_ISCCP |
---|
[1262] | 117 | if (cfg%Lisccp_sim) then |
---|
[2428] | 118 | call system_clock(t0) |
---|
[1262] | 119 | call cosp_isccp_simulator(gbx,sgx,isccp) |
---|
[2428] | 120 | call system_clock(t1) |
---|
| 121 | tsim(isim) = tsim(isim) + (t1 -t0) |
---|
[1262] | 122 | endif |
---|
[2428] | 123 | |
---|
[1262] | 124 | !+++++++++ MISR simulator ++++++++++ |
---|
[2428] | 125 | isim = I_MISR |
---|
[1262] | 126 | if (cfg%Lmisr_sim) then |
---|
[2428] | 127 | call system_clock(t0) |
---|
[1262] | 128 | call cosp_misr_simulator(gbx,sgx,misr) |
---|
[2428] | 129 | call system_clock(t1) |
---|
| 130 | tsim(isim) = tsim(isim) + (t1 -t0) |
---|
[1262] | 131 | endif |
---|
| 132 | |
---|
[2428] | 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 | |
---|
[1262] | 153 | !+++++++++++ Summary statistics +++++++++++ |
---|
[2428] | 154 | isim = I_STATS |
---|
[1262] | 155 | if (cfg%Lstats) then |
---|
[2428] | 156 | call system_clock(t0) |
---|
[1262] | 157 | call cosp_stats(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar) |
---|
[2428] | 158 | call system_clock(t1) |
---|
| 159 | tsim(isim) = tsim(isim) + (t1 -t0) |
---|
[1262] | 160 | endif |
---|
| 161 | |
---|
[2428] | 162 | !+++++++++++ Change of units after computation of statistics +++++++++++ |
---|
| 163 | ! This avoids using UDUNITS in CMOR |
---|
| 164 | |
---|
| 165 | ! Cloud fractions from 1 to % |
---|
[2464] | 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 |
---|
[2428] | 175 | |
---|
[2464] | 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 |
---|
[2428] | 187 | |
---|
[2464] | 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 |
---|
[2428] | 194 | |
---|
[2464] | 195 | ! if (cfg%LclMISR) then |
---|
| 196 | ! where(misr%fq_MISR /= R_UNDEF) misr%fq_MISR = misr%fq_MISR*100.0 |
---|
| 197 | ! endif |
---|
[2428] | 198 | |
---|
[2464] | 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 |
---|
[2428] | 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 |
---|
[2464] | 207 | ! if (cfg%Lcltmodis) then |
---|
| 208 | ! where(modis%Cloud_Fraction_Total_Mean /= R_UNDEF) modis%Cloud_Fraction_Total_Mean = modis%Cloud_Fraction_Total_Mean*100.0 |
---|
| 209 | ! endif |
---|
| 210 | ! if (cfg%Lclwmodis) then |
---|
| 211 | ! where(modis%Cloud_Fraction_Water_Mean /= R_UNDEF) modis%Cloud_Fraction_Water_Mean = modis%Cloud_Fraction_Water_Mean*100.0 |
---|
| 212 | ! endif |
---|
| 213 | ! if (cfg%Lclimodis) then |
---|
| 214 | ! where(modis%Cloud_Fraction_Ice_Mean /= R_UNDEF) modis%Cloud_Fraction_Ice_Mean = modis%Cloud_Fraction_Ice_Mean*100.0 |
---|
| 215 | ! endif |
---|
[2428] | 216 | |
---|
[2464] | 217 | ! if (cfg%Lclhmodis) then |
---|
| 218 | ! where(modis%Cloud_Fraction_High_Mean /= R_UNDEF) modis%Cloud_Fraction_High_Mean = modis%Cloud_Fraction_High_Mean*100.0 |
---|
| 219 | ! endif |
---|
| 220 | ! if (cfg%Lclmmodis) then |
---|
| 221 | ! where(modis%Cloud_Fraction_Mid_Mean /= R_UNDEF) modis%Cloud_Fraction_Mid_Mean = modis%Cloud_Fraction_Mid_Mean*100.0 |
---|
| 222 | ! endif |
---|
| 223 | ! if (cfg%Lcllmodis) then |
---|
| 224 | ! where(modis%Cloud_Fraction_Low_Mean /= R_UNDEF) modis%Cloud_Fraction_Low_Mean = modis%Cloud_Fraction_Low_Mean*100.0 |
---|
| 225 | ! endif |
---|
[2428] | 226 | |
---|
| 227 | ! Change pressure from hPa to Pa. |
---|
| 228 | if (cfg%Lboxptopisccp) then |
---|
| 229 | where(isccp%boxptop /= R_UNDEF) isccp%boxptop = isccp%boxptop*100.0 |
---|
| 230 | endif |
---|
| 231 | if (cfg%Lpctisccp) then |
---|
| 232 | where(isccp%meanptop /= R_UNDEF) isccp%meanptop = isccp%meanptop*100.0 |
---|
| 233 | endif |
---|
| 234 | |
---|
| 235 | |
---|
[1262] | 236 | END SUBROUTINE COSP_SIMULATOR |
---|
| 237 | |
---|
| 238 | END MODULE MOD_COSP_SIMULATOR |
---|