Changeset 2428
- Timestamp:
- Jan 27, 2016, 10:42:32 AM (8 years ago)
- Location:
- LMDZ5/trunk
- Files:
-
- 2 deleted
- 40 edited
-
DefLists/cosp_input_nl.txt (modified) (1 diff)
-
DefLists/cosp_output_nl.txt (modified) (1 diff)
-
DefLists/field_def_lmdz.xml (modified) (2 diffs)
-
DefLists/file_def_histdayCOSP_lmdz.xml (modified) (2 diffs)
-
DefLists/file_def_histhfCOSP_lmdz.xml (modified) (1 diff)
-
DefLists/file_def_histmthCOSP_lmdz.xml (modified) (2 diffs)
-
libf/phylmd/cosp/MISR_simulator.F (modified) (10 diffs)
-
libf/phylmd/cosp/array_lib.F90 (modified) (1 diff)
-
libf/phylmd/cosp/atmos_lib.F90 (modified) (3 diffs)
-
libf/phylmd/cosp/congvec.h (modified) (1 diff)
-
libf/phylmd/cosp/cosp.F90 (modified) (24 diffs)
-
libf/phylmd/cosp/cosp_constants.F90 (modified) (7 diffs)
-
libf/phylmd/cosp/cosp_isccp_simulator.F90 (modified) (3 diffs)
-
libf/phylmd/cosp/cosp_lidar.F90 (modified) (5 diffs)
-
libf/phylmd/cosp/cosp_misr_simulator.F90 (modified) (4 diffs)
-
libf/phylmd/cosp/cosp_output_mod.F90 (modified) (9 diffs)
-
libf/phylmd/cosp/cosp_output_write_mod.F90 (modified) (12 diffs)
-
libf/phylmd/cosp/cosp_radar.F90 (modified) (7 diffs)
-
libf/phylmd/cosp/cosp_simulator.F90 (modified) (4 diffs)
-
libf/phylmd/cosp/cosp_stats.F90 (modified) (10 diffs)
-
libf/phylmd/cosp/cosp_types.F90 (modified) (35 diffs)
-
libf/phylmd/cosp/cosp_utils.F90 (modified) (4 diffs)
-
libf/phylmd/cosp/dsd.F90 (modified) (15 diffs)
-
libf/phylmd/cosp/format_input.F90 (modified) (1 diff)
-
libf/phylmd/cosp/gases.F90 (modified) (5 diffs)
-
libf/phylmd/cosp/icarus.F (modified) (1 diff)
-
libf/phylmd/cosp/lidar_simulator.F90 (modified) (18 diffs)
-
libf/phylmd/cosp/llnl_stats.F90 (modified) (5 diffs)
-
libf/phylmd/cosp/lmd_ipsl_stats.F90 (modified) (19 diffs)
-
libf/phylmd/cosp/load_hydrometeor_classes.F90 (deleted)
-
libf/phylmd/cosp/load_mie_table.F90 (deleted)
-
libf/phylmd/cosp/math_lib.F90 (modified) (2 diffs)
-
libf/phylmd/cosp/optics_lib.F90 (modified) (10 diffs)
-
libf/phylmd/cosp/pf_to_mr.F (modified) (3 diffs)
-
libf/phylmd/cosp/phys_cosp.F90 (modified) (14 diffs)
-
libf/phylmd/cosp/prec_scops.F (modified) (7 diffs)
-
libf/phylmd/cosp/radar_simulator.F90 (modified) (3 diffs)
-
libf/phylmd/cosp/radar_simulator_types.F90 (modified) (2 diffs)
-
libf/phylmd/cosp/read_cosp_output_nl.F90 (modified) (13 diffs)
-
libf/phylmd/cosp/scops.F (modified) (4 diffs)
-
libf/phylmd/cosp/zeff.F90 (modified) (7 diffs)
-
libf/phylmd/physiq_mod.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/DefLists/cosp_input_nl.txt
r2138 r2428 28 28 NPOINTS_IT=10000,! Max number of gridpoints to be processed in one iteration 29 29 NCOLUMNS=20, ! Number of subcolumns 30 USE_VGRID=. false., ! Use fixed vertical grid for outputs? (if .true. then you need to define number of levels with Nlr)30 USE_VGRID=.true., ! Use fixed vertical grid for outputs? (if .true. then you need to define number of levels with Nlr) 31 31 NLR=40, ! Number of levels in statistical outputs (only used if USE_VGRID=.true.) 32 CSAT_VGRID=. false., ! CloudSat vertical grid? (if .true. then the CloudSat standard grid is used for the outputs.32 CSAT_VGRID=.true., ! CloudSat vertical grid? (if .true. then the CloudSat standard grid is used for the outputs. 33 33 ! USE_VGRID needs also be .true.) 34 34 !---------------------------------------------------------------------------------- -
LMDZ5/trunk/DefLists/cosp_output_nl.txt
r1907 r2428 32 32 Lisccp_sim=.true., 33 33 Lmisr_sim=.false., 34 Lmodis_sim=.false., 35 Lrttov_sim=.false., 34 36 ! Output variables 35 Lalbisccp=.true., 36 Latb532=.true., 37 Lboxptopisccp=.true., 38 Lboxtauisccp=.true., 39 Lcfad_dbze94=.false., 40 Lcfad_lidarsr532=.true., 37 !- Variables unique in 1D (curtain) mode 38 Ltoffset=.false., 39 !- CloudSat 40 Lcfaddbze94=.false., 41 Ldbze94=.true., 42 !- CALIPSO 43 Latb532=.false., 44 LcfadLidarsr532=.false., 41 45 Lclcalipso=.true., 42 46 Lclhcalipso=.true., 43 Lclisccp2=.true.,44 47 Lcllcalipso=.true., 45 48 Lclmcalipso=.true., 46 49 Lcltcalipso=.true., 47 Lctpisccp=.true., 48 Ldbze94=.false., 50 LparasolRefl=.true., 51 ! CALIPSO phase diagnostics 52 Lclcalipsoliq=.true., 53 Lclcalipsoice=.true., 54 Lclcalipsoun=.true., 55 Lclcalipsotmp=.true., 56 Lclcalipsotmpliq=.true., 57 Lclcalipsotmpice=.true., 58 Lclcalipsotmpun=.true., 59 Lclhcalipsoliq=.true., 60 Lcllcalipsoliq=.true., 61 Lclmcalipsoliq=.true., 62 Lcltcalipsoliq=.true., 63 Lclhcalipsoice=.true., 64 Lcllcalipsoice=.true., 65 Lclmcalipsoice=.true., 66 Lcltcalipsoice=.true., 67 Lclhcalipsoun=.true., 68 Lcllcalipsoun=.true., 69 Lclmcalipsoun=.true., 70 Lcltcalipsoun=.true., 71 !- ISCCP 72 Lalbisccp=.true., 73 Lboxptopisccp=.false., 74 Lboxtauisccp=.false., 75 Lpctisccp=.true., 76 Lclisccp=.true., 49 77 Ltauisccp=.true., 50 Ltclisccp=.true., 51 Llongitude=.false., 52 Llatitude=.false., 53 Lparasol_refl=.true., 54 LclMISR=.false., 78 Lcltisccp=.true., 55 79 Lmeantbisccp=.true., 56 80 Lmeantbclrisccp=.true., 57 ! Use lidar and radar 81 !- MISR 82 LclMISR=.false., 83 !- Use lidar and radar 58 84 Lclcalipso2=.false., 59 85 Lcltlidarradar=.false., 60 ! These are provided for debugging or special purposes 61 Lfrac_out=.false., 62 Lbeta_mol532=.true., 86 !- These are provided for debugging or special purposes 87 Lfracout=.false., 88 LlidarBetaMol532=.true., 89 !- MODIS 90 Lcltmodis=.false., 91 Lclwmodis=.false., 92 Lclimodis=.false., 93 Lclhmodis=.false., 94 Lclmmodis=.false., 95 Lcllmodis=.false., 96 Ltautmodis=.false., 97 Ltauwmodis=.false., 98 Ltauimodis=.false., 99 Ltautlogmodis=.false., 100 Ltauwlogmodis=.false., 101 Ltauilogmodis=.false., 102 Lreffclwmodis=.false., 103 Lreffclimodis=.false., 104 Lpctmodis=.false., 105 Llwpmodis=.false., 106 Liwpmodis=.false., 107 Lclmodis=.false., 108 !- RTTOV 109 Ltbrttov=.false., 63 110 / -
LMDZ5/trunk/DefLists/field_def_lmdz.xml
r2389 r2428 637 637 <field id="clmcalipso" long_name="Lidar Mid-level Cloud Fraction" unit="1" /> 638 638 <field id="cltcalipso" long_name="Lidar Total Cloud Fraction" unit="1" /> 639 <field id="clcalipso" long_name="Lidar Cloud Fraction (532 nm)" unit="1" axis_ref=" presnivs" />639 <field id="clcalipso" long_name="Lidar Cloud Fraction (532 nm)" unit="1" axis_ref="height" /> 640 640 <field id="parasol_refl" long_name="PARASOL-like mono-directional reflectance" unit="1" axis_ref="sza" /> 641 641 <field id="parasol_crefl" long_name="PARASOL-like mono-directional reflectance (integral)" unit="1" axis_ref="sza" /> 642 642 <field id="Ncrefl" long_name="Nb for PARASOL-like mono-directional reflectance" unit="1" axis_ref="sza" /> 643 <field id="c01_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />644 <field id="c02_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />645 <field id="c03_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />646 <field id="c04_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />647 <field id="c05_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />648 <field id="c06_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />649 <field id="c07_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />650 <field id="c08_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />651 <field id="c09_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />652 <field id="c10_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />653 <field id="c11_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />654 <field id="c12_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />655 <field id="c13_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />656 <field id="c14_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />657 <field id="c15_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />658 <field id="c16_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />659 <field id="c17_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />660 <field id="c18_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />661 <field id="c19_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />662 <field id="c20_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref=" presnivs" />643 <field id="c01_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 644 <field id="c02_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 645 <field id="c03_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 646 <field id="c04_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 647 <field id="c05_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 648 <field id="c06_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 649 <field id="c07_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 650 <field id="c08_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 651 <field id="c09_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 652 <field id="c10_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 653 <field id="c11_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 654 <field id="c12_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 655 <field id="c13_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 656 <field id="c14_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 657 <field id="c15_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 658 <field id="c16_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 659 <field id="c17_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 660 <field id="c18_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 661 <field id="c19_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 662 <field id="c20_cfad_lidarsr532" long_name="Lidar Scattering Ratio CFAD (532 nm)" unit="1" axis_ref="height" /> 663 663 <field id="c01_atb532" long_name="Lidar Attenuated Total Backscatter (532 nm)" unit="1" axis_ref="height_mlev" /> 664 664 <field id="c02_atb532" long_name="Lidar Attenuated Total Backscatter (532 nm)" unit="1" axis_ref="height_mlev" /> … … 682 682 <field id="c20_atb532" long_name="Lidar Attenuated Total Backscatter (532 nm)" unit="1" axis_ref="height_mlev" /> 683 683 <field id="beta_mol532" long_name="Lidar Molecular Backscatter (532 nm)" unit="m-1 sr-1" axis_ref="height_mlev" /> 684 <field id="cllcalipsoice" long_name="Lidar Ice-Phase Low-level Cloud Fraction" unit="%" /> 685 <field id="clhcalipsoice" long_name="Lidar Ice-Phase Hight-level Cloud Fraction" unit="%" /> 686 <field id="clmcalipsoice" long_name="Lidar Ice-Phase Mid-level Cloud Fraction" unit="%" /> 687 <field id="cltcalipsoice" long_name="Lidar Ice-Phase Total Cloud Fraction" unit="%" /> 688 <field id="clcalipsoice" long_name="Lidar Ice-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" /> 689 <field id="cllcalipsoliq" long_name="Lidar Liq-Phase Low-level Cloud Fraction" unit="%" /> 690 <field id="clhcalipsoliq" long_name="Lidar Liq-Phase Hight-level Cloud Fraction" unit="%" /> 691 <field id="clmcalipsoliq" long_name="Lidar Liq-Phase Mid-level Cloud Fraction" unit="%" /> 692 <field id="cltcalipsoliq" long_name="Lidar Liq-Phase Total Cloud Fraction" unit="%" /> 693 <field id="clcalipsoliq" long_name="Lidar Liq-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" /> 694 <field id="cllcalipsoun" long_name="Lidar Undefined-Phase Low-level Cloud Fraction" unit="%" /> 695 <field id="clhcalipsoun" long_name="Lidar Undefined-Phase Hight-level Cloud Fraction" unit="%" /> 696 <field id="clmcalipsoun" long_name="Lidar Undefined-Phase Mid-level Cloud Fraction" unit="%" /> 697 <field id="cltcalipsoun" long_name="Lidar Undefined-Phase Total Cloud Fraction" unit="%" /> 698 <field id="clcalipsoun" long_name="Lidar Undefined-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" /> 699 <field id="clcalipsotmp" long_name="Lidar Cloud Fraction (532 nm)" unit="%" axis_ref="height" /> 700 <field id="clcalipsotmpliq" long_name="Lidar Liq-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" /> 701 <field id="clcalipsotmpice" long_name="Lidar Ice-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" /> 702 <field id="clcalipsotmpun" long_name="Undefined-Phase Total Cloud Fraction" unit="%" axis_ref="height" /> 684 703 </field_group> 685 704 -
LMDZ5/trunk/DefLists/file_def_histdayCOSP_lmdz.xml
r2411 r2428 1 1 <file_definition> 2 2 <file_group id="defile"> 3 <file id="histdayCOSP" name="histdayCOSP" output_freq="1d" output_level=" 5" enabled=".FALSE.">3 <file id="histdayCOSP" name="histdayCOSP" output_freq="1d" output_level="1" enabled=".TRUE."> 4 4 5 5 <!-- VARS 2D --> 6 <field_group operation="average" freq_op="3h" >6 <field_group operation="average" freq_op="3h" detect_missing_value=".true."> 7 7 <field field_ref="cllcalipso" level="1" /> 8 8 <field field_ref="clmcalipso" level="1" /> 9 9 <field field_ref="clhcalipso" level="1" /> 10 10 <field field_ref="cltcalipso" level="1" /> 11 <field field_ref="clcalipso" level="1" axis_ref="presnivs" /> 11 <field field_ref="cllcalipsoice" level="1" /> 12 <field field_ref="clmcalipsoice" level="1" /> 13 <field field_ref="clhcalipsoice" level="1" /> 14 <field field_ref="cltcalipsoice" level="1" /> 15 <field field_ref="cllcalipsoliq" level="1" /> 16 <field field_ref="clmcalipsoliq" level="1" /> 17 <field field_ref="clhcalipsoliq" level="1" /> 18 <field field_ref="cltcalipsoliq" level="1" /> 19 <field field_ref="cllcalipsoun" level="1" /> 20 <field field_ref="clmcalipsoun" level="1" /> 21 <field field_ref="clhcalipsoun" level="1" /> 22 <field field_ref="cltcalipsoun" level="1" /> 23 <field field_ref="clcalipso" level="1" axis_ref="height" /> 24 <field field_ref="clcalipsoice" level="1" axis_ref="height" /> 25 <field field_ref="clcalipsoliq" level="1" axis_ref="height" /> 26 <field field_ref="clcalipsoun" level="1" axis_ref="height" /> 27 <field field_ref="clcalipsotmp" level="1" axis_ref="height" /> 28 <field field_ref="clcalipsotmpice" level="1" axis_ref="height" /> 29 <field field_ref="clcalipsotmpliq" level="1" axis_ref="height" /> 30 <field field_ref="clcalipsotmpun" level="1" axis_ref="height" /> 12 31 <field field_ref="parasol_refl" level="1" axis_ref="sza" /> 13 32 <field field_ref="parasol_crefl" level="1" axis_ref="sza" /> 14 33 <field field_ref="Ncrefl" level="1" axis_ref="sza" /> 15 <field field_ref="c01_cfad_lidarsr532" level="10" axis_ref=" presnivs" />16 <field field_ref="c02_cfad_lidarsr532" level="10" axis_ref=" presnivs" />17 <field field_ref="c03_cfad_lidarsr532" level="10" axis_ref=" presnivs" />18 <field field_ref="c04_cfad_lidarsr532" level="10" axis_ref=" presnivs" />19 <field field_ref="c05_cfad_lidarsr532" level="10" axis_ref=" presnivs" />20 <field field_ref="c06_cfad_lidarsr532" level="10" axis_ref=" presnivs" />21 <field field_ref="c07_cfad_lidarsr532" level="10" axis_ref=" presnivs" />22 <field field_ref="c08_cfad_lidarsr532" level="10" axis_ref=" presnivs" />23 <field field_ref="c09_cfad_lidarsr532" level="10" axis_ref=" presnivs" />24 <field field_ref="c10_cfad_lidarsr532" level="10" axis_ref=" presnivs" />25 <field field_ref="c11_cfad_lidarsr532" level="10" axis_ref=" presnivs" />26 <field field_ref="c12_cfad_lidarsr532" level="10" axis_ref=" presnivs" />27 <field field_ref="c13_cfad_lidarsr532" level="10" axis_ref=" presnivs" />28 <field field_ref="c14_cfad_lidarsr532" level="10" axis_ref=" presnivs" />29 <field field_ref="c15_cfad_lidarsr532" level="10" axis_ref=" presnivs" />30 <field field_ref="c16_cfad_lidarsr532" level="10" axis_ref=" presnivs" />31 <field field_ref="c17_cfad_lidarsr532" level="10" axis_ref=" presnivs" />32 <field field_ref="c18_cfad_lidarsr532" level="10" axis_ref=" presnivs" />33 <field field_ref="c19_cfad_lidarsr532" level="10" axis_ref=" presnivs" />34 <field field_ref="c20_cfad_lidarsr532" level="10" axis_ref=" presnivs" />34 <field field_ref="c01_cfad_lidarsr532" level="10" axis_ref="height" /> 35 <field field_ref="c02_cfad_lidarsr532" level="10" axis_ref="height" /> 36 <field field_ref="c03_cfad_lidarsr532" level="10" axis_ref="height" /> 37 <field field_ref="c04_cfad_lidarsr532" level="10" axis_ref="height" /> 38 <field field_ref="c05_cfad_lidarsr532" level="10" axis_ref="height" /> 39 <field field_ref="c06_cfad_lidarsr532" level="10" axis_ref="height" /> 40 <field field_ref="c07_cfad_lidarsr532" level="10" axis_ref="height" /> 41 <field field_ref="c08_cfad_lidarsr532" level="10" axis_ref="height" /> 42 <field field_ref="c09_cfad_lidarsr532" level="10" axis_ref="height" /> 43 <field field_ref="c10_cfad_lidarsr532" level="10" axis_ref="height" /> 44 <field field_ref="c11_cfad_lidarsr532" level="10" axis_ref="height" /> 45 <field field_ref="c12_cfad_lidarsr532" level="10" axis_ref="height" /> 46 <field field_ref="c13_cfad_lidarsr532" level="10" axis_ref="height" /> 47 <field field_ref="c14_cfad_lidarsr532" level="10" axis_ref="height" /> 48 <field field_ref="c15_cfad_lidarsr532" level="10" axis_ref="height" /> 49 <field field_ref="c16_cfad_lidarsr532" level="10" axis_ref="height" /> 50 <field field_ref="c17_cfad_lidarsr532" level="10" axis_ref="height" /> 51 <field field_ref="c18_cfad_lidarsr532" level="10" axis_ref="height" /> 52 <field field_ref="c19_cfad_lidarsr532" level="10" axis_ref="height" /> 53 <field field_ref="c20_cfad_lidarsr532" level="10" axis_ref="height" /> 35 54 <field field_ref="c01_atb532" level="10" axis_ref="height_mlev" /> 36 55 <field field_ref="c02_atb532" level="10" axis_ref="height_mlev" /> … … 65 84 <field field_ref="boxptopisccp" level="10" axis_ref="column" /> 66 85 <field field_ref="tclisccp" level="1" /> 67 <field field_ref="ctpisccp" level="1 0" />68 <field field_ref="tauisccp" level="1 0" />69 <field field_ref="albisccp" level="1 0" />86 <field field_ref="ctpisccp" level="1" /> 87 <field field_ref="tauisccp" level="1" /> 88 <field field_ref="albisccp" level="1" /> 70 89 <field field_ref="meantbisccp" level="10" /> 71 90 <field field_ref="meantbclrisccp" level="10" /> -
LMDZ5/trunk/DefLists/file_def_histhfCOSP_lmdz.xml
r2411 r2428 1 1 <file_definition> 2 2 <file_group id="defile"> 3 <file id="histhfCOSP" name=" histhfCOSP" output_freq="6h" output_level="5" enabled=".FALSE.">3 <file id="histhfCOSP" name="XhisthfCOSP" output_freq="3h" output_level="1" enabled=".TRUE."> 4 4 5 5 <!-- VARS 2D --> 6 <field_group operation="instant" freq_op=" 3h">6 <field_group operation="instant" freq_op="1ts"> 7 7 <field field_ref="cllcalipso" level="1" /> 8 8 <field field_ref="clmcalipso" level="1" /> 9 9 <field field_ref="clhcalipso" level="1" /> 10 10 <field field_ref="cltcalipso" level="1" /> 11 <field field_ref="clcalipso" level="1" axis_ref="presnivs" /> 11 <field field_ref="cllcalipsoice" level="1" /> 12 <field field_ref="clmcalipsoice" level="1" /> 13 <field field_ref="clhcalipsoice" level="1" /> 14 <field field_ref="cltcalipsoice" level="1" /> 15 <field field_ref="cllcalipsoliq" level="1" /> 16 <field field_ref="clmcalipsoliq" level="1" /> 17 <field field_ref="clhcalipsoliq" level="1" /> 18 <field field_ref="cltcalipsoliq" level="1" /> 19 <field field_ref="cllcalipsoun" level="1" /> 20 <field field_ref="clmcalipsoun" level="1" /> 21 <field field_ref="clhcalipsoun" level="1" /> 22 <field field_ref="cltcalipsoun" level="1" /> 23 <field field_ref="clcalipso" level="1" axis_ref="height" /> 24 <field field_ref="clcalipsoice" level="1" axis_ref="height" /> 25 <field field_ref="clcalipsoliq" level="1" axis_ref="height" /> 26 <field field_ref="clcalipsoun" level="1" axis_ref="height" /> 27 <field field_ref="clcalipsotmp" level="1" axis_ref="height" /> 28 <field field_ref="clcalipsotmpice" level="1" axis_ref="height" /> 29 <field field_ref="clcalipsotmpliq" level="1" axis_ref="height" /> 30 <field field_ref="clcalipsotmpun" level="1" axis_ref="height" /> 12 31 <field field_ref="parasol_refl" level="1" axis_ref="sza" /> 13 32 <field field_ref="parasol_crefl" level="1" axis_ref="sza" /> 14 33 <field field_ref="Ncrefl" level="1" axis_ref="sza" /> 15 <field field_ref="c01_cfad_lidarsr532" level="10" axis_ref=" presnivs" />16 <field field_ref="c02_cfad_lidarsr532" level="10" axis_ref=" presnivs" />17 <field field_ref="c03_cfad_lidarsr532" level="10" axis_ref=" presnivs" />18 <field field_ref="c04_cfad_lidarsr532" level="10" axis_ref=" presnivs" />19 <field field_ref="c05_cfad_lidarsr532" level="10" axis_ref=" presnivs" />20 <field field_ref="c06_cfad_lidarsr532" level="10" axis_ref=" presnivs" />21 <field field_ref="c07_cfad_lidarsr532" level="10" axis_ref=" presnivs" />22 <field field_ref="c08_cfad_lidarsr532" level="10" axis_ref=" presnivs" />23 <field field_ref="c09_cfad_lidarsr532" level="10" axis_ref=" presnivs" />24 <field field_ref="c10_cfad_lidarsr532" level="10" axis_ref=" presnivs" />25 <field field_ref="c11_cfad_lidarsr532" level="10" axis_ref=" presnivs" />26 <field field_ref="c12_cfad_lidarsr532" level="10" axis_ref=" presnivs" />27 <field field_ref="c13_cfad_lidarsr532" level="10" axis_ref=" presnivs" />28 <field field_ref="c14_cfad_lidarsr532" level="10" axis_ref=" presnivs" />29 <field field_ref="c15_cfad_lidarsr532" level="10" axis_ref=" presnivs" />30 <field field_ref="c16_cfad_lidarsr532" level="10" axis_ref=" presnivs" />31 <field field_ref="c17_cfad_lidarsr532" level="10" axis_ref=" presnivs" />32 <field field_ref="c18_cfad_lidarsr532" level="10" axis_ref=" presnivs" />33 <field field_ref="c19_cfad_lidarsr532" level="10" axis_ref=" presnivs" />34 <field field_ref="c20_cfad_lidarsr532" level="10" axis_ref=" presnivs" />34 <field field_ref="c01_cfad_lidarsr532" level="10" axis_ref="height" /> 35 <field field_ref="c02_cfad_lidarsr532" level="10" axis_ref="height" /> 36 <field field_ref="c03_cfad_lidarsr532" level="10" axis_ref="height" /> 37 <field field_ref="c04_cfad_lidarsr532" level="10" axis_ref="height" /> 38 <field field_ref="c05_cfad_lidarsr532" level="10" axis_ref="height" /> 39 <field field_ref="c06_cfad_lidarsr532" level="10" axis_ref="height" /> 40 <field field_ref="c07_cfad_lidarsr532" level="10" axis_ref="height" /> 41 <field field_ref="c08_cfad_lidarsr532" level="10" axis_ref="height" /> 42 <field field_ref="c09_cfad_lidarsr532" level="10" axis_ref="height" /> 43 <field field_ref="c10_cfad_lidarsr532" level="10" axis_ref="height" /> 44 <field field_ref="c11_cfad_lidarsr532" level="10" axis_ref="height" /> 45 <field field_ref="c12_cfad_lidarsr532" level="10" axis_ref="height" /> 46 <field field_ref="c13_cfad_lidarsr532" level="10" axis_ref="height" /> 47 <field field_ref="c14_cfad_lidarsr532" level="10" axis_ref="height" /> 48 <field field_ref="c15_cfad_lidarsr532" level="10" axis_ref="height" /> 49 <field field_ref="c16_cfad_lidarsr532" level="10" axis_ref="height" /> 50 <field field_ref="c17_cfad_lidarsr532" level="10" axis_ref="height" /> 51 <field field_ref="c18_cfad_lidarsr532" level="10" axis_ref="height" /> 52 <field field_ref="c19_cfad_lidarsr532" level="10" axis_ref="height" /> 53 <field field_ref="c20_cfad_lidarsr532" level="10" axis_ref="height" /> 35 54 <field field_ref="c01_atb532" level="10" axis_ref="height_mlev" /> 36 55 <field field_ref="c02_atb532" level="10" axis_ref="height_mlev" /> -
LMDZ5/trunk/DefLists/file_def_histmthCOSP_lmdz.xml
r2411 r2428 1 1 <file_definition> 2 2 <file_group id="defile"> 3 <file id="histmthCOSP" name="histmthCOSP" output_freq=" 1mo" output_level="5" enabled=".FALSE.">3 <file id="histmthCOSP" name="histmthCOSP" output_freq="30d" output_level="1" enabled=".TRUE."> 4 4 5 5 <!-- VARS 2D --> 6 <field_group operation="average" freq_op="3h" >6 <field_group operation="average" freq_op="3h" detect_missing_value=".true."> 7 7 <field field_ref="cllcalipso" level="1" /> 8 8 <field field_ref="clmcalipso" level="1" /> 9 9 <field field_ref="clhcalipso" level="1" /> 10 10 <field field_ref="cltcalipso" level="1" /> 11 <field field_ref="clcalipso" level="1" axis_ref="presnivs" /> 11 <field field_ref="cllcalipsoice" level="1" /> 12 <field field_ref="clmcalipsoice" level="1" /> 13 <field field_ref="clhcalipsoice" level="1" /> 14 <field field_ref="cltcalipsoice" level="1" /> 15 <field field_ref="cllcalipsoliq" level="1" /> 16 <field field_ref="clmcalipsoliq" level="1" /> 17 <field field_ref="clhcalipsoliq" level="1" /> 18 <field field_ref="cltcalipsoliq" level="1" /> 19 <field field_ref="cllcalipsoun" level="1" /> 20 <field field_ref="clmcalipsoun" level="1" /> 21 <field field_ref="clhcalipsoun" level="1" /> 22 <field field_ref="cltcalipsoun" level="1" /> 23 <field field_ref="clcalipso" level="1" axis_ref="height" /> 24 <field field_ref="clcalipsoice" level="1" axis_ref="height" /> 25 <field field_ref="clcalipsoliq" level="1" axis_ref="height" /> 26 <field field_ref="clcalipsoun" level="1" axis_ref="height" /> 27 <field field_ref="clcalipsotmp" level="1" axis_ref="height" /> 28 <field field_ref="clcalipsotmpice" level="1" axis_ref="height" /> 29 <field field_ref="clcalipsotmpliq" level="1" axis_ref="height" /> 30 <field field_ref="clcalipsotmpun" level="1" axis_ref="height" /> 12 31 <field field_ref="parasol_refl" level="1" axis_ref="sza" /> 13 32 <field field_ref="parasol_crefl" level="1" axis_ref="sza" /> 14 33 <field field_ref="Ncrefl" level="1" axis_ref="sza" /> 15 <field field_ref="c01_cfad_lidarsr532" level="10" axis_ref=" presnivs" />16 <field field_ref="c02_cfad_lidarsr532" level="10" axis_ref=" presnivs" />17 <field field_ref="c03_cfad_lidarsr532" level="10" axis_ref=" presnivs" />18 <field field_ref="c04_cfad_lidarsr532" level="10" axis_ref=" presnivs" />19 <field field_ref="c05_cfad_lidarsr532" level="10" axis_ref=" presnivs" />20 <field field_ref="c06_cfad_lidarsr532" level="10" axis_ref=" presnivs" />21 <field field_ref="c07_cfad_lidarsr532" level="10" axis_ref=" presnivs" />22 <field field_ref="c08_cfad_lidarsr532" level="10" axis_ref=" presnivs" />23 <field field_ref="c09_cfad_lidarsr532" level="10" axis_ref=" presnivs" />24 <field field_ref="c10_cfad_lidarsr532" level="10" axis_ref=" presnivs" />25 <field field_ref="c11_cfad_lidarsr532" level="10" axis_ref=" presnivs" />26 <field field_ref="c12_cfad_lidarsr532" level="10" axis_ref=" presnivs" />27 <field field_ref="c13_cfad_lidarsr532" level="10" axis_ref=" presnivs" />28 <field field_ref="c14_cfad_lidarsr532" level="10" axis_ref=" presnivs" />29 <field field_ref="c15_cfad_lidarsr532" level="10" axis_ref=" presnivs" />30 <field field_ref="c16_cfad_lidarsr532" level="10" axis_ref=" presnivs" />31 <field field_ref="c17_cfad_lidarsr532" level="10" axis_ref=" presnivs" />32 <field field_ref="c18_cfad_lidarsr532" level="10" axis_ref=" presnivs" />33 <field field_ref="c19_cfad_lidarsr532" level="10" axis_ref=" presnivs" />34 <field field_ref="c20_cfad_lidarsr532" level="10" axis_ref=" presnivs" />34 <field field_ref="c01_cfad_lidarsr532" level="10" axis_ref="height" /> 35 <field field_ref="c02_cfad_lidarsr532" level="10" axis_ref="height" /> 36 <field field_ref="c03_cfad_lidarsr532" level="10" axis_ref="height" /> 37 <field field_ref="c04_cfad_lidarsr532" level="10" axis_ref="height" /> 38 <field field_ref="c05_cfad_lidarsr532" level="10" axis_ref="height" /> 39 <field field_ref="c06_cfad_lidarsr532" level="10" axis_ref="height" /> 40 <field field_ref="c07_cfad_lidarsr532" level="10" axis_ref="height" /> 41 <field field_ref="c08_cfad_lidarsr532" level="10" axis_ref="height" /> 42 <field field_ref="c09_cfad_lidarsr532" level="10" axis_ref="height" /> 43 <field field_ref="c10_cfad_lidarsr532" level="10" axis_ref="height" /> 44 <field field_ref="c11_cfad_lidarsr532" level="10" axis_ref="height" /> 45 <field field_ref="c12_cfad_lidarsr532" level="10" axis_ref="height" /> 46 <field field_ref="c13_cfad_lidarsr532" level="10" axis_ref="height" /> 47 <field field_ref="c14_cfad_lidarsr532" level="10" axis_ref="height" /> 48 <field field_ref="c15_cfad_lidarsr532" level="10" axis_ref="height" /> 49 <field field_ref="c16_cfad_lidarsr532" level="10" axis_ref="height" /> 50 <field field_ref="c17_cfad_lidarsr532" level="10" axis_ref="height" /> 51 <field field_ref="c18_cfad_lidarsr532" level="10" axis_ref="height" /> 52 <field field_ref="c19_cfad_lidarsr532" level="10" axis_ref="height" /> 53 <field field_ref="c20_cfad_lidarsr532" level="10" axis_ref="height" /> 35 54 <field field_ref="c01_atb532" level="10" axis_ref="height_mlev" /> 36 55 <field field_ref="c02_atb532" level="10" axis_ref="height_mlev" /> … … 54 73 <field field_ref="c20_atb532" level="10" axis_ref="height_mlev" /> 55 74 <field field_ref="beta_mol532" level="10" axis_ref="height_mlev" /> 56 <field field_ref="sunlit" level="1 0" />57 <field field_ref="c01_clisccp2" level="1 0" axis_ref="pressure2" />58 <field field_ref="c02_clisccp2" level="1 0" axis_ref="pressure2" />59 <field field_ref="c03_clisccp2" level="1 0" axis_ref="pressure2" />60 <field field_ref="c04_clisccp2" level="1 0" axis_ref="pressure2" />61 <field field_ref="c05_clisccp2" level="1 0" axis_ref="pressure2" />62 <field field_ref="c06_clisccp2" level="1 0" axis_ref="pressure2" />63 <field field_ref="c07_clisccp2" level="1 0" axis_ref="pressure2" />75 <field field_ref="sunlit" level="1" /> 76 <field field_ref="c01_clisccp2" level="1" axis_ref="pressure2" /> 77 <field field_ref="c02_clisccp2" level="1" axis_ref="pressure2" /> 78 <field field_ref="c03_clisccp2" level="1" axis_ref="pressure2" /> 79 <field field_ref="c04_clisccp2" level="1" axis_ref="pressure2" /> 80 <field field_ref="c05_clisccp2" level="1" axis_ref="pressure2" /> 81 <field field_ref="c06_clisccp2" level="1" axis_ref="pressure2" /> 82 <field field_ref="c07_clisccp2" level="1" axis_ref="pressure2" /> 64 83 <field field_ref="boxtauisccp" level="10" axis_ref="column" /> 65 84 <field field_ref="boxptopisccp" level="10" axis_ref="column" /> 66 <field field_ref="tclisccp" level="1 0" />67 <field field_ref="ctpisccp" level="1 0" />68 <field field_ref="tauisccp" level="1 0" />69 <field field_ref="albisccp" level="1 0" />85 <field field_ref="tclisccp" level="1" /> 86 <field field_ref="ctpisccp" level="1" /> 87 <field field_ref="tauisccp" level="1" /> 88 <field field_ref="albisccp" level="1" /> 70 89 <field field_ref="meantbisccp" level="10" /> 71 90 <field field_ref="meantbclrisccp" level="10" /> -
LMDZ5/trunk/libf/phylmd/cosp/MISR_simulator.F
r1907 r2428 2 2 ! Copyright (c) 2009, Roger Marchand, version 1.2 3 3 ! All rights reserved. 4 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 5 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/MISR_simulator/MISR_simulator.f $ 4 6 ! 5 7 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 27 29 & ncol, 28 30 & sunlit, 29 & 30 & 31 & zfull, 32 & at, 31 33 & dtau_s, 32 & dtau_c, 33 & frac_out, 34 & fq_MISR_TAU_v_CTH, 35 & dist_model_layertops, 36 & MISR_mean_ztop, 34 & dtau_c, 35 & frac_out, 36 & missing_value, 37 & fq_MISR_TAU_v_CTH, 38 & dist_model_layertops, 39 & MISR_mean_ztop, 37 40 & MISR_cldarea 38 41 & ) 39 42 40 43 41 44 implicit none … … 48 51 49 52 INTEGER npoints ! if ncol ==1, the number of model points in the horizontal grid 50 ! elsethe number of GCM grid points51 53 ! else the number of GCM grid points 54 52 55 INTEGER nlev ! number of model vertical levels 53 56 54 57 INTEGER ncol ! number of model sub columns 55 56 58 ! (must already be generated in via scops and passed to this 59 ! routine via the variable frac_out ) 57 60 58 61 INTEGER sunlit(npoints) ! 1 for day points, 0 for night time 59 62 60 REAL zfull(npoints,nlev) 63 REAL zfull(npoints,nlev) ! height (in meters) of full model levels (i.e. midpoints) 61 64 ! zfull(npoints,1) is top level of model 62 65 ! zfull(npoints,nlev) is bottom level of model (closest point to surface) … … 66 69 REAL dtau_s(npoints,nlev) ! visible wavelength cloud optical depth ... for "stratiform" condensate 67 70 ! NOTE: this the cloud optical depth of only the 68 !the model cell (i,j)69 71 ! the model cell (i,j) 72 70 73 REAL dtau_c(npoints,nlev) ! visible wavelength cloud optical depth ... for "convective" condensate 71 74 ! NOTE: this the cloud optical depth of only the 72 !the model cell (i,j)75 ! the model cell (i,j) 73 76 74 77 REAL frac_out(npoints,ncol,nlev) ! NOTE: only need if columns>1 ... subgrid scheme in use. 78 79 REAL missing_value 75 80 76 81 ! ------ 77 82 ! Outputs 78 83 ! ------ 79 84 80 85 REAL fq_MISR_TAU_v_CTH(npoints,7,n_MISR_CTH) 81 86 REAL dist_model_layertops(npoints,n_MISR_CTH) 82 REAL MISR_cldarea(npoints) 83 REAL MISR_mean_ztop(npoints) 84 85 87 REAL MISR_cldarea(npoints) ! fractional area coverged by clouds 88 REAL MISR_mean_ztop(npoints) ! mean cloud top hieght(m) MISR would observe 89 ! NOTE: == 0 if area ==0 90 86 91 87 92 ! ------ … … 89 94 ! ------ 90 95 91 REAL tau(npoints,ncol) 92 93 INTEGER j,ilev,ilev2,ibox 96 REAL tau(npoints,ncol) ! total column optical depth ... 97 98 INTEGER j,ilev,ilev2,ibox,k 94 99 INTEGER itau 95 100 … … 99 104 real boxarea 100 105 real tauchk 101 REAL box_MISR_ztop(npoints,ncol) 106 REAL box_MISR_ztop(npoints,ncol) ! cloud top hieght(m) MISR would observe 102 107 103 108 integer thres_crossed_MISR … … 109 114 110 115 DATA MISR_CTH_boundaries / -99, 0, 0.5, 1, 1.5, 2, 2.5, 3, 111 c 116 c 4, 5, 7, 9, 11, 13, 15, 17, 99 / 112 117 113 118 DATA isccp_taumin / 0.3 / 114 119 115 120 tauchk = -1.*log(0.9999999) 116 121 117 122 ! 118 ! 119 ! 120 do j=1,npoints 123 ! For each GCM cell or horizontal model grid point ... 124 ! 125 do j=1,npoints 121 126 122 127 ! 123 ! 124 ! 128 ! estimate distribution of Model layer tops 129 ! 125 130 dist_model_layertops(j,:)=0 126 131 127 do ilev=1,nlev 128 129 130 131 132 133 134 endif 135 136 137 138 139 140 141 142 & 143 144 145 146 147 148 149 & 150 151 152 132 do ilev=1,nlev 133 134 ! define location of "layer top" 135 if(ilev.eq.1 .or. ilev.eq.nlev) then 136 ztest=zfull(j,ilev) 137 else 138 ztest=0.5*(zfull(j,ilev)+zfull(j,ilev-1)) 139 endif 140 141 ! find MISR layer that contains this level 142 ! note, the first MISR level is "no height" level 143 iMISR_ztop=2 144 do loop=2,n_MISR_CTH 145 146 if ( ztest .gt. 147 & 1000*MISR_CTH_boundaries(loop+1) ) then 148 149 iMISR_ztop=loop+1 150 endif 151 enddo 152 153 dist_model_layertops(j,iMISR_ztop)= 154 & dist_model_layertops(j,iMISR_ztop)+1 155 enddo 156 157 153 158 ! 154 159 ! compute total cloud optical depth for each column 155 160 ! 156 157 158 159 160 161 162 163 164 165 166 161 do ibox=1,ncol 162 163 ! Initialize tau to zero in each subcolum 164 tau(j,ibox)=0. 165 box_cloudy(j,ibox)=.false. 166 box_MISR_ztop(j,ibox)=0 167 168 ! initialize threshold detection for each sub column 169 thres_crossed_MISR=0; 170 171 do ilev=1,nlev 167 172 168 169 170 173 dtau=0 174 175 if (frac_out(j,ibox,ilev).eq.1) then 171 176 dtau = dtau_s(j,ilev) 172 177 endif … … 174 179 if (frac_out(j,ibox,ilev).eq.2) then 175 180 dtau = dtau_c(j,ilev) 176 end if 181 end if 177 182 178 179 180 181 182 183 184 185 186 187 cloud_dtau=0 188 endif 189 190 191 & 183 tau(j,ibox)=tau(j,ibox)+ dtau 184 185 186 ! NOW for MISR .. 187 ! if there a cloud ... start the counter ... store this height 188 if(thres_crossed_MISR .eq. 0 .and. dtau .gt. 0.) then 189 190 ! first encountered a "cloud" 191 thres_crossed_MISR=1 192 cloud_dtau=0 193 endif 194 195 if( thres_crossed_MISR .lt. 99 .and. 196 & thres_crossed_MISR .gt. 0 ) then 192 197 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 & 221 & 222 & 223 endif 224 225 226 227 228 229 230 198 if( dtau .eq. 0.) then 199 200 ! we have come to the end of the current cloud 201 ! layer without yet selecting a CTH boundary. 202 ! ... restart cloud tau counter 203 cloud_dtau=0 204 else 205 ! add current optical depth to count for 206 ! the current cloud layer 207 cloud_dtau=cloud_dtau+dtau 208 endif 209 210 ! if the cloud is continuous but optically thin (< 1) 211 ! from above the current layer cloud top to the current level 212 ! then MISR will like see a top below the top of the current 213 ! layer 214 if( dtau.gt.0 .and. (cloud_dtau-dtau) .lt. 1) then 215 216 if(dtau .lt. 1 .or. ilev.eq.1 .or. ilev.eq.nlev) then 217 218 ! MISR will likely penetrate to some point 219 ! within this layer ... the middle 220 MISR_penetration_height=zfull(j,ilev) 221 222 else 223 ! take the OD = 1.0 level into this layer 224 MISR_penetration_height= 225 & 0.5*(zfull(j,ilev)+zfull(j,ilev-1)) - 226 & 0.5*(zfull(j,ilev-1)-zfull(j,ilev+1)) 227 & /dtau 228 endif 229 230 box_MISR_ztop(j,ibox)=MISR_penetration_height 231 232 endif 233 234 ! check for a distinctive water layer 235 if(dtau .gt. 1 .and. at(j,ilev).gt.273 ) then 231 236 232 233 234 235 236 237 238 239 if(tau(j,ibox) .gt. 5) then 240 241 thres_crossed_MISR=99 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 237 ! must be a water cloud ... 238 ! take this as CTH level 239 thres_crossed_MISR=99 240 endif 241 242 ! if the total column optical depth is "large" than 243 ! MISR can't seen anything else ... set current point as CTH level 244 if(tau(j,ibox) .gt. 5) then 245 246 thres_crossed_MISR=99 247 endif 248 249 endif ! MISR CTH booundary not set 250 251 enddo !ilev - loop over vertical levesl 252 253 ! written by roj 5/2006 254 ! check to see if there was a cloud for which we didn't 255 ! set a MISR cloud top boundary 256 if( thres_crossed_MISR .eq. 1) then 257 258 ! if the cloud has a total optical depth of greater 259 ! than ~ 0.5 MISR will still likely pick up this cloud 260 ! with a height near the true cloud top 261 ! otherwise there should be no CTH 262 if( tau(j,ibox) .gt. 0.5) then 263 264 ! keep MISR detected CTH 265 266 elseif(tau(j,ibox) .gt. 0.2) then 267 268 ! MISR may detect but wont likley have a good height 269 box_MISR_ztop(j,ibox)=-1 270 271 else 272 ! MISR not likely to even detect. 273 ! so set as not cloudy 274 box_MISR_ztop(j,ibox)=0 275 276 endif 277 278 endif 279 280 enddo ! loop of subcolumns 276 281 enddo ! loop of gridpoints 277 282 278 283 279 284 ! 280 ! 281 282 !Code in this region added by roj 5/2006 to account283 !for spatial effect of the MISR pattern matcher.284 !Basically, if a column is found between two neighbors285 !at the same CTH, and that column has no hieght or286 !a lower CTH, THEN misr will tend to but place the287 !odd column at the same height as it neighbors.288 289 !This setup assumes the columns represent a about a 1 to 4 km scale290 !it will need to be modified significantly, otherwise291 292 293 285 ! Modify MISR CTH for satellite spatial / pattern matcher effects 286 ! 287 ! Code in this region added by roj 5/2006 to account 288 ! for spatial effect of the MISR pattern matcher. 289 ! Basically, if a column is found between two neighbors 290 ! at the same CTH, and that column has no hieght or 291 ! a lower CTH, THEN misr will tend to but place the 292 ! odd column at the same height as it neighbors. 293 ! 294 ! This setup assumes the columns represent a about a 1 to 4 km scale 295 ! it will need to be modified significantly, otherwise 296 if(ncol.eq.1) then 297 298 ! adjust based on neightboring points ... i.e. only 2D grid was input 294 299 do j=2,npoints-1 295 296 297 & box_MISR_ztop(j+1,1).gt.0) then298 299 300 & 301 & 302 & 303 & 304 305 306 & 307 308 309 300 301 if(box_MISR_ztop(j-1,1).gt.0 .and. 302 & box_MISR_ztop(j+1,1).gt.0 ) then 303 304 if( abs( box_MISR_ztop(j-1,1) - 305 & box_MISR_ztop(j+1,1) ) .lt. 500 306 & .and. 307 & box_MISR_ztop(j,1) .lt. 308 & box_MISR_ztop(j+1,1) ) then 309 310 box_MISR_ztop(j,1) = 311 & box_MISR_ztop(j+1,1) 312 endif 313 314 endif 310 315 enddo 311 else316 else 312 317 313 318 ! adjust based on neighboring subcolumns .... 314 319 do ibox=2,ncol-1 315 316 317 & box_MISR_ztop(1,ibox+1).gt.0) then318 319 320 & 321 & 322 & 323 & 324 325 326 & 327 328 329 320 321 if(box_MISR_ztop(1,ibox-1).gt.0 .and. 322 & box_MISR_ztop(1,ibox+1).gt.0 ) then 323 324 if( abs( box_MISR_ztop(1,ibox-1) - 325 & box_MISR_ztop(1,ibox+1) ) .lt. 500 326 & .and. 327 & box_MISR_ztop(1,ibox) .lt. 328 & box_MISR_ztop(1,ibox+1) ) then 329 330 box_MISR_ztop(1,ibox) = 331 & box_MISR_ztop(1,ibox+1) 332 endif 333 334 endif 330 335 enddo 331 336 332 endif337 endif 333 338 334 339 ! 335 336 337 338 339 boxarea=1./real(ncol)340 do j=1,npoints340 ! DETERMINE CLOUD TYPE FREQUENCIES 341 ! 342 ! Now that ztop and tau have been determined, 343 ! determine amount of each cloud type 344 boxarea=1./real(ncol) 345 do j=1,npoints 341 346 342 347 ! reset frequencies -- modified loop structure, roj 5/2006 343 do ilev=1,7 ! "tau loop" 344 do ilev2=1,n_MISR_CTH 345 348 do ilev=1,7 ! "tau loop" 349 do ilev2=1,n_MISR_CTH 350 fq_MISR_TAU_v_CTH(j,ilev,ilev2)=0. 346 351 enddo 347 348 349 350 352 enddo 353 354 MISR_cldarea(j)=0. 355 MISR_mean_ztop(j)=0. 351 356 352 357 do ibox=1,ncol … … 356 361 endif 357 362 358 359 363 itau = 0 364 360 365 if (box_cloudy(j,ibox)) then 361 362 366 367 !determine optical depth category 363 368 if (tau(j,ibox) .lt. isccp_taumin) then 364 369 itau=1 … … 382 387 endif 383 388 384 385 386 387 388 389 endif 390 391 ! update MISR histograms and summary metrics - roj 5/2005 392 if (sunlit(j).eq.1) then 393 389 394 !if cloudy added by roj 5/2005 390 391 392 393 394 395 396 397 398 399 400 401 & 402 403 404 405 406 407 408 409 410 411 412 413 414 & 415 416 417 418 419 420 421 422 423 424 425 & 395 if( box_MISR_ztop(j,ibox).eq.0) then 396 397 ! no cloud detected 398 iMISR_ztop=0 399 400 elseif( box_MISR_ztop(j,ibox).eq.-1) then 401 402 ! cloud can be detected but too thin to get CTH 403 iMISR_ztop=1 404 405 fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop)= 406 & fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop) + boxarea 407 408 else 409 410 ! 411 ! determine index for MISR bin set 412 ! 413 414 iMISR_ztop=2 415 416 do loop=2,n_MISR_CTH 417 418 if ( box_MISR_ztop(j,ibox) .gt. 419 & 1000*MISR_CTH_boundaries(loop+1) ) then 420 421 iMISR_ztop=loop+1 422 423 endif 424 enddo 425 426 if(box_cloudy(j,ibox)) then 427 428 ! there is an isccp clouds so itau(j) is defined 429 fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop)= 430 & fq_MISR_TAU_v_CTH(j,itau,iMISR_ztop) + boxarea 426 431 427 428 429 430 431 432 433 434 435 436 437 ! 438 ! & 439 440 441 442 443 & box_MISR_ztop(j,ibox)*boxarea444 445 432 else 433 ! MISR CTH resolution is trying to fill in a 434 ! broken cloud scene where there is no condensate. 435 ! The MISR CTH-1D-OD product will only put in a cloud 436 ! if the MISR cloud mask indicates cloud. 437 ! therefore we will not include this column in the histogram 438 ! in reality aerosoal and 3D effects or bright surfaces 439 ! could fool the MISR cloud mask 440 441 ! the alternative is to count as very thin cloud ?? 442 ! fq_MISR_TAU_v_CTH(1,iMISR_ztop)= 443 ! & fq_MISR_TAU_v_CTH(1,iMISR_ztop) + boxarea 444 endif 445 446 447 MISR_mean_ztop(j)=MISR_mean_ztop(j)+ 448 & box_MISR_ztop(j,ibox)*boxarea 449 450 MISR_cldarea(j)=MISR_cldarea(j) + boxarea 446 451 447 endif 448 449 endif ! is sunlight ? 450 451 enddo ! ibox - loop over subcolumns 452 453 if( MISR_cldarea(j) .gt. 0.) then 454 MISR_mean_ztop(j)= MISR_mean_ztop(j) / MISR_cldarea(j) ! roj 5/2006 455 endif 456 457 enddo ! loop over grid points 452 endif 453 else 454 ! Set to issing data. A. Bodas - 14/05/2010 455 do loop=1,n_MISR_CTH 456 do k=1,7 457 fq_MISR_TAU_v_CTH(j,k,loop) = missing_value 458 enddo 459 dist_model_layertops(j,loop) = missing_value 460 enddo 461 MISR_cldarea(j) = missing_value 462 MISR_mean_ztop(npoints) = missing_value 463 464 endif ! is sunlight ? 465 466 enddo ! ibox - loop over subcolumns 467 468 if( MISR_cldarea(j) .gt. 0.) then 469 MISR_mean_ztop(j)= MISR_mean_ztop(j) / MISR_cldarea(j) ! roj 5/2006 470 endif 471 472 enddo ! loop over grid points 458 473 459 474 return -
LMDZ5/trunk/libf/phylmd/cosp/array_lib.F90
r1907 r2428 1 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/array_lib.f90 $ 1 3 ! ARRAY_LIB: Array procedures for F90 2 4 ! Compiled/Modified: -
LMDZ5/trunk/libf/phylmd/cosp/atmos_lib.F90
r1907 r2428 1 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/atmos_lib.f90 $ 1 3 ! ATMOS_LIB: Atmospheric science procedures for F90 2 4 ! Compiled/Modified: … … 64 66 32.2000, 27.7000, 13.2000, 6.52000, 3.33000, 1.76000, & 65 67 0.951000,0.0671000,0.000300000/) 66 68 67 69 tk = (/294.000, 290.000, 285.000, 279.000, 273.000, 267.000, & 68 70 261.000, 255.000, 248.000, 242.000, 235.000, 229.000, & … … 124 126 1.55162,1.37966,0.229799,0.0245943,0.00373686,0.000702138, & 125 127 0.000162076,0.000362055,7.68645e-06/) 126 128 127 129 case default 128 130 print *, 'Must enter a profile type' -
LMDZ5/trunk/libf/phylmd/cosp/congvec.h
r1907 r2428 3 3 ! (c) British Crown Copyright 2009, the Met Office. 4 4 ! All rights reserved. 5 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 6 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/icarus-scops-4.1-bsd/congvec.f $ 5 7 ! 6 8 ! Redistribution and use in source and binary forms, with or without -
LMDZ5/trunk/libf/phylmd/cosp/cosp.F90
r1907 r2428 23 23 ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 24 25 !!#include "cosp_defs.h"25 #include "cosp_defs.h" 26 26 MODULE MOD_COSP 27 27 USE MOD_COSP_TYPES 28 28 USE MOD_COSP_SIMULATOR 29 USE mod_phys_lmdz_para 30 USE mod_grid_phy_lmdz 29 USE MOD_COSP_MODIS_SIMULATOR 31 30 IMPLICIT NONE 32 31 … … 37 36 !--------------------- SUBROUTINE COSP --------------------------- 38 37 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 39 SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 40 38 !#ifdef RTTOV 39 !SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 40 !#else 41 SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 42 !#endif 41 43 ! Arguments 42 44 integer,intent(in) :: overlap ! overlap type in SCOPS: 1=max, 2=rand, 3=max/rand … … 50 52 type(cosp_isccp),intent(inout) :: isccp ! Output from ISCCP simulator 51 53 type(cosp_misr),intent(inout) :: misr ! Output from MISR simulator 54 type(cosp_modis),intent(inout) :: modis ! Output from MODIS simulator 55 !#ifdef RTTOV 56 ! type(cosp_rttov),intent(inout) :: rttov ! Output from RTTOV 57 !#endif 52 58 type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator 53 59 type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator … … 59 65 integer :: Niter ! Number of calls to cosp_simulator 60 66 integer :: i_first,i_last ! First and last gridbox to be processed in each iteration 61 integer :: i, j,k,Ni67 integer :: i,Ni 62 68 integer,dimension(2) :: ix,iy 63 69 logical :: reff_zero 64 real :: minv,maxv65 70 real :: maxp,minp 66 integer,dimension(:), save,allocatable :: & ! Dimensions nPoints71 integer,dimension(:),allocatable :: & ! Dimensions nPoints 67 72 seed ! It is recommended that the seed is set to a different value for each model 68 73 ! gridbox it is called on, as it is possible that the choice of the same 69 74 ! seed value every time may introduce some statistical bias in the results, 70 75 ! particularly for low values of NCOL. 71 !$OMP THREADPRIVATE(seed)72 real,dimension(:),allocatable :: rseed ! It is recommended that the seed is set to a different value for each model73 76 ! Types used in one iteration 74 77 type(cosp_gridbox) :: gbx_it … … 78 81 type(cosp_sglidar) :: sglidar_it 79 82 type(cosp_isccp) :: isccp_it 83 type(cosp_modis) :: modis_it 80 84 type(cosp_misr) :: misr_it 85 !#ifdef RTTOV 86 ! type(cosp_rttov) :: rttov_it 87 !#endif 81 88 type(cosp_radarstats) :: stradar_it 82 89 type(cosp_lidarstats) :: stlidar_it 83 84 logical,save :: first_cosp=.TRUE. 85 !$OMP THREADPRIVATE(first_cosp) 86 87 !++++++++++ Dimensions ++++++++++++ 90 91 !++++++++++ Dimensions ++++++++++++ 88 92 Npoints = gbx%Npoints 89 93 Nlevels = gbx%Nlevels 90 94 Nhydro = gbx%Nhydro 95 96 !++++++++++ Depth of model layers ++++++++++++ 97 do i=1,Nlevels-1 98 gbx%dlev(:,i) = gbx%zlev_half(:,i+1) - gbx%zlev_half(:,i) 99 enddo 100 gbx%dlev(:,Nlevels) = 2.0*(gbx%zlev(:,Nlevels) - gbx%zlev_half(:,Nlevels)) 91 101 92 102 !++++++++++ Apply sanity checks to inputs ++++++++++ … … 129 139 ! and reff_zero == .false. Reff use in lidar and set to 0 for radar 130 140 endif 131 ! if ((gbx%use_reff) .and. (reff_zero)) then ! Inconsistent choice. Want to use Reff but not inputs passed132 ! print *, '---------- COSP ERROR ------------'133 ! print *, ''134 ! print *, 'use_reff==.true. but Reff is always zero'135 ! print *, ''136 ! print *, '----------------------------------'137 ! stop138 ! endif139 141 if ((.not. gbx%use_reff) .and. (reff_zero)) then ! No Reff in radar. Default in lidar 140 142 gbx%Reff = DEFAULT_LIDAR_REFF … … 170 172 endif 171 173 172 if (first_cosp) then173 174 ! We base the seed in the decimal part of the surface pressure. 174 allocate(seed(Npoints)) 175 176 allocate(rseed(klon_glo)) 177 CALL gather(gbx%psfc,rseed) 178 call bcast(rseed) 179 ! seed = int(gbx%psfc) ! This is to avoid division by zero when Npoints = 1 175 allocate(seed(Npoints)) 176 seed = int(gbx%psfc) ! This is to avoid division by zero when Npoints = 1 180 177 ! Roj Oct/2008 ... Note: seed value of 0 caused me some problems + I want to 181 178 ! randomize for each call to COSP even when Npoints ==1 182 minp = minval(rseed) 183 maxp = maxval(rseed) 184 185 if (Npoints .gt. 1) THEN 186 seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1 187 else 188 seed=int(gbx%psfc-minp) 189 endif 190 191 deallocate(rseed) 192 first_cosp=.false. 193 endif 194 179 minp = minval(gbx%psfc) 180 maxp = maxval(gbx%psfc) 181 if (Npoints .gt. 1) seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1 182 ! Below it's how it was done in the original implementation of the ISCCP simulator. 183 ! The one above is better for offline data, when you may have packed data 184 ! that subsamples the decimal fraction of the surface pressure. 185 ! if (Npoints .gt. 1) seed=(gbx%psfc-int(gbx%psfc))*1000000 186 187 195 188 if (gbx%Npoints_it >= gbx%Npoints) then ! One iteration gbx%Npoints 196 call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 189 !#ifdef RTTOV 190 ! call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 191 !#else 192 call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 193 !#endif 197 194 else ! Several iterations to save memory 198 195 Niter = gbx%Npoints/gbx%Npoints_it ! Integer division … … 205 202 if (i == 1) then 206 203 ! Allocate types for all but last iteration 207 call construct_cosp_gridbox(gbx%time,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables,gbx%use_gas_abs, & 208 gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels,Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 204 call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, & 205 gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, & 206 Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 209 207 gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, & 210 208 gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, & … … 219 217 call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it) 220 218 call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it) 219 call construct_cosp_modis(cfg, Ni, modis_it) 221 220 call construct_cosp_misr(cfg,Ni,misr_it) 221 !#ifdef RTTOV 222 ! call construct_cosp_rttov(Ni,gbx%nchan,rttov_it) 223 !#endif 222 224 call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it) 223 225 call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it) … … 229 231 call free_cosp_sglidar(sglidar_it) 230 232 call free_cosp_isccp(isccp_it) 233 call free_cosp_modis(modis_it) 231 234 call free_cosp_misr(misr_it) 235 !#ifdef RTTOV 236 ! call free_cosp_rttov(rttov_it) 237 !#endif 232 238 call free_cosp_radarstats(stradar_it) 233 239 call free_cosp_lidarstats(stlidar_it) 234 240 ! Allocate types for iterations 235 call construct_cosp_gridbox(gbx%time,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables,gbx%use_gas_abs, & 236 gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels,Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 241 call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, & 242 gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, & 243 Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 237 244 gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, & 238 245 gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, & … … 250 257 call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it) 251 258 call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it) 259 call construct_cosp_modis(cfg,Ni, modis_it) 252 260 call construct_cosp_misr(cfg,Ni,misr_it) 261 !#ifdef RTTOV 262 ! call construct_cosp_rttov(Ni,gbx%nchan,rttov_it) 263 !#endif 253 264 call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it) 254 265 call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it) … … 263 274 if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar,sglidar_it) 264 275 if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp,isccp_it) 276 if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis,modis_it) 265 277 if (cfg%Lmisr_sim) call cosp_misr_cpsection(ix,iy,misr,misr_it) 278 !#ifdef RTTOV 279 ! if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov,rttov_it) 280 !#endif 266 281 if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar,stradar_it) 267 282 if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar,stlidar_it) 268 print *,'---------ix: ',ix 283 !#ifdef RTTOV 284 ! call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, & 285 ! sglidar_it,isccp_it,misr_it,modis_it,rttov_it,stradar_it,stlidar_it) 286 !#else 269 287 call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, & 270 sglidar_it,isccp_it,misr_it, stradar_it,stlidar_it)271 288 sglidar_it,isccp_it,misr_it,modis_it,stradar_it,stlidar_it) 289 !#endif 272 290 ! --- Copy results to output structures --- 273 ! call cosp_gridbox_cphp(gbx_it,gbx)274 291 ix=(/1,Ni/) 275 292 iy=(/i_first,i_last/) … … 278 295 if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar_it,sglidar) 279 296 if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp_it,isccp) 297 if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis_it,modis) 280 298 if (cfg%Lmisr_sim) call cosp_misr_cpsection(ix,iy,misr_it,misr) 299 !#ifdef RTTOV 300 ! if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov_it,rttov) 301 !#endif 281 302 if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar_it,stradar) 282 303 if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar_it,stlidar) … … 289 310 call free_cosp_sglidar(sglidar_it) 290 311 call free_cosp_isccp(isccp_it) 312 call free_cosp_modis(modis_it) 291 313 call free_cosp_misr(misr_it) 314 !#ifdef RTTOV 315 ! call free_cosp_rttov(rttov_it) 316 !#endif 292 317 call free_cosp_radarstats(stradar_it) 293 318 call free_cosp_lidarstats(stlidar_it) 294 319 endif 320 deallocate(seed) 295 321 296 322 … … 300 326 !--------------------- SUBROUTINE COSP_ITER ---------------------- 301 327 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 302 SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 303 328 !#ifdef RTTOV 329 !SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 330 !#else 331 SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 332 !#endif 304 333 ! Arguments 305 334 integer,intent(in) :: overlap ! overlap type in SCOPS: 1=max, 2=rand, 3=max/rand … … 313 342 type(cosp_isccp),intent(inout) :: isccp ! Output from ISCCP simulator 314 343 type(cosp_misr),intent(inout) :: misr ! Output from MISR simulator 344 type(cosp_modis),intent(inout) :: modis ! Output from MODIS simulator 345 !#ifdef RTTOV 346 ! type(cosp_rttov),intent(inout) :: rttov ! Output from RTTOV 347 !#endif 315 348 type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator 316 349 type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator … … 321 354 integer :: Nlevels ! Number of levels 322 355 integer :: Nhydro ! Number of hydrometeors 323 integer :: Niter ! Number of calls to cosp_simulator324 356 integer :: i,j,k 325 integer :: I_HYDRO 357 integer :: I_HYDRO 326 358 real,dimension(:,:),pointer :: column_frac_out ! Array with one column of frac_out 327 integer,parameter :: scops_debug=0 ! set to non-zero value to print out inputs for debugging in SCOPS328 359 real,dimension(:,:),pointer :: column_prec_out ! Array with one column of prec_frac 360 integer :: scops_debug=0 ! set to non-zero value to print out inputs for debugging in SCOPS 329 361 real,dimension(:, :),allocatable :: cca_scops,ls_p_rate,cv_p_rate, & 330 362 tca_scops ! Cloud cover in each model level (HORIZONTAL gridbox fraction) of total cloud. … … 332 364 real,dimension(:,:),allocatable :: frac_ls,prec_ls,frac_cv,prec_cv ! Cloud/Precipitation fraction in each model level 333 365 ! Levels are from SURFACE to TOA 334 real,dimension(:,:),allocatable :: rho ! (Npoints, Nlevels). Atmospheric dens 366 real,dimension(:,:),allocatable :: rho ! (Npoints, Nlevels). Atmospheric density 335 367 type(cosp_sghydro) :: sghydro ! Subgrid info for hydrometeors en each iteration 336 368 … … 342 374 Nhydro = gbx%Nhydro 343 375 344 345 376 !++++++++++ Climate/NWP mode ++++++++++ 346 377 if (Ncolumns > 1) then … … 411 442 ! Deallocate arrays that will no longer be used 412 443 deallocate(tca_scops,cca_scops,ls_p_rate,cv_p_rate) 413 444 414 445 ! Populate the subgrid arrays 415 446 call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro) … … 420 451 sghydro%mr_hydro(:,k,:,I_LSCLIQ) = gbx%mr_hydro(:,:,I_LSCLIQ) 421 452 sghydro%mr_hydro(:,k,:,I_LSCICE) = gbx%mr_hydro(:,:,I_LSCICE) 422 453 423 454 sghydro%Reff(:,k,:,I_LSCLIQ) = gbx%Reff(:,:,I_LSCLIQ) 424 455 sghydro%Reff(:,k,:,I_LSCICE) = gbx%Reff(:,:,I_LSCICE) 425 sghydro%Reff(:,k,:,I_LSRAIN) = gbx%Reff(:,:,I_LSRAIN) 426 sghydro%Reff(:,k,:,I_LSSNOW) = gbx%Reff(:,:,I_LSSNOW) 427 sghydro%Reff(:,k,:,I_LSGRPL) = gbx%Reff(:,:,I_LSGRPL) 456 457 sghydro%Np(:,k,:,I_LSCLIQ) = gbx%Np(:,:,I_LSCLIQ) 458 sghydro%Np(:,k,:,I_LSCICE) = gbx%Np(:,:,I_LSCICE) 459 428 460 elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV clouds ++++++++ 429 sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ) 430 sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE) 431 432 sghydro%Reff(:,k,:,I_CVCLIQ) = gbx%Reff(:,:,I_CVCLIQ) 433 sghydro%Reff(:,k,:,I_CVCICE) = gbx%Reff(:,:,I_CVCICE) 434 sghydro%Reff(:,k,:,I_CVRAIN) = gbx%Reff(:,:,I_CVRAIN) 435 sghydro%Reff(:,k,:,I_CVSNOW) = gbx%Reff(:,:,I_CVSNOW) 436 end where 461 sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ) 462 sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE) 463 464 sghydro%Reff(:,k,:,I_CVCLIQ) = gbx%Reff(:,:,I_CVCLIQ) 465 sghydro%Reff(:,k,:,I_CVCICE) = gbx%Reff(:,:,I_CVCICE) 466 467 sghydro%Np(:,k,:,I_CVCLIQ) = gbx%Np(:,:,I_CVCLIQ) 468 sghydro%Np(:,k,:,I_CVCICE) = gbx%Np(:,:,I_CVCICE) 469 470 end where 471 column_prec_out => sgx%prec_frac(:,k,:) 472 where ((column_prec_out == 1) .or. (column_prec_out == 3) ) !++++ LS precip ++++ 473 sghydro%Reff(:,k,:,I_LSRAIN) = gbx%Reff(:,:,I_LSRAIN) 474 sghydro%Reff(:,k,:,I_LSSNOW) = gbx%Reff(:,:,I_LSSNOW) 475 sghydro%Reff(:,k,:,I_LSGRPL) = gbx%Reff(:,:,I_LSGRPL) 476 477 sghydro%Np(:,k,:,I_LSRAIN) = gbx%Np(:,:,I_LSRAIN) 478 sghydro%Np(:,k,:,I_LSSNOW) = gbx%Np(:,:,I_LSSNOW) 479 sghydro%Np(:,k,:,I_LSGRPL) = gbx%Np(:,:,I_LSGRPL) 480 elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3)) !++++ CONV precip ++++ 481 sghydro%Reff(:,k,:,I_CVRAIN) = gbx%Reff(:,:,I_CVRAIN) 482 sghydro%Reff(:,k,:,I_CVSNOW) = gbx%Reff(:,:,I_CVSNOW) 483 484 sghydro%Np(:,k,:,I_CVRAIN) = gbx%Np(:,:,I_CVRAIN) 485 sghydro%Np(:,k,:,I_CVSNOW) = gbx%Np(:,:,I_CVSNOW) 486 end where 437 487 !--------- Precip ------- 438 488 if (.not. gbx%use_precipitation_fluxes) then … … 442 492 sghydro%mr_hydro(:,k,:,I_LSGRPL) = gbx%mr_hydro(:,:,I_LSGRPL) 443 493 elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV Precipitation ++++++++ 444 sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN) 445 sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW) 494 sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN) 495 sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW) 446 496 end where 447 497 endif … … 486 536 487 537 if (gbx%use_precipitation_fluxes) then 488 ! convert precipitation flux into mixing ratio 489 call pf_to_mr(Npoints,Nlevels,Ncolumns,gbx%rain_ls,gbx%snow_ls,gbx%grpl_ls, & 490 gbx%rain_cv,gbx%snow_cv,sgx%prec_frac,gbx%p,gbx%T, & 491 sghydro%mr_hydro(:,:,:,I_LSRAIN),sghydro%mr_hydro(:,:,:,I_LSSNOW),sghydro%mr_hydro(:,:,:,I_LSGRPL), & 492 sghydro%mr_hydro(:,:,:,I_CVRAIN),sghydro%mr_hydro(:,:,:,I_CVSNOW)) 493 endif 538 539 #ifdef MMF_V3p5_TWO_MOMENT 540 541 write(*,*) 'Precipitation Flux to Mixing Ratio conversion not (yet?) supported ', & 542 'for MMF3.5 Two Moment Microphysics' 543 stop 544 #else 545 ! Density 546 allocate(rho(Npoints,Nlevels)) 547 I_HYDRO = I_LSRAIN 548 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., & 549 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 550 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 551 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 552 gbx%rain_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 553 I_HYDRO = I_LSSNOW 554 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., & 555 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 556 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 557 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 558 gbx%snow_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 559 I_HYDRO = I_CVRAIN 560 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., & 561 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 562 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 563 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 564 gbx%rain_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 565 I_HYDRO = I_CVSNOW 566 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., & 567 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 568 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 569 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 570 gbx%snow_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 571 I_HYDRO = I_LSGRPL 572 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., & 573 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 574 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 575 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 576 gbx%grpl_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 577 if(allocated(rho)) deallocate(rho) 578 #endif 579 580 endif 494 581 !++++++++++ CRM mode ++++++++++ 495 582 else 583 call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro) 496 584 sghydro%mr_hydro(:,1,:,:) = gbx%mr_hydro 497 585 sghydro%Reff(:,1,:,:) = gbx%Reff 586 sghydro%Np(:,1,:,:) = gbx%Np ! added by Roj with Quickbeam V3.0 587 498 588 !--------- Clouds ------- 499 589 where ((gbx%dtau_s > 0.0)) … … 502 592 endif ! Ncolumns > 1 503 593 504 505 594 !++++++++++ Simulator ++++++++++ 506 call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,stradar,stlidar) 595 !#ifdef RTTOV 596 ! call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 597 !#else 598 call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 599 !#endif 507 600 508 601 ! Deallocate subgrid arrays -
LMDZ5/trunk/libf/phylmd/cosp/cosp_constants.F90
r2080 r2428 28 28 ! Jul 2008 - A. Bodas-Salcedo - Added definitions of ISCCP axes 29 29 ! Oct 2008 - H. Chepfer - Added PARASOL_NREFL 30 ! Jun 2010 - R. Marchand - Modified to support quickbeam V3, added ifdef for hydrometeor definitions 31 ! 30 32 ! 31 33 ! 34 35 #include "cosp_defs.h" 32 36 MODULE MOD_COSP_CONSTANTS 37 33 38 use netcdf, only: nf90_fill_real 34 39 IMPLICIT NONE 35 40 41 character(len=32) :: COSP_VERSION='COSP v1.4' 42 36 43 ! Indices to address arrays of LS and CONV hydrometeors 37 44 integer,parameter :: I_LSCLIQ = 1 … … 44 51 integer,parameter :: I_CVSNOW = 8 45 52 integer,parameter :: I_LSGRPL = 9 46 53 47 54 ! Missing value 48 !! real,parameter :: R_UNDEF = -1.0E30 49 ! real,parameter :: R_UNDEF = 9.96921e+36 50 real,parameter :: R_UNDEF = nf90_fill_real 55 real,parameter :: R_UNDEF = -1.0E30 56 ! real,parameter :: R_UNDEF = nf90_fill_real 51 57 52 58 ! Number of possible output variables 53 integer,parameter :: N_OUT_LIST = 27 59 integer,parameter :: N_OUT_LIST = 63 60 integer,parameter :: N3D = 8 61 integer,parameter :: N2D = 14 62 integer,parameter :: N1D = 40 63 54 64 ! Value for forward model result from a level that is under the ground 55 65 real,parameter :: R_GROUND = -1.0E20 … … 58 68 integer, parameter :: I_LSC = 1, & ! Large-scale clouds 59 69 I_CVC = 2 ! Convective clouds 60 70 71 ! Timing of different simulators, including statistics module 72 integer, parameter :: N_SIMULATORS = 7 73 integer,parameter :: I_RADAR = 1 74 integer,parameter :: I_LIDAR = 2 75 integer,parameter :: I_ISCCP = 3 76 integer,parameter :: I_MISR = 4 77 integer,parameter :: I_MODIS = 5 78 integer,parameter :: I_RTTOV = 6 79 integer,parameter :: I_STATS = 7 80 character*32, dimension(N_SIMULATORS) :: SIM_NAME = (/'Radar','Lidar','ISCCP','MISR ','MODIS','RTTOV','Stats'/) 81 integer,dimension(N_SIMULATORS) :: tsim 82 data tsim/N_SIMULATORS*0.0/ 83 61 84 !--- Radar constants 62 85 ! CFAD constants … … 67 90 real,parameter :: CFAD_ZE_WIDTH = 5.0 ! Bin width (dBZe) 68 91 69 92 70 93 !--- Lidar constants 71 94 ! CFAD constants … … 73 96 integer,parameter :: DPOL_BINS = 6 74 97 real,parameter :: LIDAR_UNDEF = 999.999 98 75 99 ! Other constants 76 100 integer,parameter :: LIDAR_NCAT = 4 77 101 integer,parameter :: PARASOL_NREFL = 5 ! parasol 78 real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/0.0, 20.0, 40.0, 6.0, 80.0/) 79 ! real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/1.0, 2.0, 3.0, 4.0, 5.0/) 102 real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/0.0, 20.0, 40.0, 60.0, 80.0/) 80 103 real,parameter :: DEFAULT_LIDAR_REFF = 30.0e-6 ! Default lidar effective radius 81 104 105 integer,parameter :: LIDAR_NTEMP = 40 106 real,parameter,dimension(LIDAR_NTEMP) :: LIDAR_PHASE_TEMP=(/-91.5,-88.5,-85.5,-82.5,-79.5,-76.5,-73.5,-70.5,-67.5,-64.5, & 107 -61.5,-58.5,-55.5,-52.5,-49.5,-46.5,-43.5,-40.5,-37.5,-34.5, & 108 -31.5,-28.5,-25.5,-22.5,-19.5,-16.5,-13.5,-10.5, -7.5, -4.5, & 109 -1.5, 1.5, 4.5, 7.5, 10.5, 13.5, 16.5, 19.5, 22.5, 25.5/) 110 real,parameter,dimension(2,LIDAR_NTEMP) :: LIDAR_PHASE_TEMP_BNDS=reshape(source=(/-273.15,-90.,-90.,-87.,-87.,-84.,-84.,-81.,-81.,-78., & 111 -78.,-75.,-75.,-72.,-72.,-69.,-69.,-66.,-66.,-63., & 112 -63.,-60.,-60.,-57.,-57.,-54.,-54.,-51.,-51.,-48., & 113 -48.,-45.,-45.,-42.,-42.,-39.,-39.,-36.,-36.,-33., & 114 -33.,-30.,-30.,-27.,-27.,-24.,-24.,-21.,-21.,-18., & 115 -18.,-15.,-15.,-12.,-12., -9., -9., -6., -6., -3., & 116 -3., 0., 0., 3., 3., 6., 6., 9., 9., 12., & 117 12., 15., 15., 18., 18., 21., 21., 24., 24.,100./),shape=(/2,40/)) 118 82 119 !--- MISR constants 83 120 integer,parameter :: MISR_N_CTH = 16 … … 85 122 !--- RTTOV constants 86 123 integer,parameter :: RTTOV_MAX_CHANNELS = 20 87 124 88 125 ! ISCCP tau-Pc axes 89 real,parameter,dimension(7) :: ISCCP_TAU = (/0.15, 0.80, 2.45, 6.5, 16.2, 41.5, 50000.0/)126 real,parameter,dimension(7) :: ISCCP_TAU = (/0.15, 0.80, 2.45, 6.5, 16.2, 41.5, 100.0/) 90 127 real,parameter,dimension(2,7) :: ISCCP_TAU_BNDS = reshape(source=(/0.0,0.3,0.3,1.30,1.30,3.6,3.6,9.4, & 91 128 9.4,23.0,23.0,60.0,60.0,100000.0/), shape=(/2,7/)) 92 93 ! real,parameter,dimension(7) :: ISCCP_PC = (/9000., 24500., 37500., 50000., 62000., 74000., 90000./) 94 ! real,parameter,dimension(2,7) :: ISCCP_PC_BNDS = reshape(source=(/0.0,18000.0,18000.0,31000.0,31000.0, & 95 ! 44000.0,44000.0,56000.0,56000.0,68000.0,68000.0,80000.0,80000.0,100000.0/), shape=(/2,7/)) 96 129 97 130 real,parameter,dimension(7) :: ISCCP_PC = (/90000., 74000., 62000., 50000., 37500., 24500., 9000./) 98 131 real,parameter,dimension(2,7) :: ISCCP_PC_BNDS = reshape(source=(/100000.0,80000.0,80000.0,68000.0,68000.0,56000.0 & 99 132 ,56000.0,44000.0,44000.0,31000.0,31000.0,18000.0,18000.0,0.0/), shape=(/2,7/)) 100 101 real,parameter,dimension(MISR_N_CTH) :: MISR_CTH = (/ 0., 0.25, 0.75, 1.25, 1.75, 2.25, 2.75, 3.5, &133 134 real,parameter,dimension(MISR_N_CTH) :: MISR_CTH = 1000.0*(/ 0., 0.25, 0.75, 1.25, 1.75, 2.25, 2.75, 3.5, & 102 135 4.5, 6., 8., 10., 12., 14.5, 16., 18./) 103 real,parameter,dimension(2,MISR_N_CTH) :: MISR_CTH_BNDS = reshape(source=(/ &136 real,parameter,dimension(2,MISR_N_CTH) :: MISR_CTH_BNDS = 1000.0*reshape(source=(/ & 104 137 -99.0, 0.0, 0.0, 0.5, 0.5, 1.0, 1.0, 1.5, & 105 138 1.5, 2.0, 2.0, 2.5, 2.5, 3.0, 3.0, 4.0, & … … 107 140 11.0, 13.0, 13.0, 15.0, 15.0, 17.0, 17.0, 99.0/), & 108 141 shape=(/2,MISR_N_CTH/)) 109 110 ! Table hclass for quickbeam 142 143 144 ! 145 ! The following code was modifed by Roj with implementation of quickbeam V3 146 ! (1) use ifdef to support more than one microphyscis scheme 147 ! (2) added constants microphysic_scheme_name, LOAD_scale_LUTs, and SAVE_scale_LUTs 148 ! 149 150 ! directory where LUTs will be stored 151 character*120 :: RADAR_SIM_LUT_DIRECTORY = './' 152 153 #ifdef MMF_V3_SINGLE_MOMENT 154 155 ! 156 ! Table hclass for quickbeam to support one-moment (bulk) microphysics scheme used by MMF V3.0 & V3.5 157 ! 158 159 ! 160 ! NOTE: if ANY value in this section of code is changed, the existing LUT 161 ! (i.e., the associated *.dat file) MUST be deleted so that a NEW 162 ! LUT will be created !!! 163 ! 164 character*120 :: RADAR_SIM_MICROPHYSICS_SCHEME_NAME = 'MMF_v3_single_moment' 165 166 logical :: RADAR_SIM_LOAD_scale_LUTs_flag = .false. 167 logical :: RADAR_SIM_UPDATE_scale_LUTs_flag = .false. 111 168 integer,parameter :: N_HYDRO = 9 112 real :: HCLASS_TYPE(N_HYDRO),HCLASS_COL(N_HYDRO),HCLASS_PHASE(N_HYDRO), & 113 HCLASS_CP(N_HYDRO),HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO) 114 real :: HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), & 169 170 integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO) 171 172 real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), & 173 HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), & 115 174 HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO) 116 data HCLASS_TYPE/5,1,2,2,5,1,2,2,2/ 117 data HCLASS_COL/1,2,3,4,5,6,7,8,9/ 118 data HCLASS_PHASE/0,1,0,1,0,1,0,1,1/ 119 data HCLASS_CP/0,0,1,1,0,0,1,1,1/ 120 data HCLASS_DMIN/-1,-1,-1,-1,-1,-1,-1,-1,-1/ 121 data HCLASS_DMAX/-1,-1,-1,-1,-1,-1,-1,-1,-1/ 122 data HCLASS_APM/524,110.8,524,-1,524,110.8,524,-1,-1/ 123 data HCLASS_BPM/3,2.91,3,-1,3,2.91,3,-1,-1/ 124 data HCLASS_RHO/-1,-1,-1,100,-1,-1,-1,100,400/ 125 data HCLASS_P1/-1,-1,8000000.,3000000.,-1,-1,8000000.,3000000.,4000000./ 126 data HCLASS_P2/6,40,-1,-1,6,40,-1,-1,-1/ 127 data HCLASS_P3/0.3,2,-1,-1,0.3,2,-1,-1,-1/ 128 129 130 175 176 ! HCLASS_CP is not used in the version of Quickbeam included in COSP 177 ! LSL LSI LSR LSS CVL CVI CVR CVS LSG 178 data HCLASS_TYPE/ 5, 1, 2, 2, 5, 1, 2, 2, 2/ 179 data HCLASS_PHASE/ 0, 1, 0, 1, 0, 1, 0, 1, 1/ 180 data HCLASS_DMIN/ -1, -1, -1, -1, -1, -1, -1, -1, -1/ 181 data HCLASS_DMAX/ -1, -1, -1, -1, -1, -1, -1, -1, -1/ 182 data HCLASS_APM/ 524, 110.8, 524, -1, 524, 110.8, 524, -1, -1/ 183 data HCLASS_BPM/ 3, 2.91, 3, -1, 3, 2.91, 3, -1, -1/ 184 data HCLASS_RHO/ -1, -1, -1, 100, -1, -1, -1, 100, 400/ 185 data HCLASS_P1/ -1, -1, 8.e6, 3.e6, -1, -1, 8.e6, 3.e6, 4.e6/ 186 data HCLASS_P2/ 6, 40, -1, -1, 6, 40, -1, -1, -1/ 187 data HCLASS_P3/ 0.3, 2, -1, -1, 0.3, 2, -1, -1, -1/ 188 189 ! NOTES on HCLASS variables 190 ! 191 ! TYPE - Set to 192 ! 1 for modified gamma distribution, 193 ! 2 for exponential distribution, 194 ! 3 for power law distribution, 195 ! 4 for monodisperse distribution, 196 ! 5 for lognormal distribution. 197 198 ! PHASE - Set to 0 for liquid, 1 for ice. 199 200 ! DMIN - The minimum drop size for this class (micron), ignored for monodisperse. 201 ! DMAX - The maximum drop size for this class (micron), ignored for monodisperse. 202 ! Important note: The settings for DMIN and DMAX are 203 ! ignored in the current version for all distributions except for power 204 ! law. Except when the power law distribution is used, particle size 205 ! is fixed to vary from zero to infinity, a restriction that is expected 206 ! to be lifted in future versions. A placeholder must still be specified 207 ! for each. 208 209 ! Density of particles is given by apm*D^bpm or a fixed value rho. ONLY specify ONE of these two!! 210 ! APM - The alpha_m coefficient in equation (1) (kg m**-beta_m ) 211 ! BPM - The beta_m coefficient in equation (1), see section 4.1. 212 213 ! RHO - Hydrometeor density (kg m-3 ). 214 215 ! P1, P2, P3 - are default distribution parameters that depend on the type 216 ! of distribution (see quickmbeam documentation for more information) 217 ! 218 ! Modified Gamma (must set P3 and one of P1 or P2) 219 ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 ), where 220 ! rho_a is the density of air in the radar volume. 221 ! P2 - Set to the particle mean diameter D (micron). 222 ! P3 - Set to the distribution width nu. 223 ! 224 ! Exponetial (set one of) 225 ! P1 - Set to a constant intercept parameter N0 (m-4). 226 ! P2 - Set to a constant lambda (micron-1). 227 ! 228 ! Power Law 229 ! P1 - Set this to the value of a constant power law parameter br 230 ! 231 ! Monodisperse 232 ! P1 - Set to a constant diameter D0 (micron) = Re. 233 ! 234 ! Log-normal (must set P3 and one of P1 or P2) 235 ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 ) 236 ! P2 - Set to the geometric mean particle radius rg (micron). 237 ! P3 - Set to the natural logarithm of the geometric standard deviation. 238 ! 239 240 241 real,dimension(N_HYDRO) :: N_ax,N_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma_1,gamma_2,gamma_3,gamma_4 242 243 ! Microphysical settings for the precipitation flux to mixing ratio conversion 244 ! LSL LSI LSR LSS CVL CVI CVR CVS LSG 245 data N_ax/ -1., -1., 8.e6, 3.e6, -1., -1., 8.e6, 3.e6, 4.e6/ 246 data N_bx/ -1., -1., 0.0, 0.0, -1., -1., 0.0, 0.0, 0.0/ 247 data alpha_x/ -1., -1., 0.0, 0.0, -1., -1., 0.0, 0.0, 0.0/ 248 data c_x/ -1., -1., 842.0, 4.84, -1., -1., 842.0, 4.84, 94.5/ 249 data d_x/ -1., -1., 0.8, 0.25, -1., -1., 0.8, 0.25, 0.5/ 250 data g_x/ -1., -1., 0.5, 0.5, -1., -1., 0.5, 0.5, 0.5/ 251 data a_x/ -1., -1., 524.0, 52.36, -1., -1., 524.0, 52.36, 209.44/ 252 data b_x/ -1., -1., 3.0, 3.0, -1., -1., 3.0, 3.0, 3.0/ 253 data gamma_1/ -1., -1., 17.83725, 8.284701, -1., -1., 17.83725, 8.284701, 11.63230/ 254 data gamma_2/ -1., -1., 6.0, 6.0, -1., -1., 6.0, 6.0, 6.0/ 255 data gamma_3/ -1., -1., 2.0, 2.0, -1., -1., 2.0, 2.0, 2.0/ 256 data gamma_4/ -1., -1., 6.0, 6.0, -1., -1., 6.0, 6.0, 6.0/ 257 258 259 260 #endif 261 262 263 #ifdef MMF_V3p5_TWO_MOMENT 264 265 ! 266 ! Table hclass for quickbeam to support two-moment "morrison" microphysics scheme used by V3.5 (SAM 6.8) 267 ! 268 ! This Number concentriation Np in [1/kg] MUST be input to COSP/radar simulator 269 ! 270 ! NOTE: Be sure to check that the ice-density (rho) set it this tables matches what you used 271 ! 272 273 ! 274 ! NOTE: if ANY value in this section of code is changed, the existing LUT 275 ! (i.e., the associated *.dat file) MUST be deleted so that a NEW 276 ! LUT will be created !!! 277 ! 278 character*120 :: RADAR_SIM_MICROPHYSICS_SCHEME_NAME = 'MMF_v3.5_two_moment' 279 280 logical :: RADAR_SIM_LOAD_scale_LUTs_flag = .false. 281 logical :: RADAR_SIM_UPDATE_scale_LUTs_flag = .false. 282 283 integer,parameter :: N_HYDRO = 9 284 285 integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO) 286 287 real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), & 288 HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), & 289 HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO) 290 291 ! HCLASS_CP is not used in the version of Quickbeam included in COSP 292 ! LSL LSI LSR LSS CVL CVI CVR CVS LSG 293 data HCLASS_TYPE/ 1, 1, 1, 1, 1, 1, 1, 1, 1/ 294 data HCLASS_PHASE/ 0, 1, 0, 1, 0, 1, 0, 1, 1/ 295 data HCLASS_DMIN/ -1, -1, -1, -1, -1, -1, -1, -1, -1/ 296 data HCLASS_DMAX/ -1, -1, -1, -1, -1, -1, -1, -1, -1/ 297 data HCLASS_APM/ 524, -1, 524, -1, 524, -1, 524, -1, -1/ 298 data HCLASS_BPM/ 3, -1, 3, -1, 3, -1, 3, -1, -1/ 299 data HCLASS_RHO/ -1, 500, -1, 100, -1, 500, -1, 100, 900/ 300 data HCLASS_P1/ -1, -1, -1, -1, -1, -1, -1, -1, -1/ 301 data HCLASS_P2/ -1, -1, -1, -1, -1, -1, -1, -1, -1/ 302 data HCLASS_P3/ -2, 1, 1, 1, -2, 1, 1, 1, 1/ 303 ! Note: value of "-2" for HCLASS_P3 uses martin 1994 parameteriztion of gamma function width with Number concentration 304 #endif 305 131 306 END MODULE MOD_COSP_CONSTANTS -
LMDZ5/trunk/libf/phylmd/cosp/cosp_isccp_simulator.F90
r1907 r2428 1 1 ! (c) British Crown Copyright 2008, the Met Office. 2 2 ! All rights reserved. 3 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 4 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_isccp_simulator.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 42 44 43 45 ! Local variables 44 integer :: i,Nlevels,Npoints46 integer :: Nlevels,Npoints 45 47 real :: pfull(gbx%Npoints, gbx%Nlevels) 46 48 real :: phalf(gbx%Npoints, gbx%Nlevels + 1) … … 84 86 y%fq_isccp(:,:,:) = y%fq_isccp(:,:,7:1:-1) 85 87 86 ! Change boxptop from hPa to Pa. This avoids using UDUNITS in CMOR 87 ! y%boxptop = y%boxptop*100.0 88 88 89 89 ! Check if there is any value slightly greater than 1 90 90 where ((y%totalcldarea > 1.0-1.e-5) .and. (y%totalcldarea < 1.0+1.e-5)) -
LMDZ5/trunk/libf/phylmd/cosp/cosp_lidar.F90
r1907 r2428 1 1 ! (c) British Crown Copyright 2008, the Met Office. 2 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_lidar.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 29 31 ! Call lidar_simulator changed (lsca, gbx%cca and depol removed; 30 32 ! frac_out changed in sgx%frac_out) 33 ! Jun 2011 - G. Cesana - Added betaperp_tot argument 31 34 ! 32 35 ! … … 43 46 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 44 47 SUBROUTINE COSP_LIDAR(gbx,sgx,sghydro,y) 45 48 46 49 ! Arguments 47 50 type(cosp_gridbox),intent(in) :: gbx ! Gridbox info … … 49 52 type(cosp_sghydro),intent(in) :: sghydro ! Subgrid info for hydrometeors 50 53 type(cosp_sglidar),intent(inout) :: y ! Subgrid output 51 54 52 55 ! Local variables 53 56 integer :: i 54 57 real :: presf(sgx%Npoints, sgx%Nlevels + 1) 55 real :: frac_out(sgx%Npoints, sgx%Nlevels)56 58 real,dimension(sgx%Npoints, sgx%Nlevels) :: lsca,mr_ll,mr_li,mr_cl,mr_ci 57 59 real,dimension(sgx%Npoints, sgx%Nlevels) :: beta_tot,tau_tot 60 real,dimension(sgx%Npoints, sgx%Nlevels) :: betaperp_tot 58 61 real,dimension(sgx%Npoints, PARASOL_NREFL) :: refle 59 60 62 61 63 presf(:,1:sgx%Nlevels) = gbx%ph 62 64 presf(:,sgx%Nlevels + 1) = 0.0 63 ! presf(:,sgx%Nlevels + 1) = gbx%p(:,sgx%Nlevels) - (presf(:,sgx%Nlevels) - gbx%p(:,sgx%Nlevels))64 65 lsca = gbx%tca-gbx%cca 65 66 do i=1,sgx%Ncolumns … … 69 70 mr_cl(:,:) = sghydro%mr_hydro(:,i,:,I_CVCLIQ) 70 71 mr_ci(:,:) = sghydro%mr_hydro(:,i,:,I_CVCICE) 71 frac_out(:,:) = sgx%frac_out(:,i,:) 72 call lidar_simulator(sgx%Npoints, sgx%Nlevels, 4 & 73 , PARASOL_NREFL, LIDAR_UNDEF & 74 , gbx%p, presf, gbx%T & 75 , mr_ll, mr_li, mr_cl, mr_ci & 76 , gbx%Reff(:,:,I_LSCLIQ), gbx%Reff(:,:,I_LSCICE), gbx%Reff(:,:,I_CVCLIQ), gbx%Reff(:,:,I_CVCICE) & 77 , frac_out, gbx%lidar_ice_type, y%beta_mol, beta_tot, tau_tot & 78 , refle ) ! reflectance 79 72 call lidar_simulator(sgx%Npoints, sgx%Nlevels, 4, PARASOL_NREFL, LIDAR_UNDEF & 73 , gbx%p, presf, gbx%T, mr_ll, mr_li, mr_cl, mr_ci & 74 , gbx%Reff(:,:,I_LSCLIQ), gbx%Reff(:,:,I_LSCICE) & 75 , gbx%Reff(:,:,I_CVCLIQ), gbx%Reff(:,:,I_CVCICE) & 76 , gbx%lidar_ice_type, y%beta_mol, beta_tot & 77 , betaperp_tot, tau_tot, refle ) 78 79 y%betaperp_tot(:,i,:) = betaperp_tot(:,:) 80 80 y%beta_tot(:,i,:) = beta_tot(:,:) 81 81 y%tau_tot(:,i,:) = tau_tot(:,:) -
LMDZ5/trunk/libf/phylmd/cosp/cosp_misr_simulator.F90
r1907 r2428 1 1 ! (c) British Crown Copyright 2008, the Met Office. 2 2 ! All rights reserved. 3 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 4 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_misr_simulator.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 48 50 49 51 ! Local variables 50 integer :: i,Nlevels,Npoints52 integer :: Nlevels,Npoints 51 53 real :: dtau_s(gbx%Npoints, gbx%Nlevels) 52 54 real :: dtau_c(gbx%Npoints, gbx%Nlevels) … … 58 60 ! zfull(npoints,1) is top level of model 59 61 ! zfull(npoints,nlev) is bottom level of model 60 real :: phy_t0p1_mean_ztop ! mean cloud top height(m) of 0.1 tau treshold61 real :: fq_phy_t0p1_TAU_v_CTH(7,16)62 62 63 63 64 64 Nlevels = gbx%Nlevels 65 65 Npoints = gbx%Npoints … … 73 73 74 74 call MISR_simulator(gbx%npoints,gbx%nlevels,gbx%ncolumns,& 75 sunlit,zfull,at,dtau_s,dtau_c,frac_out, &75 sunlit,zfull,at,dtau_s,dtau_c,frac_out, R_UNDEF, & 76 76 y%fq_MISR,y%MISR_dist_model_layertops,y%MISR_meanztop,y%MISR_cldarea) 77 77 -
LMDZ5/trunk/libf/phylmd/cosp/cosp_output_mod.F90
r2367 r2428 8 8 USE MOD_COSP_CONSTANTS 9 9 USE MOD_COSP_TYPES 10 use MOD_COSP_Modis_Simulator, only : cosp_modis 10 11 11 12 ! cosp_output_mod … … 15 16 INTEGER, DIMENSION(3), SAVE :: cosp_nidfiles 16 17 !$OMP THREADPRIVATE(cosp_outfilekeys, cosp_nidfiles) 17 INTEGER, DIMENSION(3), SAVE :: nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp18 INTEGER, DIMENSION(3), SAVE :: nhoricosp,nvert,nvertmcosp,nvertcol,nvertisccp,nvertp,nverttemp,nvertmisr 18 19 REAL, DIMENSION(3), SAVE :: zoutm_cosp 19 !$OMP THREADPRIVATE(nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp, zoutm_cosp )20 !$OMP THREADPRIVATE(nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp, zoutm_cosp, nverttemp, nvertmisr) 20 21 REAL, SAVE :: zdtimemoy_cosp 21 22 !$OMP THREADPRIVATE(zdtimemoy_cosp) … … 33 34 CHARACTER(len=20),DIMENSION(3) :: cosp_typeecrit !!! Operation (ave, inst, ...) 34 35 END TYPE ctrl_outcosp 36 35 37 ! CALIPSO vars 36 38 TYPE(ctrl_outcosp), SAVE :: o_cllcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 37 "cllcalipso", "Lidar Low-level Cloud Fraction", " 1", (/ ('', i=1, 3) /))39 "cllcalipso", "Lidar Low-level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 38 40 TYPE(ctrl_outcosp), SAVE :: o_clmcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 39 "clmcalipso", "Lidar Mid-level Cloud Fraction", " 1", (/ ('', i=1, 3) /))41 "clmcalipso", "Lidar Mid-level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 40 42 TYPE(ctrl_outcosp), SAVE :: o_clhcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 41 "clhcalipso", "Lidar Hight-level Cloud Fraction", " 1", (/ ('', i=1, 3) /))43 "clhcalipso", "Lidar Hight-level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 42 44 TYPE(ctrl_outcosp), SAVE :: o_cltcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 43 "cltcalipso", "Lidar Total Cloud Fraction", " 1", (/ ('', i=1, 3) /))45 "cltcalipso", "Lidar Total Cloud Fraction", "%", (/ ('', i=1, 3) /)) 44 46 TYPE(ctrl_outcosp), SAVE :: o_clcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 45 "clcalipso", "Lidar Cloud Fraction (532 nm)", " 1", (/ ('', i=1, 3) /))47 "clcalipso", "Lidar Cloud Fraction (532 nm)", "%", (/ ('', i=1, 3) /)) 46 48 TYPE(ctrl_outcosp), SAVE :: o_cfad_lidarsr532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), & 47 49 "cfad_lidarsr532", "Lidar Scattering Ratio CFAD (532 nm)", "1", (/ ('', i=1, 3) /)) … … 56 58 TYPE(ctrl_outcosp), SAVE :: o_beta_mol532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), & 57 59 "beta_mol532", "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", (/ ('', i=1, 3) /)) 60 !! AI 11 2015 61 TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 62 "cllcalipsoice", "CALIPSO Ice-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 63 TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 64 "cllcalipsoliq", "CALIPSO Liq-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 65 TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 66 "clmcalipsoice", "CALIPSO Ice-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 67 TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 68 "clmcalipsoliq", "CALIPSO Liq-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 69 TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 70 "clhcalipsoice", "CALIPSO Ice-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 71 TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 72 "clhcalipsoliq", "CALIPSO Liq-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 73 TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 74 "cltcalipsoice", "CALIPSO Ice-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 75 TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 76 "cltcalipsoliq", "CALIPSO Liq-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 77 TYPE(ctrl_outcosp), SAVE :: o_cllcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 78 "cllcalipsoun", "CALIPSO Undefined-Phase Low Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 79 TYPE(ctrl_outcosp), SAVE :: o_clmcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 80 "clmcalipsoun", "CALIPSO Undefined-Phase Mid Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 81 TYPE(ctrl_outcosp), SAVE :: o_clhcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 82 "clhcalipsoun", "CALIPSO Undefined-Phase High Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 83 TYPE(ctrl_outcosp), SAVE :: o_cltcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 84 "cltcalipsoun", "CALIPSO Undefined-Phase Tot Level Cloud Fraction", "%", (/ ('', i=1, 3) /)) 85 TYPE(ctrl_outcosp), SAVE :: o_clcalipsoice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 86 "clcalipsoice", "Lidar Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /)) 87 TYPE(ctrl_outcosp), SAVE :: o_clcalipsoliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 88 "clcalipsoliq", "Lidar Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /)) 89 TYPE(ctrl_outcosp), SAVE :: o_clcalipsoun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 90 "clcalipsoun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /)) 91 TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpice = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 92 "clcalipsotmpice", "Lidar Ice-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /)) 93 TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpliq = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 94 "clcalipsotmpliq", "Lidar Liq-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /)) 95 TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmpun = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 96 "clcalipsotmpun", "Lidar Undef-Phase Cloud Fraction", "%", (/ ('', i=1, 3) /)) 97 TYPE(ctrl_outcosp), SAVE :: o_clcalipsotmp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 98 "clcalipsotmp", "Lidar Cloud Fraction", "%", (/ ('', i=1, 3) /)) 99 100 ! Radar Cloudsat 101 TYPE(ctrl_outcosp), SAVE :: o_cfadDbze94 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 102 "cfadDbze94", "CloudSat Radar Reflectivity CFAD", "%", (/ ('', i=1, 3) /)) 103 TYPE(ctrl_outcosp), SAVE :: o_dbze94 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 104 "dbze94", "CloudSat Radar Reflectivity", "%", (/ ('', i=1, 3) /)) 105 106 ! Calipso + Cloudsat 107 TYPE(ctrl_outcosp), SAVE :: o_clcalipso2 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 108 "clcalipso2", "CALIPSO Cloud Fraction Undetected by CloudSat", "1", (/ ('', i=1, 3) /)) 109 58 110 ! ISCCP vars 59 111 TYPE(ctrl_outcosp), SAVE :: o_sunlit = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & … … 80 132 by the ISCCP Simulator","K", (/ ('', i=1, 3) /)) 81 133 134 ! MISR simulator 135 TYPE(ctrl_outcosp), SAVE :: o_clMISR = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 136 "clMISR", "Cloud Fraction as Calculated by the MISR Simulator","1", (/ ('', i=1, 3) /)) 137 138 ! MODIS simulator 139 TYPE(ctrl_outcosp), SAVE :: o_cllmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 140 "cllmodis", "MODIS Low-level Cloud Fraction", "1", (/ ('', i=1, 3) /)) 141 TYPE(ctrl_outcosp), SAVE :: o_clmmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 142 "clmmodis", "MODIS Mid-level Cloud Fraction", "1", (/ ('', i=1, 3) /)) 143 TYPE(ctrl_outcosp), SAVE :: o_clhmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 144 "clhmodis", "MODIS Hight-level Cloud Fraction", "1", (/ ('', i=1, 3) /)) 145 TYPE(ctrl_outcosp), SAVE :: o_cltmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 146 "cltmodis", "MODIS Total Cloud Fraction", "1", (/ ('', i=1, 3) /)) 147 TYPE(ctrl_outcosp), SAVE :: o_clwmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 148 "clwmodis", "MODIS Cloud Fraction water mean", "1", (/ ('', i=1, 3) /)) 149 TYPE(ctrl_outcosp), SAVE :: o_climodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 150 "climodis", "MODIS Cloud Fraction ice mean", "1", (/ ('', i=1, 3) /)) 151 TYPE(ctrl_outcosp), SAVE :: o_tautmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 152 "tautmodis", "MODIS Optical_Thickness_Total_Mean", "1", (/ ('', i=1, 3) /)) 153 TYPE(ctrl_outcosp), SAVE :: o_tauwmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 154 "tauwmodis", "MODIS Optical_Thickness_Water_Mean", "1", (/ ('', i=1, 3) /)) 155 TYPE(ctrl_outcosp), SAVE :: o_tauimodis= ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 156 "tauimodis", "MODIS Optical_Thickness_Ice_Mean", "1", (/ ('', i=1, 3) /)) 157 TYPE(ctrl_outcosp), SAVE :: o_tautlogmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 158 "tautlogmodis", "MODIS Optical_Thickness_Total_logMean", "1", (/ ('', i=1, 3) /)) 159 TYPE(ctrl_outcosp), SAVE :: o_tauwlogmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 160 "tauwlogmodis", "MODIS Optical_Thickness_Water_logMean", "1", (/ ('', i=1, 3) /)) 161 TYPE(ctrl_outcosp), SAVE :: o_tauilogmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 162 "tauilogmodis", "MODIS Optical_Thickness_Ice_logMean", "1", (/ ('', i=1, 3) /)) 163 TYPE(ctrl_outcosp), SAVE :: o_reffclwmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 164 "reffclwmodis", "Modis Cloud_Particle_Size_Water_Mean", "m", (/ ('', i=1, 3) /)) 165 TYPE(ctrl_outcosp), SAVE :: o_reffclimodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 166 "reffclimodis", "Modis Cloud_Particle_Size_Ice_Mean", "m", (/ ('', i=1, 3) /)) 167 TYPE(ctrl_outcosp), SAVE :: o_pctmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 168 "pctmodis", "Modis Cloud_Top_Pressure_Total_Mean", "Pa", (/ ('', i=1, 3) /)) 169 TYPE(ctrl_outcosp), SAVE :: o_lwpmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 170 "lwpmodis", "Modis Liquid_Water_Path_Mean", "kg m-2", (/ ('', i=1, 3) /)) 171 TYPE(ctrl_outcosp), SAVE :: o_iwpmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 172 "iwpmodis", "Modis Ice_Water_Path_Mean", "kg m-2", (/ ('', i=1, 3) /)) 173 TYPE(ctrl_outcosp), SAVE :: o_clmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 174 "clmodis", "MODIS Cloud Area Fraction", "%", (/ ('', i=1, 3) /)) 175 176 ! Rttovs simulator 177 TYPE(ctrl_outcosp), SAVE :: o_tbrttov = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 178 "tbrttov", "Rttovs Cloud Area Fraction", "%", (/ ('', i=1, 3) /)) 179 180 ! Scops and others 181 TYPE(ctrl_outcosp), SAVE :: o_fracout = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), & 182 "fracout", "Subcolumn output from SCOPS", "%", (/ ('', i=1, 3) /)) 183 82 184 LOGICAL, SAVE :: cosp_varsdefined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL 83 185 REAL, SAVE :: Cosp_fill_value … … 181 283 Cosp_fill_value=0. 182 284 print*,'Cosp_fill_value=',Cosp_fill_value 183 ! ug R\'eglage du calendrier xios184 !Temps julian => an, mois, jour, heure185 ! CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)186 ! CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)187 ! CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &188 ! ini_mois, ini_jour, ini_heure )189 ! ug d�claration des axes verticaux de chaque fichier:190 285 ! if (use_vgrid) then 286 ! print*,'vgrid%Nlvgrid, vgrid%z = ',vgrid%Nlvgrid, vgrid%z 191 287 CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z) 288 print*,'wxios_add_vaxis ' 192 289 ! else 193 290 ! WRITE(lunout,*) 'wxios_add_vaxis "presnivs", vgrid%Nlvgrid ',vgrid%Nlvgrid … … 202 299 WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns 203 300 CALL wxios_add_vaxis("column", Ncolumns, column_ax) 301 302 ! AI nov 2015 303 CALL wxios_add_vaxis("temp", LIDAR_NTEMP, LIDAR_PHASE_TEMP) 304 CALL wxios_add_vaxis("cth16", MISR_N_CTH, MISR_CTH) 204 305 #endif 205 306 … … 212 313 CALL histbeg_phy_all(cosp_outfilenames(iff),itau_phy,zjulian,& 213 314 dtime,nhoricosp(iff),cosp_nidfiles(iff)) 214 print*,'histbeg_phy nhoricosp(iff),cosp_nidfiles(iff)', &215 nhoricosp(iff),cosp_nidfiles(iff)315 ! print*,'histbeg_phy nhoricosp(iff),cosp_nidfiles(iff)', & 316 ! nhoricosp(iff),cosp_nidfiles(iff) 216 317 217 318 #ifdef CPP_XIOS … … 240 341 CALL histvert(cosp_nidfiles(iff),"column","column","count",Ncolumns,column_ax(1:Ncolumns),nvertcol(iff)) 241 342 343 CALL histvert(cosp_nidfiles(iff),"temp","temperature","C",LIDAR_NTEMP,LIDAR_PHASE_TEMP,nverttemp(iff)) 344 CALL histvert(cosp_nidfiles(iff),"cth16","altitude","m",MISR_N_CTH,MISR_CTH,nvertmisr(iff)) 242 345 !!! Valeur indefinie en cas IOIPSL 243 346 Cosp_fill_value=0. -
LMDZ5/trunk/libf/phylmd/cosp/cosp_output_write_mod.F90
r2345 r2428 18 18 19 19 SUBROUTINE cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, & 20 cfg, gbx, vgrid, sglidar, stlidar, isccp) 20 cfg, gbx, vgrid, sglidar, sgradar, stlidar, stradar, & 21 isccp, misr, modis) 21 22 22 23 USE ioipsl … … 35 36 type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP 36 37 type(cosp_sglidar) :: sglidar ! Output from lidar simulator 38 type(cosp_sgradar) :: sgradar ! Output from radar simulator 37 39 type(cosp_isccp) :: isccp ! Output from ISCCP simulator 38 40 type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator 41 type(cosp_radarstats) :: stradar 42 type(cosp_misr) :: misr ! Output from MISR 43 type(cosp_modis) :: modis ! Outputs from Modis 39 44 type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats 40 45 … … 126 131 enddo 127 132 133 ! AI 11 / 2015 134 135 where(stlidar%parasolrefl == R_UNDEF) stlidar%parasolrefl = 0.0 136 where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = 0.0 137 where(stlidar%cldlayerphase == R_UNDEF) stlidar%cldlayerphase = 0.0 138 where(stlidar%lidarcldphase == R_UNDEF) stlidar%lidarcldphase = 0.0 139 where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = 0.0 140 141 128 142 print*,'Appel histwrite2d_cosp' 129 143 CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1)) … … 132 146 CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4)) 133 147 CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert) 148 CALL histwrite3d_cosp(o_clcalipsotmp,stlidar%lidarcldtmp(:,:,1),nverttemp) 149 150 CALL histwrite2d_cosp(o_cllcalipsoice,stlidar%cldlayerphase(:,1,1)) 151 CALL histwrite2d_cosp(o_clhcalipsoice,stlidar%cldlayerphase(:,3,1)) 152 CALL histwrite2d_cosp(o_clmcalipsoice,stlidar%cldlayerphase(:,2,1)) 153 CALL histwrite2d_cosp(o_cltcalipsoice,stlidar%cldlayerphase(:,4,1)) 154 CALL histwrite3d_cosp(o_clcalipsoice,stlidar%lidarcldphase(:,:,1),nvert) 155 CALL histwrite3d_cosp(o_clcalipsotmpice,stlidar%lidarcldtmp(:,:,2),nverttemp) 156 157 CALL histwrite2d_cosp(o_cllcalipsoliq,stlidar%cldlayerphase(:,1,2)) 158 CALL histwrite2d_cosp(o_clhcalipsoliq,stlidar%cldlayerphase(:,3,2)) 159 CALL histwrite2d_cosp(o_clmcalipsoliq,stlidar%cldlayerphase(:,2,2)) 160 CALL histwrite2d_cosp(o_cltcalipsoliq,stlidar%cldlayerphase(:,4,2)) 161 CALL histwrite3d_cosp(o_clcalipsoliq,stlidar%lidarcldphase(:,:,2),nvert) 162 CALL histwrite3d_cosp(o_clcalipsotmpliq,stlidar%lidarcldtmp(:,:,3),nverttemp) 163 164 CALL histwrite2d_cosp(o_cllcalipsoun,stlidar%cldlayerphase(:,1,3)) 165 CALL histwrite2d_cosp(o_clhcalipsoun,stlidar%cldlayerphase(:,3,3)) 166 CALL histwrite2d_cosp(o_clmcalipsoun,stlidar%cldlayerphase(:,2,3)) 167 CALL histwrite2d_cosp(o_cltcalipsoun,stlidar%cldlayerphase(:,4,3)) 168 CALL histwrite3d_cosp(o_clcalipsoice,stlidar%lidarcldphase(:,:,3),nvert) 169 CALL histwrite3d_cosp(o_clcalipsotmpun,stlidar%lidarcldtmp(:,:,4),nverttemp) 134 170 135 171 do icl=1,SR_BINS … … 160 196 endif !Lidar 161 197 198 if (cfg%Lradar_sim) then 199 do icl=1,Ncolumns 200 CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvertmcosp,icl) 201 enddo 202 do icl=1,DBZE_BINS 203 CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl) 204 enddo 205 endif 206 207 if (cfg%Llidar_sim .and. cfg%Lradar_sim) then 208 where(stradar%lidar_only_freq_cloud == R_UNDEF) & 209 stradar%lidar_only_freq_cloud = 0.0 210 CALL histwrite3d_cosp(o_clcalipso2,stradar%lidar_only_freq_cloud,nvert) 211 endif 212 162 213 if (cfg%Lisccp_sim) then 163 214 164 215 ! Traitement des valeurs indefinies 165 216 do ip = 1,Npoints 166 if(isccp%totalcldarea(ip).eq. -1.E+30)then217 if(isccp%totalcldarea(ip).eq.R_UNDEF)then 167 218 isccp%totalcldarea(ip)=Cosp_fill_value 168 219 endif 169 if(isccp%meanptop(ip).eq. -1.E+30)then220 if(isccp%meanptop(ip).eq.R_UNDEF)then 170 221 isccp%meanptop(ip)=Cosp_fill_value 171 222 endif 172 if(isccp%meantaucld(ip).eq. -1.E+30)then223 if(isccp%meantaucld(ip).eq.R_UNDEF)then 173 224 isccp%meantaucld(ip)=Cosp_fill_value 174 225 endif 175 if(isccp%meanalbedocld(ip).eq. -1.E+30)then226 if(isccp%meanalbedocld(ip).eq.R_UNDEF)then 176 227 isccp%meanalbedocld(ip)=Cosp_fill_value 177 228 endif 178 if(isccp%meantb(ip).eq. -1.E+30)then229 if(isccp%meantb(ip).eq.R_UNDEF)then 179 230 isccp%meantb(ip)=Cosp_fill_value 180 231 endif 181 if(isccp%meantbclr(ip).eq. -1.E+30)then232 if(isccp%meantbclr(ip).eq.R_UNDEF)then 182 233 isccp%meantbclr(ip)=Cosp_fill_value 183 234 endif … … 185 236 do k=1,7 186 237 do ii=1,7 187 if(isccp%fq_isccp(ip,ii,k).eq. -1.E+30)then238 if(isccp%fq_isccp(ip,ii,k).eq.R_UNDEF)then 188 239 isccp%fq_isccp(ip,ii,k)=Cosp_fill_value 189 240 endif … … 192 243 193 244 do ii=1,Ncolumns 194 if(isccp%boxtau(ip,ii).eq. -1.E+30)then245 if(isccp%boxtau(ip,ii).eq.R_UNDEF)then 195 246 isccp%boxtau(ip,ii)=Cosp_fill_value 196 247 endif … … 198 249 199 250 do ii=1,Ncolumns 200 if(isccp%boxptop(ip,ii).eq. -1.E+30)then251 if(isccp%boxptop(ip,ii).eq.R_UNDEF)then 201 252 isccp%boxptop(ip,ii)=Cosp_fill_value 202 253 endif … … 217 268 CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr) 218 269 endif ! Isccp 270 271 ! MISR simulator 272 if (cfg%Lmisr_sim) then 273 do ip=1,Npoints 274 do ii=1,7 275 do k=1,MISR_N_CTH 276 if(misr%fq_MISR(ip,ii,k).eq.R_UNDEF)then 277 misr%fq_MISR(ip,ii,k)=Cosp_fill_value 278 endif 279 enddo 280 enddo 281 enddo 282 283 do icl=1,7 284 CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl) 285 enddo 286 endif 287 288 ! Modis simulator 289 if (cfg%Lmodis_sim) then 290 291 do ip=1,Npoints 292 if(modis%Cloud_Fraction_Low_Mean(ip).eq.R_UNDEF)then 293 modis%Cloud_Fraction_Low_Mean(ip)=Cosp_fill_value 294 endif 295 if(modis%Cloud_Fraction_High_Mean(ip).eq.R_UNDEF)then 296 modis%Cloud_Fraction_High_Mean(ip)=Cosp_fill_value 297 endif 298 if(modis%Cloud_Fraction_Mid_Mean(ip).eq.R_UNDEF)then 299 modis%Cloud_Fraction_Mid_Mean(ip)=Cosp_fill_value 300 endif 301 if(modis%Cloud_Fraction_Total_Mean(ip).eq.R_UNDEF)then 302 modis%Cloud_Fraction_Total_Mean(ip)=Cosp_fill_value 303 endif 304 if(modis%Cloud_Fraction_Water_Mean(ip).eq.R_UNDEF)then 305 modis%Cloud_Fraction_Water_Mean(ip)=Cosp_fill_value 306 endif 307 if(modis%Cloud_Fraction_Ice_Mean(ip).eq.R_UNDEF)then 308 modis%Cloud_Fraction_Ice_Mean(ip)=Cosp_fill_value 309 endif 310 if(modis%Optical_Thickness_Total_Mean(ip).eq.R_UNDEF)then 311 modis%Optical_Thickness_Total_Mean(ip)=Cosp_fill_value 312 endif 313 if(modis%Optical_Thickness_Water_Mean(ip).eq.R_UNDEF)then 314 modis%Optical_Thickness_Water_Mean(ip)=Cosp_fill_value 315 endif 316 if(modis%Optical_Thickness_Ice_Mean(ip).eq.R_UNDEF)then 317 modis%Optical_Thickness_Ice_Mean(ip)=Cosp_fill_value 318 endif 319 if(modis%Cloud_Particle_Size_Water_Mean(ip).eq.R_UNDEF)then 320 modis%Cloud_Particle_Size_Water_Mean(ip)=Cosp_fill_value 321 endif 322 if(modis%Cloud_Top_Pressure_Total_Mean(ip).eq.R_UNDEF)then 323 modis%Cloud_Top_Pressure_Total_Mean(ip)=Cosp_fill_value 324 endif 325 if(modis%Liquid_Water_Path_Mean(ip).eq.R_UNDEF)then 326 modis%Liquid_Water_Path_Mean(ip)=Cosp_fill_value 327 endif 328 if(modis%Ice_Water_Path_Mean(ip).eq.R_UNDEF)then 329 modis%Ice_Water_Path_Mean(ip)=Cosp_fill_value 330 endif 331 332 enddo 333 334 CALL histwrite2d_cosp(o_cllmodis,modis%Cloud_Fraction_Low_Mean) 335 CALL histwrite2d_cosp(o_clhmodis,modis%Cloud_Fraction_High_Mean) 336 CALL histwrite2d_cosp(o_clmmodis,modis%Cloud_Fraction_Mid_Mean) 337 CALL histwrite2d_cosp(o_cltmodis,modis%Cloud_Fraction_Total_Mean) 338 CALL histwrite2d_cosp(o_clwmodis,modis%Cloud_Fraction_Water_Mean) 339 CALL histwrite2d_cosp(o_climodis,modis%Cloud_Fraction_Ice_Mean) 340 CALL histwrite2d_cosp(o_tautmodis,modis%Optical_Thickness_Total_Mean) 341 CALL histwrite2d_cosp(o_tauwmodis,modis%Optical_Thickness_Water_Mean) 342 CALL histwrite2d_cosp(o_tauimodis,modis%Optical_Thickness_Ice_Mean) 343 CALL histwrite2d_cosp(o_tautlogmodis,modis%Optical_Thickness_Total_LogMean) 344 CALL histwrite2d_cosp(o_tauwlogmodis,modis%Optical_Thickness_Water_LogMean) 345 CALL histwrite2d_cosp(o_tauilogmodis,modis%Optical_Thickness_Ice_LogMean) 346 CALL histwrite2d_cosp(o_reffclwmodis,modis%Cloud_Particle_Size_Water_Mean) 347 CALL histwrite2d_cosp(o_reffclimodis,modis%Cloud_Particle_Size_Ice_Mean) 348 CALL histwrite2d_cosp(o_pctmodis,modis%Cloud_Top_Pressure_Total_Mean) 349 CALL histwrite2d_cosp(o_lwpmodis,modis%Liquid_Water_Path_Mean) 350 CALL histwrite2d_cosp(o_iwpmodis,modis%Ice_Water_Path_Mean) 351 352 do ip=1,Npoints 353 do ii=1,7 354 do k=1,7 355 if(modis%Optical_Thickness_vs_Cloud_Top_Pressure(ip,ii,k).eq.R_UNDEF)then 356 modis%Optical_Thickness_vs_Cloud_Top_Pressure(ip,ii,k)=0. 357 endif 358 enddo 359 enddo 360 enddo 361 362 do icl=1,7 363 CALL histwrite3d_cosp(o_clmodis, & 364 modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl) 365 enddo 366 endif 219 367 220 368 IF(.NOT.cosp_varsdefined) THEN … … 362 510 klevs=Ncolout 363 511 nam_axvert="column" 512 ELSE IF (nvertsave.eq.nverttemp(iff)) THEN 513 klevs=LIDAR_NTEMP 514 nam_axvert="temp" 515 ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN 516 klevs=MISR_N_CTH 517 nam_axvert="cth16" 364 518 ELSE 365 519 klevs=Nlevout … … 494 648 #ifdef CPP_XIOS 495 649 IF (ok_all_xml) THEN 496 if (prt_level >= 1 0) then650 if (prt_level >= 1) then 497 651 WRITE(lunout,*)'xios_send_field variable ',var%name 498 652 endif … … 596 750 IF (ok_all_xml) THEN 597 751 CALL xios_send_field(nom, Field3d(:,:,1:nlev)) 598 IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name752 IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name 599 753 ENDIF 600 754 #endif -
LMDZ5/trunk/libf/phylmd/cosp/cosp_radar.F90
r1907 r2428 26 26 USE MOD_COSP_CONSTANTS 27 27 USE MOD_COSP_TYPES 28 USE MOD_COSP_UTILS 28 29 use radar_simulator_types 29 30 use array_lib … … 31 32 use format_input 32 33 IMPLICIT NONE 33 34 34 35 INTERFACE 35 subroutine radar_simulator(freq,k2,do_ray,use_gas_abs,use_mie_table,mt, & 36 nhclass,hp,nprof,ngate,nsizes,D,hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix, & 37 rh_matrix,Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe, & 36 subroutine radar_simulator(hp,nprof,ngate,undef, & 37 hgt_matrix,hm_matrix,re_matrix,Np_matrix, & 38 p_matrix,t_matrix,rh_matrix, & 39 Ze_non,Ze_ray,g_to_vol,a_to_vol,dBZe, & 38 40 g_to_vol_in,g_to_vol_out) 39 40 use m_mrgrnk 41 42 use m_mrgrnk 41 43 use array_lib 42 44 use math_lib … … 44 46 use radar_simulator_types 45 47 implicit none 48 46 49 ! ----- INPUTS ----- 47 type(mie), intent(in) :: mt48 50 type(class_param) :: hp 49 real*8, intent(in) :: freq,k2 50 integer, intent(in) :: do_ray,use_gas_abs,use_mie_table, &51 nhclass,nprof,ngate,nsizes 52 real *8, dimension(nsizes), intent(in) :: D51 52 integer, intent(in) :: nprof,ngate 53 54 real undef 53 55 real*8, dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, & 54 56 t_matrix,rh_matrix 55 real*8, dimension(nhclass,nprof,ngate), intent(in) :: hm_matrix 56 real*8, dimension(nhclass,nprof,ngate), intent(inout) :: re_matrix 57 real*8, dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix 58 real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix 59 real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: Np_matrix 60 57 61 ! ----- OUTPUTS ----- 58 62 real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, & 59 g_ atten_to_vol,dBZe,h_atten_to_vol63 g_to_vol,dBZe,a_to_vol 60 64 ! ----- OPTIONAL ----- 61 real*8, optional, dimension(n gate,nprof) :: &65 real*8, optional, dimension(nprof,ngate) :: & 62 66 g_to_vol_in,g_to_vol_out 63 67 end subroutine radar_simulator … … 73 77 74 78 ! Arguments 75 type(cosp_gridbox),intent(in ) :: gbx ! Gridbox info79 type(cosp_gridbox),intent(inout) :: gbx ! Gridbox info 76 80 type(cosp_subgrid),intent(in) :: sgx ! Subgrid info 77 81 type(cosp_sghydro),intent(in) :: sghydro ! Subgrid info for hydrometeors … … 80 84 ! Local variables 81 85 integer :: & 82 nsizes 86 nsizes ! num of discrete drop sizes 83 87 84 real*8 :: &85 freq, & ! radar frequency (GHz)86 k2 ! |K|^2, -1=use frequency dependent default87 88 88 real*8, dimension(:,:), allocatable :: & 89 89 g_to_vol ! integrated atten due to gases, r>v (dB) 90 90 91 91 real*8, dimension(:,:), allocatable :: & 92 Ze_non, & 93 Ze_ray, & 94 h_atten_to_vol, & 95 g_atten_to_vol, & 96 dBZe, & 97 hgt_matrix, & 92 Ze_non, & ! radar reflectivity withOUT attenuation (dBZ) 93 Ze_ray, & ! Rayleigh reflectivity (dBZ) 94 h_atten_to_vol, & ! attenuation by hydromets, radar to vol (dB) 95 g_atten_to_vol, & ! gaseous atteunation, radar to vol (dB) 96 dBZe, & ! effective radar reflectivity factor (dBZ) 97 hgt_matrix, & ! height of hydrometeors (km) 98 98 t_matrix, & !temperature (k) 99 99 p_matrix, & !pressure (hPa) 100 100 rh_matrix !relative humidity (%) 101 101 102 102 real*8, dimension(:,:,:), allocatable :: & 103 hm_matrix, & ! hydrometeor mixing ratio (g kg^-1) 104 re_matrix 103 hm_matrix, & ! hydrometeor mixing ratio (g kg^-1) 104 re_matrix, & ! effective radius (microns). Optional. 0 ==> use Np_matrix or defaults 105 Np_matrix ! total number concentration (kg^-1). Optional 0==> use defaults 105 106 106 107 integer, parameter :: one = 1 107 logical :: hgt_reversed 108 integer :: pr,i,j,k,unt 108 ! logical :: hgt_reversed 109 logical :: hgt_descending 110 integer :: pr,i,j,k,unt,ngate 109 111 110 112 ! ----- main program settings ------ 111 112 freq = gbx%radar_freq113 k2 = gbx%k2114 115 !116 ! note: intitialization section that was here has been relocated to SUBROUTINE CONSTRUCT_COSP_GRIDBOX by roj, Feb 2008117 !118 mt_ttl=gbx%mt_ttl ! these variables really should be moved into the mt structure rather than kept as global arrays.119 mt_tti=gbx%mt_tti120 113 121 114 ! Inputs to Quickbeam 122 115 allocate(hgt_matrix(gbx%Npoints,gbx%Nlevels),p_matrix(gbx%Npoints,gbx%Nlevels), & 123 116 t_matrix(gbx%Npoints,gbx%Nlevels),rh_matrix(gbx%Npoints,gbx%Nlevels)) 124 allocate(hm_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels)) 117 allocate(hm_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels)) 125 118 allocate(re_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels)) 119 allocate(Np_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels)) 126 120 127 121 ! Outputs from Quickbeam … … 131 125 allocate(g_atten_to_vol(gbx%Npoints,gbx%Nlevels)) 132 126 allocate(dBZe(gbx%Npoints,gbx%Nlevels)) 133 127 134 128 ! Optional argument. It is computed and returned in the first call to 135 129 ! radar_simulator, and passed as input in the rest 136 allocate(g_to_vol(gbx%Nlevels,gbx%Npoints)) 137 130 allocate(g_to_vol(gbx%Npoints,gbx%Nlevels)) 131 132 ! Even if there is no unit conversion, they are needed for type conversion 138 133 p_matrix = gbx%p/100.0 ! From Pa to hPa 139 134 hgt_matrix = gbx%zlev/1000.0 ! From m to km 140 t_matrix = gbx%T -273.15 ! From K to C135 t_matrix = gbx%T 141 136 rh_matrix = gbx%q 142 137 re_matrix = 0.0 143 144 ! Quickbeam assumes the first row is closest to the radar 145 call order_data(hgt_matrix,hm_matrix,p_matrix,t_matrix, & 146 rh_matrix,gbx%surface_radar,hgt_reversed) 147 138 139 140 ! set flag denoting position of radar relative to hgt_matrix orientation 141 ngate = size(hgt_matrix,2) 142 143 hgt_descending = hgt_matrix(1,1) > hgt_matrix(1,ngate) 144 145 if ( & 146 (gbx%surface_radar == 1 .and. hgt_descending) .or. & 147 (gbx%surface_radar == 0 .and. (.not. hgt_descending)) & 148 ) & 149 then 150 gbx%hp%radar_at_layer_one = .false. 151 else 152 gbx%hp%radar_at_layer_one = .true. 153 endif 154 148 155 ! ----- loop over subcolumns ----- 149 156 do pr=1,sgx%Ncolumns 157 158 ! NOTE: 150 159 ! atmospheric profiles are the same within the same gridbox 151 ! only hydrometeor profiles will be different 152 if (hgt_reversed) then 153 do i=1,gbx%Nhydro 154 hm_matrix(i,:,:) = sghydro%mr_hydro(:,pr,gbx%Nlevels:1:-1,i)*1000.0 ! Units from kg/kg to g/kg 155 if (gbx%use_reff) then 156 re_matrix(i,:,:) = sghydro%Reff(:,pr,gbx%Nlevels:1:-1,i)*1.e6 ! Units from m to micron 157 endif 158 enddo 159 else 160 ! only hydrometeor profiles will be different for each subgridbox 161 160 162 do i=1,gbx%Nhydro 161 163 hm_matrix(i,:,:) = sghydro%mr_hydro(:,pr,:,i)*1000.0 ! Units from kg/kg to g/kg 162 164 if (gbx%use_reff) then 163 165 re_matrix(i,:,:) = sghydro%Reff(:,pr,:,i)*1.e6 ! Units from m to micron 166 Np_matrix(i,:,:) = sghydro%Np(:,pr,:,i) ! Units [#/kg] 164 167 endif 165 168 enddo 166 endif167 169 168 170 ! ----- call radar simulator ----- 169 171 if (pr == 1) then ! Compute gaseous attenuation for all profiles 170 j=0 171 if (gbx%Npoints == 53) then 172 unt=10 173 j=1 174 endif 175 if (gbx%Npoints == 153) then 176 unt=11 177 j=101 178 endif 179 call radar_simulator(freq,k2,gbx%do_ray,gbx%use_gas_abs,gbx%use_mie_tables,gbx%mt, & ! v0.2: mt changed to gbx%mt, roj 180 gbx%Nhydro,gbx%hp,gbx%Npoints,gbx%Nlevels,gbx%nsizes,gbx%D, & ! v0.2: hp->gbx%hp, D->gbx%d, nsizes->gbx%nsizes, roj 181 hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix,rh_matrix, & 172 call radar_simulator(gbx%hp,gbx%Npoints,gbx%Nlevels,R_UNDEF, & 173 hgt_matrix,hm_matrix,re_matrix,Np_matrix, & 174 p_matrix,t_matrix,rh_matrix, & 182 175 Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_out=g_to_vol) 183 176 else ! Use gaseous atteunuation for pr = 1 184 call radar_simulator( freq,k2,gbx%do_ray,gbx%use_gas_abs,gbx%use_mie_tables,gbx%mt, &185 gbx%Nhydro,gbx%hp,gbx%Npoints,gbx%Nlevels,gbx%nsizes,gbx%D, &186 hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix,rh_matrix, &177 call radar_simulator(gbx%hp,gbx%Npoints,gbx%Nlevels,R_UNDEF, & 178 hgt_matrix,hm_matrix,re_matrix,Np_matrix, & 179 p_matrix,t_matrix,rh_matrix, & 187 180 Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_in=g_to_vol) 188 181 endif 189 ! ----- BEGIN output section -----190 ! spaceborne radar : from TOA to SURFACE191 if (gbx%surface_radar == 1) then192 z%Ze_tot(:,pr,:)=dBZe(:,:)193 else if (gbx%surface_radar == 0) then ! Spaceborne194 z%Ze_tot(:,pr,:)=dBZe(:,gbx%Nlevels:1:-1)195 endif196 182 183 ! store caluculated dBZe values for later output/processing 184 z%Ze_tot(:,pr,:)=dBZe(:,:) 197 185 enddo !pr 198 199 ! Change undefined value to one defined in COSP200 where (z%Ze_tot == -999.0) z%Ze_tot = R_UNDEF201 186 202 187 deallocate(hgt_matrix,p_matrix,t_matrix,rh_matrix) … … 204 189 Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe) 205 190 deallocate(g_to_vol) 206 207 ! deallocate(mt_ttl,mt_tti) !v0.2: roj feb 2008 can not be done here,208 !these variables now part of gbx structure and dealocated later209 210 191 END SUBROUTINE COSP_RADAR 211 192 -
LMDZ5/trunk/libf/phylmd/cosp/cosp_simulator.F90
r1907 r2428 1 1 ! (c) British Crown Copyright 2008, the Met Office. 2 3 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 $ 4 5 ! 5 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 27 28 ! History: 28 29 ! Jul 2007 - A. Bodas-Salcedo - Initial version 30 ! Jan 2013 - G. Cesana - Add new variables linked to the lidar cloud phase 29 31 ! 30 ! 31 32 33 #include "cosp_defs.h" 32 34 MODULE 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 33 37 USE MOD_COSP_TYPES 34 38 USE MOD_COSP_RADAR 35 39 USE MOD_COSP_LIDAR 36 40 USE MOD_COSP_ISCCP_SIMULATOR 41 USE MOD_COSP_MODIS_SIMULATOR 37 42 USE MOD_COSP_MISR_SIMULATOR 43 !#ifdef RTTOV 44 ! USE MOD_COSP_RTTOV_SIMULATOR 45 !#endif 38 46 USE MOD_COSP_STATS 39 47 IMPLICIT NONE … … 45 53 !--------------------- SUBROUTINE COSP_SIMULATOR ------------------ 46 54 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 47 SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,stradar,stlidar) 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 48 60 49 61 ! Arguments 50 type(cosp_gridbox),intent(in ) :: gbx ! Grid-box inputs62 type(cosp_gridbox),intent(inout) :: gbx ! Grid-box inputs 51 63 type(cosp_subgrid),intent(in) :: sgx ! Subgrid inputs 52 64 type(cosp_sghydro),intent(in) :: sghydro ! Subgrid info for hydrometeors 53 type(cosp_config),intent(in) :: cfg! Configuration options65 type(cosp_config),intent(in) :: cfg ! Configuration options 54 66 type(cosp_vgrid),intent(in) :: vgrid ! Information on vertical grid of stats 55 67 type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator … … 57 69 type(cosp_isccp),intent(inout) :: isccp ! Output from ISCCP simulator 58 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 59 75 type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator 60 76 type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator 61 77 ! Local variables 62 ! ***Timing variables (to be deleted in final version) 63 integer :: t0,t1,count_rate,count_max 64 65 !+++++++++ Radar model ++++++++++ 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 66 99 if (cfg%Lradar_sim) then 100 call system_clock(t0) 67 101 call cosp_radar(gbx,sgx,sghydro,sgradar) 68 endif 69 102 call system_clock(t1) 103 tsim(isim) = tsim(isim) + (t1 -t0) 104 endif 105 70 106 !+++++++++ Lidar model ++++++++++ 107 isim = I_LIDAR 71 108 if (cfg%Llidar_sim) then 109 call system_clock(t0) 72 110 call cosp_lidar(gbx,sgx,sghydro,sglidar) 73 endif 74 75 111 call system_clock(t1) 112 tsim(isim) = tsim(isim) + (t1 -t0) 113 endif 114 76 115 !+++++++++ ISCCP simulator ++++++++++ 116 isim = I_ISCCP 77 117 if (cfg%Lisccp_sim) then 118 call system_clock(t0) 78 119 call cosp_isccp_simulator(gbx,sgx,isccp) 79 endif 80 120 call system_clock(t1) 121 tsim(isim) = tsim(isim) + (t1 -t0) 122 endif 123 81 124 !+++++++++ MISR simulator ++++++++++ 125 isim = I_MISR 82 126 if (cfg%Lmisr_sim) then 127 call system_clock(t0) 83 128 call cosp_misr_simulator(gbx,sgx,misr) 84 endif 85 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 86 152 87 153 !+++++++++++ Summary statistics +++++++++++ 154 isim = I_STATS 88 155 if (cfg%Lstats) then 156 call system_clock(t0) 89 157 call cosp_stats(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar) 90 ! print *, '%%%%%% Stats:', (t1-t0)*1.0/count_rate, ' s' 91 endif 92 93 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 ! Test 191 ! where(isccp%totalcldarea == R_UNDEF) isccp%totalcldarea = 0. 192 endif 193 if (cfg%Lclisccp) then 194 where(isccp%fq_isccp /= R_UNDEF) isccp%fq_isccp = isccp%fq_isccp*100.0 195 endif 196 197 if (cfg%LclMISR) then 198 where(misr%fq_MISR /= R_UNDEF) misr%fq_MISR = misr%fq_MISR*100.0 199 endif 200 201 if (cfg%Lcltlidarradar) then 202 where(stradar%radar_lidar_tcc /= R_UNDEF) stradar%radar_lidar_tcc = stradar%radar_lidar_tcc*100.0 203 endif 204 205 if (cfg%Lclmodis) then 206 where(modis%Optical_Thickness_vs_Cloud_Top_Pressure /= R_UNDEF) modis%Optical_Thickness_vs_Cloud_Top_Pressure = & 207 modis%Optical_Thickness_vs_Cloud_Top_Pressure*100.0 208 endif 209 if (cfg%Lcltmodis) then 210 where(modis%Cloud_Fraction_Total_Mean /= R_UNDEF) modis%Cloud_Fraction_Total_Mean = modis%Cloud_Fraction_Total_Mean*100.0 211 endif 212 if (cfg%Lclwmodis) then 213 where(modis%Cloud_Fraction_Water_Mean /= R_UNDEF) modis%Cloud_Fraction_Water_Mean = modis%Cloud_Fraction_Water_Mean*100.0 214 endif 215 if (cfg%Lclimodis) then 216 where(modis%Cloud_Fraction_Ice_Mean /= R_UNDEF) modis%Cloud_Fraction_Ice_Mean = modis%Cloud_Fraction_Ice_Mean*100.0 217 endif 218 219 if (cfg%Lclhmodis) then 220 where(modis%Cloud_Fraction_High_Mean /= R_UNDEF) modis%Cloud_Fraction_High_Mean = modis%Cloud_Fraction_High_Mean*100.0 221 endif 222 if (cfg%Lclmmodis) then 223 where(modis%Cloud_Fraction_Mid_Mean /= R_UNDEF) modis%Cloud_Fraction_Mid_Mean = modis%Cloud_Fraction_Mid_Mean*100.0 224 endif 225 if (cfg%Lcllmodis) then 226 where(modis%Cloud_Fraction_Low_Mean /= R_UNDEF) modis%Cloud_Fraction_Low_Mean = modis%Cloud_Fraction_Low_Mean*100.0 227 endif 228 229 ! Change pressure from hPa to Pa. 230 if (cfg%Lboxptopisccp) then 231 where(isccp%boxptop /= R_UNDEF) isccp%boxptop = isccp%boxptop*100.0 232 endif 233 if (cfg%Lpctisccp) then 234 where(isccp%meanptop /= R_UNDEF) isccp%meanptop = isccp%meanptop*100.0 235 endif 236 237 94 238 END SUBROUTINE COSP_SIMULATOR 95 239 -
LMDZ5/trunk/libf/phylmd/cosp/cosp_stats.F90
r1907 r2428 1 1 ! (c) British Crown Copyright 2008, the Met Office. 2 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_stats.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 30 32 ! Oct 2008 - H. Chepfer - Added PARASOL reflectance arguments 31 33 ! Jun 2010 - T. Yokohata, T. Nishimura and K. Ogochi - Added NEC SXs optimisations 32 ! 33 ! 34 ! Jan 2013 - G. Cesana - Added betaperp and temperature arguments 35 ! - Added phase 3D/3Dtemperature/Map output variables in diag_lidar 36 ! 37 ! 38 #include "cosp_defs.h" 34 39 MODULE MOD_COSP_STATS 35 40 USE MOD_COSP_CONSTANTS … … 66 71 real,dimension(:,:,:),allocatable :: Ze_out,betatot_out,betamol_in,betamol_out,ph_in,ph_out 67 72 real,dimension(:,:),allocatable :: ph_c,betamol_c 73 real,dimension(:,:,:),allocatable :: betaperptot_out, temp_in, temp_out 74 real,dimension(:,:),allocatable :: temp_c 68 75 69 76 Npoints = gbx%Npoints … … 73 80 Nlr = vgrid%Nlvgrid 74 81 75 if (cfg%Lcfad _Lidarsr532) ok_lidar_cfad=.true.82 if (cfg%LcfadLidarsr532) ok_lidar_cfad=.true. 76 83 77 84 if (vgrid%use_vgrid) then ! Statistics in a different vertical grid … … 86 93 ph_out = 0.0 87 94 ph_c = 0.0 95 allocate(betaperptot_out(Npoints,Ncolumns,Nlr),temp_in(Npoints,1,Nlevels),temp_out(Npoints,1,Nlr), & 96 temp_c(Npoints,Nlr)) 97 betaperptot_out = 0.0 98 temp_in = 0.0 99 temp_out = 0.0 100 temp_c = 0.0 101 88 102 !++++++++++++ Radar CFAD ++++++++++++++++ 89 103 if (cfg%Lradar_sim) then … … 100 114 call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sglidar%beta_tot, & 101 115 Nlr,vgrid%zl,vgrid%zu,betatot_out) 116 117 temp_in(:,1,:) = gbx%T(:,:) 118 call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sglidar%betaperp_tot, & 119 Nlr,vgrid%zl,vgrid%zu,betaperptot_out) 120 call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,temp_in, & 121 Nlr,vgrid%zl,vgrid%zu,temp_out) 122 temp_c(:,:) = temp_out(:,1,:) 123 102 124 call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,ph_in, & 103 125 Nlr,vgrid%zl,vgrid%zu,ph_out) … … 106 128 ! Stats from lidar_stat_summary 107 129 call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL & 108 , betatot_out,betamol_c,sglidar%refl,gbx%land,ph_c &130 ,temp_c,betatot_out,betaperptot_out,betamol_c,sglidar%refl,gbx%land,ph_c & 109 131 ,LIDAR_UNDEF,ok_lidar_cfad & 110 132 ,stlidar%cfad_sr,stlidar%srbval & 111 ,LIDAR_NCAT,stlidar%lidarcld,stlidar%cldlayer,stlidar%parasolrefl) 133 ,LIDAR_NCAT,stlidar%lidarcld,stlidar%lidarcldphase & 134 ,stlidar%cldlayer,stlidar%cldlayerphase,stlidar%lidarcldtmp & 135 ,stlidar%parasolrefl) 112 136 endif 137 113 138 !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++ 114 139 if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, & 115 betatot_out,betamol_c,Ze_out, &140 temp_c,betatot_out,betaperptot_out,betamol_c,Ze_out, & 116 141 stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc) 142 deallocate(temp_out,temp_c,betaperptot_out) 143 117 144 ! Deallocate arrays at coarse resolution 118 145 deallocate(Ze_out,betatot_out,betamol_in,betamol_out,betamol_c,ph_in,ph_out,ph_c) … … 124 151 ! Stats from lidar_stat_summary 125 152 if (cfg%Llidar_sim) call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL & 126 ,sglidar% beta_tot,sglidar%beta_mol,sglidar%refl,gbx%land,gbx%ph &153 ,sglidar%temp_tot,sglidar%beta_tot,sglidar%betaperp_tot,sglidar%beta_mol,sglidar%refl,gbx%land,gbx%ph & 127 154 ,LIDAR_UNDEF,ok_lidar_cfad & 128 155 ,stlidar%cfad_sr,stlidar%srbval & 129 ,LIDAR_NCAT,stlidar%lidarcld,stlidar%cldlayer,stlidar%parasolrefl) 156 ,LIDAR_NCAT,stlidar%lidarcld,stlidar%lidarcldphase,stlidar%cldlayer,stlidar%cldlayerphase & 157 ,stlidar%lidarcldtmp,stlidar%parasolrefl) 130 158 !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++ 131 159 if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, & 132 sglidar% beta_tot,sglidar%beta_mol,sgradar%Ze_tot, &160 sglidar%temp_tot,sglidar%beta_tot,sglidar%betaperp_tot,sglidar%beta_mol,sgradar%Ze_tot, & 133 161 stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc) 134 162 endif … … 138 166 where (stlidar%cldlayer == LIDAR_UNDEF) stlidar%cldlayer = R_UNDEF 139 167 where (stlidar%parasolrefl == LIDAR_UNDEF) stlidar%parasolrefl = R_UNDEF 168 where (stlidar%cldlayerphase == LIDAR_UNDEF) stlidar%cldlayerphase = R_UNDEF 169 where (stlidar%lidarcldphase == LIDAR_UNDEF) stlidar%lidarcldphase = R_UNDEF 170 where (stlidar%lidarcldtmp == LIDAR_UNDEF) stlidar%lidarcldtmp = R_UNDEF 140 171 141 172 END SUBROUTINE COSP_STATS 142 173 143 144 174 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 145 175 !---------- SUBROUTINE COSP_CHANGE_VERTICAL_GRID ---------------- 146 176 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 147 SUBROUTINE COSP_CHANGE_VERTICAL_GRID(Npoints,Ncolumns,Nlevels,zfull,zhalf,y, M,zl,zu,r,log_units)177 SUBROUTINE COSP_CHANGE_VERTICAL_GRID(Npoints,Ncolumns,Nlevels,zfull,zhalf,y,Nglevels,newgrid_bot,newgrid_top,r,log_units) 148 178 implicit none 149 179 ! Input arguments … … 154 184 real,dimension(Npoints,Nlevels),intent(in) :: zhalf ! Height at half model levels [m] (Bottom of model layer) 155 185 real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: y ! Variable to be changed to a different grid 156 integer,intent(in) :: M!# levels in the new grid157 real,dimension( M),intent(in) :: zl! Lower boundary of new levels [m]158 real,dimension( M),intent(in) :: zu! Upper boundary of new levels [m]186 integer,intent(in) :: Nglevels !# levels in the new grid 187 real,dimension(Nglevels),intent(in) :: newgrid_bot ! Lower boundary of new levels [m] 188 real,dimension(Nglevels),intent(in) :: newgrid_top ! Upper boundary of new levels [m] 159 189 logical,optional,intent(in) :: log_units ! log units, need to convert to linear units 160 190 ! Output 161 real,dimension(Npoints,Ncolumns, M),intent(out) :: r ! Variable on new grid191 real,dimension(Npoints,Ncolumns,Nglevels),intent(out) :: r ! Variable on new grid 162 192 163 193 ! Local variables 164 194 integer :: i,j,k 165 195 logical :: lunits 166 167 196 integer :: l 168 real,dimension(Npoints) :: ws,sumwyp 169 real,dimension(Npoints,Nlevels) :: xl,xu 170 real,dimension(Npoints,Nlevels) :: w 171 real,dimension(Npoints,Ncolumns,Nlevels) :: yp 197 real :: w ! Weight 198 real :: dbb, dtb, dbt, dtt ! Distances between edges of both grids 199 integer :: Nw ! Number of weights 200 real :: wt ! Sum of weights 201 real,dimension(Nlevels) :: oldgrid_bot,oldgrid_top ! Lower and upper boundaries of model grid 202 real :: yp ! Local copy of y at a particular point. 203 ! This allows for change of units. 172 204 173 205 lunits=.false. 174 206 if (present(log_units)) lunits=log_units 175 207 176 r(:,:,:) = R_GROUND 177 ! Vertical grid at that point 178 xl(:,:) = zhalf(:,:) 179 xu(:,1:Nlevels-1) = xl(:,2:Nlevels) 180 xu(:,Nlevels) = zfull(:,Nlevels) + zfull(:,Nlevels) - zhalf(:,Nlevels) ! Top level symmetric 181 yp(:,:,:) = y(:,:,:) ! Temporary variable to regrid 182 ! Check for dBZ and change if necessary 183 if (lunits) then 184 where (y /= R_UNDEF) 185 yp = 10.0**(y/10.0) 186 elsewhere 187 yp = 0.0 188 end where 189 endif 190 do k=1,M 191 ! Find weights 192 w(:,:) = 0.0 193 do j=1,Nlevels 194 do i=1,Npoints 195 if ((xl(i,j) < zl(k)).and.(xu(i,j) > zl(k)).and.(xu(i,j) <= zu(k))) then 196 !xl(j)-----------------xu(j) 197 ! zl(k)------------------------------zu(k) 198 w(i,j) = xu(i,j) - zl(k) 199 else if ((xl(i,j) >= zl(k)).and.(xu(i,j) <= zu(k))) then 200 ! xl(j)-----------------xu(j) 201 ! zl(k)------------------------------zu(k) 202 w(i,j) = xu(i,j) - xl(i,j) 203 else if ((xl(i,j) >= zl(k)).and.(xl(i,j) < zu(k)).and.(xu(i,j) >= zu(k))) then 204 ! xl(j)-----------------xu(j) 205 ! zl(k)------------------------------zu(k) 206 w(i,j) = zu(k) - xl(i,j) 207 else if ((xl(i,j) <= zl(k)).and.(xu(i,j) >= zu(k))) then 208 ! xl(j)---------------------------xu(j) 209 ! zl(k)--------------zu(k) 210 w(i,j) = zu(k) - zl(k) 208 r = 0.0 209 210 do i=1,Npoints 211 ! Calculate tops and bottoms of new and old grids 212 oldgrid_bot = zhalf(i,:) 213 oldgrid_top(1:Nlevels-1) = oldgrid_bot(2:Nlevels) 214 oldgrid_top(Nlevels) = zfull(i,Nlevels) + zfull(i,Nlevels) - zhalf(i,Nlevels) ! Top level symmetric 215 l = 0 ! Index of level in the old grid 216 ! Loop over levels in the new grid 217 do k = 1,Nglevels 218 Nw = 0 ! Number of weigths 219 wt = 0.0 ! Sum of weights 220 ! Loop over levels in the old grid and accumulate total for weighted average 221 do 222 l = l + 1 223 w = 0.0 ! Initialise weight to 0 224 ! Distances between edges of both grids 225 dbb = oldgrid_bot(l) - newgrid_bot(k) 226 dtb = oldgrid_top(l) - newgrid_bot(k) 227 dbt = oldgrid_bot(l) - newgrid_top(k) 228 dtt = oldgrid_top(l) - newgrid_top(k) 229 if (dbt >= 0.0) exit ! Do next level in the new grid 230 if (dtb > 0.0) then 231 if (dbb <= 0.0) then 232 if (dtt <= 0) then 233 w = dtb 234 else 235 w = newgrid_top(k) - newgrid_bot(k) 236 endif 237 else 238 if (dtt <= 0) then 239 w = oldgrid_top(l) - oldgrid_bot(l) 240 else 241 w = -dbt 242 endif 243 endif 244 ! If layers overlap (w/=0), then accumulate 245 if (w /= 0.0) then 246 Nw = Nw + 1 247 wt = wt + w 248 do j=1,Ncolumns 249 if (lunits) then 250 if (y(i,j,l) /= R_UNDEF) then 251 yp = 10.0**(y(i,j,l)/10.0) 252 else 253 yp = 0.0 254 endif 255 else 256 yp = y(i,j,l) 257 endif 258 r(i,j,k) = r(i,j,k) + w*yp 259 enddo 260 endif 211 261 endif 212 262 enddo 263 l = l - 2 264 if (l < 1) l = 0 265 ! Calculate average in new grid 266 if (Nw > 0) then 267 do j=1,Ncolumns 268 r(i,j,k) = r(i,j,k)/wt 269 enddo 270 endif 213 271 enddo 214 ! Do the weighted mean 272 enddo 273 274 ! Set points under surface to R_UNDEF, and change to dBZ if necessary 275 do k=1,Nglevels 215 276 do j=1,Ncolumns 216 ws (:) = 0.0 217 sumwyp(:) = 0.0 218 do l=1,Nlevels 219 do i=1,Npoints 220 if (zu(k) > zhalf(i,1)) then ! Level above model bottom level 221 ws (i) = ws (i) + w(i,l) 222 sumwyp(i) = sumwyp(i) + w(i,l)*yp(i,j,l) 277 do i=1,Npoints 278 if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level 279 if (lunits) then 280 if (r(i,j,k) <= 0.0) then 281 r(i,j,k) = R_UNDEF 282 else 283 r(i,j,k) = 10.0*log10(r(i,j,k)) 284 endif 223 285 endif 224 enddo 225 enddo 226 do i=1,Npoints 227 if (zu(k) > zhalf(i,1)) then ! Level above model bottom level 228 if (ws(i) > 0.0) r(i,j,k) = sumwyp(i)/ws(i) 286 else ! Level below surface 287 r(i,j,k) = R_GROUND 229 288 endif 230 289 enddo 231 290 enddo 232 291 enddo 233 ! Check for dBZ and change if necessary234 if (lunits) then235 do k=1,M236 do j=1,Ncolumns237 do i=1,Npoints238 if (zu(k) > zhalf(i,1)) then ! Level above model bottom level239 if (r(i,j,k) <= 0.0) then240 r(i,j,k) = R_UNDEF241 else242 r(i,j,k) = 10.0*log10(r(i,j,k))243 endif244 endif245 enddo246 enddo247 enddo248 endif249 250 251 292 252 293 END SUBROUTINE COSP_CHANGE_VERTICAL_GRID -
LMDZ5/trunk/libf/phylmd/cosp/cosp_types.F90
r1907 r2428 23 23 ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 24 25 !26 ! History:27 ! Jul 2007 - A. Bodas-Salcedo - Initial version28 ! Feb 2008 - R. Marchand - Added Quickbeam types and initialisation29 ! Oct 2008 - H. Chepfer - Added PARASOL reflectance diagnostic30 ! Nov 2008 - R. Marchand - Added MISR diagnostics31 ! Nov 2008 - V. John - Added RTTOV diagnostics32 !33 !34 25 MODULE MOD_COSP_TYPES 35 26 USE MOD_COSP_CONSTANTS 36 27 USE MOD_COSP_UTILS 37 28 38 use radar_simulator_types, only: class_param, mie, nd, mt_nd, dmax, dmin, mt_ttl, mt_tti, cnt_liq, cnt_ice ! added by roj Feb 200829 use radar_simulator_types, only: class_param, nd, mt_nd, dmax, dmin 39 30 40 31 IMPLICIT NONE 41 32 42 33 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 43 34 !----------------------- DERIVED TYPES ---------------------------- … … 46 37 ! Configuration choices (simulators, variables) 47 38 TYPE COSP_CONFIG 48 logical :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim,Lstats,Lwrite_output, & 49 Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, & 50 Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2,Lcllcalipso, & 51 Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp,Ltclisccp, & 52 Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 53 Lfrac_out,Lbeta_mol532,Ltbrttov 39 logical :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim,Lstats,Lwrite_output, & 40 Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,LcfadDbze94, & 41 LcfadLidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp,Lcllcalipso, & 42 Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lpctisccp,Ldbze94,Ltauisccp,Lcltisccp, & 43 Ltoffset,LparasolRefl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 44 Lclcalipsoliq,Lclcalipsoice,Lclcalipsoun, & 45 Lclcalipsotmp,Lclcalipsotmpliq,Lclcalipsotmpice,Lclcalipsotmpun, & 46 Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun, & 47 Lclhcalipsoliq,Lclhcalipsoice,Lclhcalipsoun, & 48 Lclmcalipsoliq,Lclmcalipsoice,Lclmcalipsoun, & 49 Lcllcalipsoliq,Lcllcalipsoice,Lcllcalipsoun, & 50 Lfracout,LlidarBetaMol532,Ltbrttov, & 51 Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, & 52 Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, & 53 Liwpmodis,Lclmodis 54 54 55 character(len=32) :: out_list(N_OUT_LIST) 55 56 END TYPE COSP_CONFIG … … 145 146 ! Arrays with dimensions (Npoints,Nlevels) 146 147 real,dimension(:,:),pointer :: beta_mol ! Molecular backscatter 148 real,dimension(:,:),pointer :: temp_tot 147 149 ! Arrays with dimensions (Npoints,Ncolumns,Nlevels) 150 real,dimension(:,:,:),pointer :: betaperp_tot ! Total backscattered signal 148 151 real,dimension(:,:,:),pointer :: beta_tot ! Total backscattered signal 149 152 real,dimension(:,:,:),pointer :: tau_tot ! Optical thickness integrated from top to level z … … 197 200 real, dimension(:,:),pointer :: lidarcld ! 3D "lidar" cloud fraction 198 201 ! Arrays with dimensions (Npoints,LIDAR_NCAT) 199 real, dimension(:,:),pointer :: cldlayer ! low, mid, high-level lidar cloud cover 202 real, dimension(:,:),pointer :: cldlayer ! low, mid, high-level, total lidar cloud cover 203 ! Arrays with dimensions (Npoints,Nlevels,Nphase) 204 real, dimension(:,:,:),pointer :: lidarcldphase ! 3D "lidar" phase cloud fraction 205 ! Arrays with dimensions (Npoints,LIDAR_NCAT,Nphase) 206 real, dimension(:,:,:),pointer :: cldlayerphase ! low, mid, high-level lidar phase cloud cover 207 ! Arrays with dimensions (Npoints,Ntemps,Nphase) 208 real, dimension(:,:,:),pointer :: lidarcldtmp ! 3D "lidar" phase cloud temperature 200 209 ! Arrays with dimensions (Npoints,PARASOL_NREFL) 201 210 real, dimension(:,:),pointer :: parasolrefl ! mean parasol reflectance … … 230 239 ! (Reff==0 means use default size) 231 240 ! (Npoints,Ncolumns,Nlevels,Nhydro) [m] 241 real,dimension(:,:,:,:),pointer :: Np ! Total # concentration each hydrometeor 242 ! (Optional, ignored if Reff > 0). 243 ! (Npoints,Ncolumns,Nlevels,Nhydro) [#/kg] 244 ! Np = Ntot / rho_a = [#/m^3] / [kg/m^3) 245 ! added by Roj with Quickbeam V3 232 246 END TYPE COSP_SGHYDRO 233 247 … … 246 260 ! Time [days] 247 261 double precision :: time 262 double precision :: time_bnds(2) 248 263 249 264 ! Radar ancillary info … … 251 266 k2 ! |K|^2, -1=use frequency dependent default 252 267 integer :: surface_radar, & ! surface=1, spaceborne=0 253 254 255 256 268 use_mie_tables, & ! use a precomputed loopup table? yes=1,no=0 269 use_gas_abs, & ! include gaseous absorption? yes=1,no=0 270 do_ray, & ! calculate/output Rayleigh refl=1, not=0 271 melt_lay ! melting layer model off=0, on=1 257 272 258 273 ! structures used by radar simulator that need to be set only ONCE per radar configuration (e.g. freq, pointing direction) ... added by roj Feb 2008 259 type(class_param) :: hp ! structure used by radar simulator to store Ze and N scaling constants and other information 260 type(mie):: mt ! structure used by radar simulator to store mie LUT information 261 integer :: nsizes ! number of discrete drop sizes (um) used to represent the distribution 262 real*8, dimension(:), pointer :: D ! array of discrete drop sizes (um) used to represent the distribution 263 real*8, dimension(:), pointer :: mt_ttl, mt_tti ! array of temperatures used with Ze_scaling (also build into mie LUT) 274 type(class_param) :: hp ! structure used by radar simulator to store Ze and N scaling constants and other information 275 integer :: nsizes ! number of discrete drop sizes (um) used to represent the distribution 264 276 265 277 ! Lidar … … 269 281 ! Radar 270 282 logical :: use_precipitation_fluxes ! True if precipitation fluxes are input to the algorithm 271 logical :: use_reff ! True if Reff is to be used by radar 283 logical :: use_reff ! True if Reff is to be used by radar (memory not allocated 284 272 285 273 286 ! Geolocation (Npoints) 287 real,dimension(:),pointer :: toffset ! Time offset of esch point from the value in time 274 288 real,dimension(:),pointer :: longitude ! longitude [degrees East] 275 289 real,dimension(:),pointer :: latitude ! latitude [deg North] … … 302 316 real,dimension(:),pointer :: sunlit ! (npoints) 1 for day points, 0 for nightime 303 317 real,dimension(:),pointer :: skt ! Skin temperature (K) 304 real,dimension(:),pointer :: sfc_height ! Surface height [m]305 318 real,dimension(:),pointer :: u_wind ! eastward wind [m s-1] 306 319 real,dimension(:),pointer :: v_wind ! northward wind [m s-1] … … 319 332 real,dimension(:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor (Npoints,Nlevels,Nhydro) [kg/kg] 320 333 real,dimension(:,:),pointer :: dist_prmts_hydro !Distributional parameters for hydrometeors (Nprmts_max_hydro,Nhydro) 321 ! Effective radius [m]. (Npoints,Nlevels,Nhydro) 334 335 ! Effective radius [m]. (Npoints,Nlevels,Nhydro) -- OPTIONAL, value of 0 mean use fixed default 322 336 real,dimension(:,:,:),pointer :: Reff 337 338 ! Total Number Concentration [#/kg]. (Npoints,Nlevels,Nhydro) -- OPTIONAL, value of 0 mean use fixed default 339 real,dimension(:,:,:),pointer :: Np ! added by Roj with Quickbeam V3 340 323 341 ! Aerosols concentration and distribution parameters 324 342 real,dimension(:,:,:),pointer :: conc_aero ! Aerosol concentration for each species (Npoints,Nlevels,Naero) … … 373 391 !------------- SUBROUTINE CONSTRUCT_COSP_RTTOV ------------------- 374 392 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 375 SUBROUTINE CONSTRUCT_COSP_RTTOV(Npoints,Nchan,x) 393 SUBROUTINE CONSTRUCT_COSP_RTTOV(cfg,Npoints,Nchan,x) 394 type(cosp_config),intent(in) :: cfg ! Configuration options 376 395 integer,intent(in) :: Npoints ! Number of sampled points 377 396 integer,intent(in) :: Nchan ! Number of channels 378 397 type(cosp_rttov),intent(out) :: x 379 380 ! Dimensions 381 x%Npoints = Npoints 382 x%Nchan = Nchan 398 ! Local variables 399 integer :: i,j 400 401 ! Allocate minumum storage if simulator not used 402 if (cfg%Lrttov_sim) then 403 i = Npoints 404 j = Nchan 405 else 406 i = 1 407 j = 1 408 endif 409 x%Npoints = i 410 x%Nchan = j 383 411 384 412 ! --- Allocate arrays --- 385 allocate(x%tbs( Npoints, Nchan))413 allocate(x%tbs(i, j)) 386 414 ! --- Initialise to zero --- 387 415 x%tbs = 0.0 … … 608 636 ! --- Allocate arrays --- 609 637 allocate(x%beta_mol(i,k), x%beta_tot(i,j,k), & 610 x%tau_tot(i,j,k),x%refl(i,j,m)) 638 x%tau_tot(i,j,k),x%refl(i,j,m), & 639 x%temp_tot(i,k),x%betaperp_tot(i,j,k)) 611 640 ! --- Initialise to zero --- 612 641 x%beta_mol = 0.0 … … 614 643 x%tau_tot = 0.0 615 644 x%refl = 0.0 ! parasol 645 x%temp_tot = 0.0 646 x%betaperp_tot = 0.0 616 647 END SUBROUTINE CONSTRUCT_COSP_SGLIDAR 617 648 … … 622 653 type(cosp_sglidar),intent(inout) :: x 623 654 624 deallocate(x%beta_mol, x%beta_tot, x%tau_tot, x%refl) 655 deallocate(x%beta_mol, x%beta_tot, x%tau_tot, x%refl, & 656 x%temp_tot, x%betaperp_tot) 657 625 658 END SUBROUTINE FREE_COSP_SGLIDAR 626 659 … … 766 799 767 800 ! --- Allocate arrays --- 768 allocate(x%srbval(SR_BINS),x%cfad_sr(i,SR_BINS,k), & 801 allocate(x%srbval(SR_BINS),x%cfad_sr(i,SR_BINS,k), & 769 802 x%lidarcld(i,k), x%cldlayer(i,LIDAR_NCAT), x%parasolrefl(i,m)) 803 allocate(x%lidarcldphase(i,k,6),x%lidarcldtmp(i,LIDAR_NTEMP,5),& 804 x%cldlayerphase(i,LIDAR_NCAT,6)) 770 805 ! --- Initialise to zero --- 771 806 x%srbval = 0.0 … … 774 809 x%cldlayer = 0.0 775 810 x%parasolrefl = 0.0 776 END SUBROUTINE CONSTRUCT_COSP_LIDARSTATS 811 x%lidarcldphase = 0.0 812 x%cldlayerphase = 0.0 813 x%lidarcldtmp = 0.0 814 815 END SUBROUTINE CONSTRUCT_COSP_LIDARSTATS 777 816 778 817 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% … … 783 822 784 823 deallocate(x%srbval, x%cfad_sr, x%lidarcld, x%cldlayer, x%parasolrefl) 824 deallocate(x%cldlayerphase, x%lidarcldtmp, x%lidarcldphase) 785 825 END SUBROUTINE FREE_COSP_LIDARSTATS 786 826 787 827 788 828 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% … … 849 889 ! --- Allocate arrays --- 850 890 allocate(y%mr_hydro(Npoints,Ncolumns,Nlevels,Nhydro), & 851 y%Reff(Npoints,Ncolumns,Nlevels,Nhydro)) 891 y%Reff(Npoints,Ncolumns,Nlevels,Nhydro), & 892 y%Np(Npoints,Ncolumns,Nlevels,Nhydro)) ! added by roj with Quickbeam V3 893 852 894 ! --- Initialise to zero --- 853 895 y%mr_hydro = 0.0 854 896 y%Reff = 0.0 897 y%Np = 0.0 ! added by roj with Quickbeam V3 855 898 856 899 END SUBROUTINE CONSTRUCT_COSP_SGHYDRO … … 863 906 864 907 ! --- Deallocate arrays --- 865 deallocate(y%mr_hydro, y%Reff )908 deallocate(y%mr_hydro, y%Reff, y%Np) ! added by Roj with Quickbeam V3 866 909 867 910 END SUBROUTINE FREE_COSP_SGHYDRO … … 870 913 !------------- SUBROUTINE CONSTRUCT_COSP_GRIDBOX ------------------ 871 914 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 872 SUBROUTINE CONSTRUCT_COSP_GRIDBOX(time, radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &873 Npoints,Nlevels,Ncolumns,Nhydro,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, & 915 SUBROUTINE CONSTRUCT_COSP_GRIDBOX(time,time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, & 916 Npoints,Nlevels,Ncolumns,Nhydro,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, & 874 917 lidar_ice_type,isccp_top_height,isccp_top_height_direction,isccp_overlap,isccp_emsfc_lw, & 875 918 use_precipitation_fluxes,use_reff, & 876 919 ! RTTOV inputs 877 920 Plat,Sat,Inst,Nchan,ZenAng,Ichan,SurfEm,co2,ch4,n2o,co,& 878 y )921 y,load_LUT) 879 922 double precision,intent(in) :: time ! Time since start of run [days] 923 double precision,intent(in) :: time_bnds(2) ! Time boundaries 880 924 real,intent(in) :: radar_freq, & ! Radar frequency [GHz] 881 925 k2 ! |K|^2, -1=use frequency dependent default … … 909 953 real,intent(in) :: co2,ch4,n2o,co 910 954 type(cosp_gridbox),intent(out) :: y 911 912 955 logical,intent(in),optional :: load_LUT 956 957 913 958 ! local variables 914 integer i, cnt_ice, cnt_liq 915 character*200 :: mie_table_name ! Mie table name 916 real*8 :: delt, deltp 917 959 character*240 :: LUT_file_name 960 logical :: local_load_LUT 961 962 if (present(load_LUT)) then 963 local_load_LUT = load_LUT 964 else 965 local_load_LUT = RADAR_SIM_LOAD_scale_LUTs_flag 966 endif 967 918 968 ! Dimensions and scalars 919 969 y%radar_freq = radar_freq … … 940 990 y%use_reff = use_reff 941 991 942 y%time = time 992 y%time = time 993 y%time_bnds = time_bnds 943 994 944 995 ! RTTOV parameters … … 966 1017 967 1018 ! Surface information and geolocation (Npoints) 968 allocate(y% longitude(Npoints),y%latitude(Npoints),y%psfc(Npoints), y%land(Npoints), &969 y%sunlit(Npoints),y%skt(Npoints),y% sfc_height(Npoints),y%u_wind(Npoints),y%v_wind(Npoints))1019 allocate(y%toffset(Npoints), y%longitude(Npoints),y%latitude(Npoints),y%psfc(Npoints), y%land(Npoints), & 1020 y%sunlit(Npoints),y%skt(Npoints),y%u_wind(Npoints),y%v_wind(Npoints)) 970 1021 ! Hydrometeors concentration and distribution parameters 971 1022 allocate(y%mr_hydro(Npoints,Nlevels,Nhydro), & 972 1023 y%dist_prmts_hydro(Nprmts_max_hydro,Nhydro), & 973 y%Reff(Npoints,Nlevels,Nhydro)) 1024 y%Reff(Npoints,Nlevels,Nhydro), & 1025 y%Np(Npoints,Nlevels,Nhydro)) ! added by Roj with Quickbeam V3 974 1026 ! Aerosols concentration and distribution parameters 975 1027 allocate(y%conc_aero(Npoints,Nlevels,Naero), y%dist_type_aero(Naero), & … … 1004 1056 y%snow_cv = 0.0 1005 1057 y%Reff = 0.0 1058 y%Np = 0.0 ! added by Roj with Quickbeam V3 1006 1059 y%mr_ozone = 0.0 1007 1060 y%u_wind = 0.0 … … 1010 1063 1011 1064 ! (Npoints) 1012 ! call zero_real(y%psfc, y%land) 1065 y%toffset = 0.0 1013 1066 y%longitude = 0.0 1014 1067 y%latitude = 0.0 … … 1017 1070 y%sunlit = 0.0 1018 1071 y%skt = 0.0 1019 y%sfc_height = 0.01020 1072 ! (Npoints,Nlevels,Nhydro) 1021 1073 ! y%fr_hydro = 0.0 … … 1027 1079 y%dist_prmts_aero = 0.0 ! (Npoints,Nlevels,Nprmts_max_aero,Naero) 1028 1080 1029 y%hp%p1 = 0.0 1030 y%hp%p2 = 0.0 1031 y%hp%p3 = 0.0 1032 y%hp%dmin = 0.0 1033 y%hp%dmax = 0.0 1034 y%hp%apm = 0.0 1035 y%hp%bpm = 0.0 1036 y%hp%rho = 0.0 1037 y%hp%dtype = 0 1038 y%hp%col = 0 1039 y%hp%cp = 0 1040 y%hp%phase = 0 1041 y%hp%scaled = .false. 1042 y%hp%z_flag = .false. 1043 y%hp%Ze_scaled = 0.0 1044 y%hp%Zr_scaled = 0.0 1045 y%hp%kr_scaled = 0.0 1046 y%hp%fc = 0.0 1047 y%hp%rho_eff = 0.0 1048 y%hp%ifc = 0 1049 y%hp%idd = 0 1050 y%mt%freq = 0.0 1051 y%mt%tt = 0.0 1052 y%mt%f = 0.0 1053 y%mt%D = 0.0 1054 y%mt%qext = 0.0 1055 y%mt%qbsca = 0.0 1056 y%mt%phase = 0 1057 1058 1059 ! --- Initialize the distributional parameters for hydrometeors 1060 y%dist_prmts_hydro( 1,:) = HCLASS_TYPE(:) 1061 y%dist_prmts_hydro( 2,:) = HCLASS_COL(:) 1062 y%dist_prmts_hydro( 3,:) = HCLASS_PHASE(:) 1063 y%dist_prmts_hydro( 4,:) = HCLASS_CP(:) 1064 y%dist_prmts_hydro( 5,:) = HCLASS_DMIN(:) 1065 y%dist_prmts_hydro( 6,:) = HCLASS_DMAX(:) 1066 y%dist_prmts_hydro( 7,:) = HCLASS_APM(:) 1067 y%dist_prmts_hydro( 8,:) = HCLASS_BPM(:) 1068 y%dist_prmts_hydro( 9,:) = HCLASS_RHO(:) 1069 y%dist_prmts_hydro(10,:) = HCLASS_P1(:) 1070 y%dist_prmts_hydro(11,:) = HCLASS_P2(:) 1071 y%dist_prmts_hydro(12,:) = HCLASS_P3(:) 1072 1073 ! the following code added by roj to initialize structures used by radar simulator, Feb 2008 1074 call load_hydrometeor_classes(y%Nprmts_max_hydro,y%dist_prmts_hydro(:,:),y%hp,y%Nhydro) 1075 1076 ! load mie tables ? 1077 if (y%use_mie_tables == 1) then 1078 1079 ! ----- Mie tables ---- 1080 mie_table_name='mie_table.dat' 1081 call load_mie_table(mie_table_name,y%mt) 1082 1083 ! :: D specified by table ... not must match that used when mie LUT generated! 1084 y%nsizes = mt_nd 1085 allocate(y%D(y%nsizes)) 1086 y%D = y%mt%D 1087 1088 else 1089 ! otherwise we still need to initialize temperature arrays for Ze scaling (which is only done when not using mie table) 1090 1091 cnt_ice=19 1092 cnt_liq=20 1093 if (.not.(allocated(mt_ttl).and.allocated(mt_tti))) then 1094 allocate(mt_ttl(cnt_liq),mt_tti(cnt_ice)) ! note needed as this is global array ... 1095 ! which should be changed in the future 1096 endif 1097 1098 do i=1,cnt_ice 1099 mt_tti(i)=(i-1)*5-90 1100 enddo 1101 1102 do i=1,cnt_liq 1103 mt_ttl(i)=(i-1)*5 - 60 1104 enddo 1105 1106 allocate(y%mt_ttl(cnt_liq),y%mt_tti(cnt_ice)) 1107 1108 y%mt_ttl = mt_ttl 1109 y%mt_tti = mt_tti 1110 1111 ! !------ OLD code in v0.1 --------------------------- 1112 ! allocate(mt_ttl(2),mt_tti(2)) 1113 ! allocate(y%mt_ttl(2),y%mt_tti(2)) 1114 ! mt_ttl = 0.0 1115 ! mt_tti = 0.0 1116 ! y%mt_ttl = mt_ttl 1117 ! y%mt_tti = mt_tti 1118 ! !--------------------------------------------------- 1119 1120 ! :: D created on a log-linear scale 1121 y%nsizes = nd 1122 delt = (log(dmax)-log(dmin))/(y%nsizes-1) 1123 deltp = exp(delt) 1124 allocate(y%D(y%nsizes)) 1125 y%D(1) = dmin 1126 do i=2,y%nsizes 1127 y%D(i) = y%D(i-1)*deltp 1128 enddo 1129 1081 1082 ! NOTE: This location use to contain initialization of some radar simulator variables 1083 ! this initialization (including use of the variable "dist_prmts_hydro" - now obselete) 1084 ! has been unified in the quickbeam v3 subroutine "radar_simulator_init". Roj, June 2010 1085 1086 ! --- Initialize the distributional parameters for hydrometeors in radar simulator 1087 1088 write(*,*) 'RADAR_SIM microphysics scheme is set to: ', & 1089 trim(RADAR_SIM_MICROPHYSICS_SCHEME_NAME) 1090 1091 1092 if(y%Nhydro.ne.N_HYDRO) then 1093 1094 write(*,*) 'Number of hydrometeor input to subroutine', & 1095 ' CONSTRUCT_COSP_GRIDBOX does not match value', & 1096 ' specified in cosp_constants.f90!' 1097 write(*,*) 1130 1098 endif 1131 1099 1100 ! NOTE: SAVE_scale_LUTs_flag is hard codded as .false. here 1101 ! so that radar simulator will NOT update LUT each time it 1102 ! is called, but rather will update when "Free_COSP_GRIDBOX" is called! 1103 ! Roj, June 2010 1104 1105 LUT_file_name = trim(RADAR_SIM_LUT_DIRECTORY) // & 1106 trim(RADAR_SIM_MICROPHYSICS_SCHEME_NAME) 1107 1108 call radar_simulator_init(radar_freq,k2, & 1109 use_gas_abs,do_ray,R_UNDEF, & 1110 y%Nhydro, & 1111 HCLASS_TYPE,HCLASS_PHASE, & 1112 HCLASS_DMIN,HCLASS_DMAX, & 1113 HCLASS_APM,HCLASS_BPM,HCLASS_RHO, & 1114 HCLASS_P1,HCLASS_P2,HCLASS_P3, & 1115 local_load_LUT, & 1116 .false., & 1117 LUT_file_name, & 1118 y%hp) 1132 1119 1133 1120 END SUBROUTINE CONSTRUCT_COSP_GRIDBOX 1134 1121 1135 1122 1136 1123 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1137 1124 !------------- SUBROUTINE FREE_COSP_GRIDBOX ----------------------- 1138 1125 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1139 SUBROUTINE FREE_COSP_GRIDBOX(y,dglobal) 1126 SUBROUTINE FREE_COSP_GRIDBOX(y,dglobal,save_LUT) 1127 1128 use scale_LUTs_io 1129 1140 1130 type(cosp_gridbox),intent(inout) :: y 1141 1131 logical,intent(in),optional :: dglobal 1142 1143 ! --- Free arrays --- 1144 deallocate(y%D,y%mt_ttl,y%mt_tti) ! added by roj Feb 2008 1145 if (.not.present(dglobal)) deallocate(mt_ttl,mt_tti) 1146 1147 ! deallocate(y%hp%p1,y%hp%p2,y%hp%p3,y%hp%dmin,y%hp%dmax,y%hp%apm,y%hp%bpm,y%hp%rho, & 1148 ! y%hp%dtype,y%hp%col,y%hp%cp,y%hp%phase,y%hp%scaled, & 1149 ! y%hp%z_flag,y%hp%Ze_scaled,y%hp%Zr_scaled,y%hp%kr_scaled, & 1150 ! y%hp%fc, y%hp%rho_eff, y%hp%ifc, y%hp%idd) 1151 ! deallocate(y%mt%freq, y%mt%tt, y%mt%f, y%mt%D, y%mt%qext, y%mt%qbsca, y%mt%phase) 1152 1132 logical,intent(in),optional :: save_LUT 1133 1134 logical :: local_save_LUT 1135 1136 if (present(save_LUT)) then 1137 local_save_LUT = save_LUT 1138 else 1139 local_save_LUT = RADAR_SIM_UPDATE_scale_LUTs_flag 1140 endif 1141 1142 ! save any updates to radar simulator LUT 1143 if (local_save_LUT) call save_scale_LUTs(y%hp) 1144 1153 1145 deallocate(y%zlev, y%zlev_half, y%dlev, y%p, y%ph, y%T, y%q, & 1154 1146 y%sh, y%dtau_s, y%dtau_c, y%dem_s, y%dem_c, & 1155 y% longitude,y%latitude,y%psfc, y%land, y%tca, y%cca, &1147 y%toffset, y%longitude,y%latitude,y%psfc, y%land, y%tca, y%cca, & 1156 1148 y%mr_hydro, y%dist_prmts_hydro, & 1157 1149 y%conc_aero, y%dist_type_aero, y%dist_prmts_aero, & 1158 1150 y%rain_ls, y%rain_cv, y%snow_ls, y%snow_cv, y%grpl_ls, & 1159 y%sunlit, y%skt, y%sfc_height, y%Reff,y%ichan,y%surfem, & 1151 y%sunlit, y%skt, y%Reff,y%Np, & 1152 y%ichan,y%surfem, & 1160 1153 y%mr_ozone,y%u_wind,y%v_wind) 1161 1154 1162 1155 END SUBROUTINE FREE_COSP_GRIDBOX 1163 1164 1156 1165 1157 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% … … 1169 1161 type(cosp_gridbox),intent(in) :: x 1170 1162 type(cosp_gridbox),intent(inout) :: y 1171 1163 1172 1164 integer :: i,j,k,sz(3) 1173 1165 double precision :: tny 1174 1166 1175 1167 tny = tiny(tny) 1176 1168 y%hp%p1 = x%hp%p1 … … 1189 1181 y%hp%fc = x%hp%fc 1190 1182 y%hp%rho_eff = x%hp%rho_eff 1191 y%hp%ifc = x%hp%ifc1192 y%hp%idd = x%hp%idd1193 sz = shape(x%hp% z_flag)1183 ! y%hp%ifc = x%hp%ifc obsolete, Roj, June 2010 1184 ! y%hp%idd = x%hp%idd 1185 sz = shape(x%hp%Z_scale_flag) 1194 1186 do k=1,sz(3) 1195 1187 do j=1,sz(2) 1196 1188 do i=1,sz(1) 1197 if (x%hp% scaled(i,k)) y%hp%scaled(i,k) = .true.1198 if (x%hp% z_flag(i,j,k)) y%hp%z_flag(i,j,k) = .true.1189 if (x%hp%N_scale_flag(i,k)) y%hp%N_scale_flag(i,k) = .true. 1190 if (x%hp%Z_scale_flag(i,j,k)) y%hp%Z_scale_flag(i,j,k) = .true. 1199 1191 if (abs(x%hp%Ze_scaled(i,j,k)) > tny) y%hp%Ze_scaled(i,j,k) = x%hp%Ze_scaled(i,j,k) 1200 1192 if (abs(x%hp%Zr_scaled(i,j,k)) > tny) y%hp%Zr_scaled(i,j,k) = x%hp%Zr_scaled(i,j,k) … … 1214 1206 type(cosp_gridbox),intent(inout) :: y 1215 1207 1216 integer :: i,j,k,sz(3)1217 1218 1208 ! --- Copy arrays without Npoints as dimension --- 1219 1209 y%dist_prmts_hydro = x%dist_prmts_hydro 1220 1210 y%dist_type_aero = x%dist_type_aero 1221 y%D = x%D 1222 y%mt_ttl = x%mt_ttl 1223 y%mt_tti = x%mt_tti 1224 1211 1225 1212 1226 1213 ! call cosp_gridbox_cphp(x,y) … … 1233 1220 y%sunlit(iy(1):iy(2)) = x%sunlit(ix(1):ix(2)) 1234 1221 y%skt(iy(1):iy(2)) = x%skt(ix(1):ix(2)) 1235 y%sfc_height(iy(1):iy(2)) = x%sfc_height(ix(1):ix(2))1236 1222 y%u_wind(iy(1):iy(2)) = x%u_wind(ix(1):ix(2)) 1237 1223 y%v_wind(iy(1):iy(2)) = x%v_wind(ix(1):ix(2)) … … 1259 1245 ! 3D 1260 1246 y%Reff(iy(1):iy(2),:,:) = x%Reff(ix(1):ix(2),:,:) 1247 y%Np(iy(1):iy(2),:,:) = x%Np(ix(1):ix(2),:,:) ! added by Roj with Quickbeam V3 1261 1248 y%conc_aero(iy(1):iy(2),:,:) = x%conc_aero(ix(1):ix(2),:,:) 1262 1249 y%mr_hydro(iy(1):iy(2),:,:) = x%mr_hydro(ix(1):ix(2),:,:) … … 1297 1284 type(cosp_sglidar),intent(in) :: x 1298 1285 type(cosp_sglidar),intent(inout) :: y 1299 1286 1287 y%temp_tot(iy(1):iy(2),:) = x%temp_tot(ix(1):ix(2),:) 1288 y%betaperp_tot(iy(1):iy(2),:,:) = x%betaperp_tot(ix(1):ix(2),:,:) 1300 1289 y%beta_mol(iy(1):iy(2),:) = x%beta_mol(ix(1):ix(2),:) 1301 1290 y%beta_tot(iy(1):iy(2),:,:) = x%beta_tot(ix(1):ix(2),:,:) … … 1311 1300 type(cosp_isccp),intent(in) :: x 1312 1301 type(cosp_isccp),intent(inout) :: y 1313 1302 1314 1303 y%fq_isccp(iy(1):iy(2),:,:) = x%fq_isccp(ix(1):ix(2),:,:) 1315 1304 y%totalcldarea(iy(1):iy(2)) = x%totalcldarea(ix(1):ix(2)) … … 1375 1364 y%cldlayer(iy(1):iy(2),:) = x%cldlayer(ix(1):ix(2),:) 1376 1365 y%parasolrefl(iy(1):iy(2),:) = x%parasolrefl(ix(1):ix(2),:) 1366 y%lidarcldphase(iy(1):iy(2),:,:) = x%lidarcldphase(ix(1):ix(2),:,:) 1367 y%cldlayerphase(iy(1):iy(2),:,:) = x%cldlayerphase(ix(1):ix(2),:,:) 1368 y%lidarcldtmp(iy(1):iy(2),:,:) = x%lidarcldtmp(ix(1):ix(2),:,:) 1377 1369 END SUBROUTINE COSP_LIDARSTATS_CPSECTION 1370 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1371 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1372 !------------- PRINT SUBROUTINES -------------- 1373 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1374 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1375 SUBROUTINE COSP_GRIDBOX_PRINT(x) 1376 type(cosp_gridbox),intent(in) :: x 1377 1378 print *, '%%%%----- Information on COSP_GRIDBOX ------' 1379 ! Scalars and dimensions 1380 print *, x%Npoints 1381 print *, x%Nlevels 1382 print *, x%Ncolumns 1383 print *, x%Nhydro 1384 print *, x%Nprmts_max_hydro 1385 print *, x%Naero 1386 print *, x%Nprmts_max_aero 1387 print *, x%Npoints_it 1388 1389 ! Time [days] 1390 print *, x%time 1391 1392 ! Radar ancillary info 1393 print *, x%radar_freq, & 1394 x%k2 1395 print *, x%surface_radar, & 1396 x%use_mie_tables, & 1397 x%use_gas_abs, & 1398 x%do_ray, & 1399 x%melt_lay 1400 1401 ! print *, 'shape(x%): ',shape(x%) 1402 1403 ! type(class_param) :: hp ! structure used by radar simulator to store Ze and N scaling constants and other information 1404 ! type(mie):: mt ! structure used by radar simulator to store mie LUT information 1405 print *, x%nsizes 1406 1407 ! Lidar 1408 print *, x%lidar_ice_type 1409 1410 ! Radar 1411 print *, x%use_precipitation_fluxes 1412 print *, x%use_reff 1413 1414 ! Geolocation (Npoints) 1415 print *, 'shape(x%longitude): ',shape(x%longitude) 1416 print *, 'shape(x%latitude): ',shape(x%latitude) 1417 ! Gridbox information (Npoints,Nlevels) 1418 print *, 'shape(x%zlev): ',shape(x%zlev) 1419 print *, 'shape(x%zlev_half): ',shape(x%zlev_half) 1420 print *, 'shape(x%dlev): ',shape(x%dlev) 1421 print *, 'shape(x%p): ',shape(x%p) 1422 print *, 'shape(x%ph): ',shape(x%ph) 1423 print *, 'shape(x%T): ',shape(x%T) 1424 print *, 'shape(x%q): ',shape(x%q) 1425 print *, 'shape(x%sh): ',shape(x%sh) 1426 print *, 'shape(x%dtau_s): ',shape(x%dtau_s) 1427 print *, 'shape(x%dtau_c): ',shape(x%dtau_c) 1428 print *, 'shape(x%dem_s): ',shape(x%dem_s) 1429 print *, 'shape(x%dem_c): ',shape(x%dem_c) 1430 print *, 'shape(x%mr_ozone): ',shape(x%mr_ozone) 1431 1432 ! Point information (Npoints) 1433 print *, 'shape(x%land): ',shape(x%land) 1434 print *, 'shape(x%psfc): ',shape(x%psfc) 1435 print *, 'shape(x%sunlit): ',shape(x%sunlit) 1436 print *, 'shape(x%skt): ',shape(x%skt) 1437 print *, 'shape(x%u_wind): ',shape(x%u_wind) 1438 print *, 'shape(x%v_wind): ',shape(x%v_wind) 1439 1440 ! TOTAL and CONV cloud fraction for SCOPS 1441 print *, 'shape(x%tca): ',shape(x%tca) 1442 print *, 'shape(x%cca): ',shape(x%cca) 1443 ! Precipitation fluxes on model levels 1444 print *, 'shape(x%rain_ls): ',shape(x%rain_ls) 1445 print *, 'shape(x%rain_cv): ',shape(x%rain_cv) 1446 print *, 'shape(x%snow_ls): ',shape(x%snow_ls) 1447 print *, 'shape(x%snow_cv): ',shape(x%snow_cv) 1448 print *, 'shape(x%grpl_ls): ',shape(x%grpl_ls) 1449 ! Hydrometeors concentration and distribution parameters 1450 print *, 'shape(x%mr_hydro): ',shape(x%mr_hydro) 1451 print *, 'shape(x%dist_prmts_hydro): ',shape(x%dist_prmts_hydro) 1452 ! Effective radius [m]. (Npoints,Nlevels,Nhydro) 1453 print *, 'shape(x%Reff): ',shape(x%Reff) 1454 print *, 'shape(x%Np): ',shape(x%Np) ! added by roj with Quickbeam V3 1455 ! Aerosols concentration and distribution parameters 1456 print *, 'shape(x%conc_aero): ',shape(x%conc_aero) 1457 print *, 'shape(x%dist_type_aero): ',shape(x%dist_type_aero) 1458 print *, 'shape(x%dist_prmts_aero): ',shape(x%dist_prmts_aero) 1459 ! ISCCP simulator inputs 1460 print *, x%isccp_top_height 1461 print *, x%isccp_top_height_direction 1462 print *, x%isccp_overlap 1463 print *, x%isccp_emsfc_lw 1464 1465 ! RTTOV inputs/options 1466 print *, x%plat 1467 print *, x%sat 1468 print *, x%inst 1469 print *, x%Nchan 1470 print *, 'shape(x%Ichan): ',x%Ichan 1471 print *, 'shape(x%Surfem): ',x%Surfem 1472 print *, x%ZenAng 1473 print *, x%co2,x%ch4,x%n2o,x%co 1474 1475 END SUBROUTINE COSP_GRIDBOX_PRINT 1476 1477 SUBROUTINE COSP_MISR_PRINT(x) 1478 type(cosp_misr),intent(in) :: x 1479 1480 print *, '%%%%----- Information on COSP_MISR ------' 1481 1482 ! Dimensions 1483 print *, x%Npoints 1484 print *, x%Ntau 1485 print *, x%Nlevels 1486 1487 ! --- (npoints,ntau,nlevels) 1488 ! the fraction of the model grid box covered by each of the MISR cloud types 1489 print *, 'shape(x%fq_MISR): ',shape(x%fq_MISR) 1490 1491 ! --- (npoints) 1492 print *, 'shape(x%MISR_meanztop): ',shape(x%MISR_meanztop) 1493 print *, 'shape(x%MISR_cldarea): ',shape(x%MISR_cldarea) 1494 ! --- (npoints,nlevels) 1495 print *, 'shape(x%MISR_dist_model_layertops): ',shape(x%MISR_dist_model_layertops) 1496 1497 END SUBROUTINE COSP_MISR_PRINT 1498 1499 SUBROUTINE COSP_ISCCP_PRINT(x) 1500 type(cosp_isccp),intent(in) :: x 1501 1502 print *, x%Npoints 1503 print *, x%Ncolumns 1504 print *, x%Nlevels 1505 1506 print *, '%%%%----- Information on COSP_ISCCP ------' 1507 1508 print *, 'shape(x%fq_isccp): ',shape(x%fq_isccp) 1509 print *, 'shape(x%totalcldarea): ',shape(x%totalcldarea) 1510 print *, 'shape(x%meantb): ',shape(x%meantb) 1511 print *, 'shape(x%meantbclr): ',shape(x%meantbclr) 1512 1513 print *, 'shape(x%meanptop): ',shape(x%meanptop) 1514 print *, 'shape(x%meantaucld): ',shape(x%meantaucld) 1515 print *, 'shape(x%meanalbedocld): ',shape(x%meanalbedocld) 1516 print *, 'shape(x%boxtau): ',shape(x%boxtau) 1517 print *, 'shape(x%boxptop): ',shape(x%boxptop) 1518 END SUBROUTINE COSP_ISCCP_PRINT 1519 1520 SUBROUTINE COSP_VGRID_PRINT(x) 1521 type(cosp_vgrid),intent(in) :: x 1522 1523 print *, '%%%%----- Information on COSP_VGRID ------' 1524 print *, x%use_vgrid 1525 print *, x%csat_vgrid 1526 print *, x%Npoints 1527 print *, x%Ncolumns 1528 print *, x%Nlevels 1529 print *, x%Nlvgrid 1530 ! Array with dimensions (Nlvgrid) 1531 print *, 'shape(x%z): ',shape(x%z) 1532 print *, 'shape(x%zl): ',shape(x%zl) 1533 print *, 'shape(x%zu): ',shape(x%zu) 1534 ! Array with dimensions (Nlevels) 1535 print *, 'shape(x%mz): ',shape(x%mz) 1536 print *, 'shape(x%mzl): ',shape(x%mzl) 1537 print *, 'shape(x%mzu): ',shape(x%mzu) 1538 END SUBROUTINE COSP_VGRID_PRINT 1539 1540 SUBROUTINE COSP_SGLIDAR_PRINT(x) 1541 type(cosp_sglidar),intent(in) :: x 1542 1543 print *, '%%%%----- Information on COSP_SGLIDAR ------' 1544 ! Dimensions 1545 print *, x%Npoints 1546 print *, x%Ncolumns 1547 print *, x%Nlevels 1548 print *, x%Nhydro 1549 print *, x%Nrefl 1550 ! Arrays with dimensions (Npoints,Nlevels) 1551 print *, 'shape(x%beta_mol): ',shape(x%beta_mol) 1552 ! Arrays with dimensions (Npoints,Ncolumns,Nlevels) 1553 print *, 'shape(x%beta_tot): ',shape(x%beta_tot) 1554 print *, 'shape(x%tau_tot): ',shape(x%tau_tot) 1555 ! Arrays with dimensions (Npoints,Ncolumns,Nrefl) 1556 print *, 'shape(x%refl): ',shape(x%refl) 1557 END SUBROUTINE COSP_SGLIDAR_PRINT 1558 1559 SUBROUTINE COSP_SGRADAR_PRINT(x) 1560 type(cosp_sgradar),intent(in) :: x 1561 1562 print *, '%%%%----- Information on COSP_SGRADAR ------' 1563 print *, x%Npoints 1564 print *, x%Ncolumns 1565 print *, x%Nlevels 1566 print *, x%Nhydro 1567 ! output vertical levels: spaceborne radar -> from TOA to SURFACE 1568 ! Arrays with dimensions (Npoints,Nlevels) 1569 print *, 'shape(x%att_gas): ', shape(x%att_gas) 1570 ! Arrays with dimensions (Npoints,Ncolumns,Nlevels) 1571 print *, 'shape(x%Ze_tot): ', shape(x%Ze_tot) 1572 END SUBROUTINE COSP_SGRADAR_PRINT 1573 1574 SUBROUTINE COSP_RADARSTATS_PRINT(x) 1575 type(cosp_radarstats),intent(in) :: x 1576 1577 print *, '%%%%----- Information on COSP_SGRADAR ------' 1578 print *, x%Npoints 1579 print *, x%Ncolumns 1580 print *, x%Nlevels 1581 print *, x%Nhydro 1582 print *, 'shape(x%cfad_ze): ',shape(x%cfad_ze) 1583 print *, 'shape(x%radar_lidar_tcc): ',shape(x%radar_lidar_tcc) 1584 print *, 'shape(x%lidar_only_freq_cloud): ',shape(x%lidar_only_freq_cloud) 1585 END SUBROUTINE COSP_RADARSTATS_PRINT 1586 1587 SUBROUTINE COSP_LIDARSTATS_PRINT(x) 1588 type(cosp_lidarstats),intent(in) :: x 1589 1590 print *, '%%%%----- Information on COSP_SGLIDAR ------' 1591 print *, x%Npoints 1592 print *, x%Ncolumns 1593 print *, x%Nlevels 1594 print *, x%Nhydro 1595 print *, x%Nrefl 1596 1597 ! Arrays with dimensions (SR_BINS) 1598 print *, 'shape(x%srbval): ',shape(x%srbval) 1599 ! Arrays with dimensions (Npoints,SR_BINS,Nlevels) 1600 print *, 'shape(x%cfad_sr): ',shape(x%cfad_sr) 1601 ! Arrays with dimensions (Npoints,Nlevels) 1602 print *, 'shape(x%lidarcld): ',shape(x%lidarcld) 1603 ! Arrays with dimensions (Npoints,LIDAR_NCAT) 1604 print *, 'shape(x%cldlayer): ',shape(x%cldlayer) 1605 ! Arrays with dimensions (Npoints,PARASOL_NREFL) 1606 print *, 'shape(x%parasolrefl): ',shape(x%parasolrefl) 1607 ! Arrays with dimensions (Npoints,Nlevels,Nphase) 1608 print *, 'shape(x%lidarcldphase): ',shape(x%lidarcldphase) 1609 ! Arrays with dimensions (Npoints,LIDAR_NCAT,Nphase) 1610 print *, 'shape(x%cldlayerphase): ',shape(x%cldlayerphase) 1611 ! Arrays with dimensions (Npoints,Ntemps,Nphase) 1612 print *, 'shape(x%lidarcldphase): ',shape(x%lidarcldtmp) 1613 1614 END SUBROUTINE COSP_LIDARSTATS_PRINT 1615 1616 SUBROUTINE COSP_SUBGRID_PRINT(x) 1617 type(cosp_subgrid),intent(in) :: x 1618 1619 print *, '%%%%----- Information on COSP_SUBGRID ------' 1620 print *, x%Npoints 1621 print *, x%Ncolumns 1622 print *, x%Nlevels 1623 print *, x%Nhydro 1624 1625 print *, 'shape(x%prec_frac): ',shape(x%prec_frac) 1626 print *, 'shape(x%frac_out): ',shape(x%frac_out) 1627 END SUBROUTINE COSP_SUBGRID_PRINT 1628 1629 SUBROUTINE COSP_SGHYDRO_PRINT(x) 1630 type(cosp_sghydro),intent(in) :: x 1631 1632 print *, '%%%%----- Information on COSP_SGHYDRO ------' 1633 print *, x%Npoints 1634 print *, x%Ncolumns 1635 print *, x%Nlevels 1636 print *, x%Nhydro 1637 1638 print *, 'shape(x%mr_hydro): ',shape(x%mr_hydro) 1639 print *, 'shape(x%Reff): ',shape(x%Reff) 1640 print *, 'shape(x%Np): ',shape(x%Np) ! added by roj with Quickbeam V3 1641 END SUBROUTINE COSP_SGHYDRO_PRINT 1378 1642 1379 1643 END MODULE MOD_COSP_TYPES -
LMDZ5/trunk/libf/phylmd/cosp/cosp_utils.F90
r1907 r2428 1 1 ! (c) British Crown Copyright 2008, the Met Office. 2 2 ! All rights reserved. 3 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 4 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_utils.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 45 47 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 46 48 SUBROUTINE COSP_PRECIP_MXRATIO(Npoints,Nlevels,Ncolumns,p,T,prec_frac,prec_type, & 47 n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2, &48 flux,mxratio )49 n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4, & 50 flux,mxratio,reff) 49 51 50 52 ! Input arguments, (IN) … … 52 54 real,intent(in),dimension(Npoints,Nlevels) :: p,T,flux 53 55 real,intent(in),dimension(Npoints,Ncolumns,Nlevels) :: prec_frac 54 real,intent(in) :: n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2, prec_type56 real,intent(in) :: n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4,prec_type 55 57 ! Input arguments, (OUT) 56 58 real,intent(out),dimension(Npoints,Ncolumns,Nlevels) :: mxratio 59 real,intent(inout),dimension(Npoints,Ncolumns,Nlevels) :: reff 57 60 ! Local variables 58 61 integer :: i,j,k 59 real :: sigma,one_over_xip1,xi,rho0,rho 62 real :: sigma,one_over_xip1,xi,rho0,rho,lambda_x,gamma_4_3_2,delta 60 63 61 64 mxratio = 0.0 62 65 63 66 if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed 64 !gamma1 = gamma(alpha_x + b_x + d_x + 1.0)65 !gamma2 = gamma(alpha_x + b_x + 1.0)66 67 xi = d_x/(alpha_x + b_x - n_bx + 1.0) 67 68 rho0 = 1.29 68 69 sigma = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi 69 70 one_over_xip1 = 1.0/(xi + 1.0) 71 gamma_4_3_2 = 0.5*gamma4/gamma3 72 delta = (alpha_x + b_x + d_x - n_bx + 1.0) 70 73 71 74 do k=1,Nlevels … … 76 79 mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1 77 80 mxratio(i,j,k)=mxratio(i,j,k)/rho 81 ! Compute effective radius 82 if ((reff(i,j,k) <= 0.0).and.(flux(i,k) /= 0.0)) then 83 lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1./delta) 84 reff(i,j,k) = gamma_4_3_2/lambda_x 85 endif 78 86 endif 79 87 enddo -
LMDZ5/trunk/libf/phylmd/cosp/dsd.F90
r1907 r2428 1 subroutine dsd(Q,Re, D,N,nsizes,dtype,rho_a,tc, &2 dmin,dmax,apm,bpm,rho_c,p1,p2,p3 ,fc,scaled)1 subroutine dsd(Q,Re,Np,D,N,nsizes,dtype,rho_a,tk, & 2 dmin,dmax,apm,bpm,rho_c,p1,p2,p3) 3 3 use array_lib 4 4 use math_lib … … 7 7 ! Purpose: 8 8 ! Create a discrete drop size distribution 9 ! Part of QuickBeam v1.03 by John Haynes 9 ! 10 ! Starting with Quickbeam V3, this routine now allows input of 11 ! both effective radius (Re) and total number concentration (Nt) 12 ! Roj Marchand July 2010 13 ! 14 ! The version in Quickbeam v.104 was modified to allow Re but not Nt 15 ! This is a significantly modified form for the version 16 ! 17 ! Originally Part of QuickBeam v1.03 by John Haynes 10 18 ! http://reef.atmos.colostate.edu/haynes/radarsim 11 19 ! 12 20 ! Inputs: 21 ! 13 22 ! [Q] hydrometeor mixing ratio (g/kg) 14 ! [Re] Optional Effective Radius (microns). 0 = use default. 15 ! [D] discrete drop sizes (um) 23 ! [Re] Optional Effective Radius (microns). 0 = use defaults (p1, p2, p3) 24 ! 25 ! [D] array of discrete drop sizes (um) where we desire to know the number concentraiton n(D). 16 26 ! [nsizes] number of elements of [D] 27 ! 17 28 ! [dtype] distribution type 18 29 ! [rho_a] ambient air density (kg m^-3) 19 ! [t c] temperature (C)30 ! [tk] temperature (K) 20 31 ! [dmin] minimum size cutoff (um) 21 32 ! [dmax] maximum size cutoff (um) … … 24 35 ! 25 36 ! Input/Output: 26 ! [fc] scaling factor for the distribution27 ! [scaled] has this hydrometeor type been scaled?28 37 ! [apm] a parameter for mass (kg m^[-bpm]) 29 38 ! [bmp] b params for mass … … 41 50 ! 01/31/06 Port from IDL to Fortran 90 42 51 ! 07/07/06 Rewritten for variable DSD's 43 ! 10/02/06 Rewritten using scaling factors (Roger Marchand and JMH) 52 ! 10/02/06 Rewritten using scaling factors (Roger Marchand and JMH), Re added V1.04 53 ! July 2020 "N Scale factors" (variable fc) removed (Roj Marchand). 44 54 45 55 ! ----- INPUTS ----- 46 56 47 integer *4, intent(in) :: nsizes57 integer, intent(in) :: nsizes 48 58 integer, intent(in) :: dtype 49 real*8, intent(in) :: Q,D(nsizes),rho_a,tc,dmin,dmax, & 50 rho_c,p1,p2,p3 51 52 ! ----- INPUT/OUTPUT ----- 53 54 real*8, intent(inout) :: fc(nsizes),apm,bpm,Re 55 logical, intent(inout) :: scaled 56 59 real*8, intent(in) :: Q,Re,Np,D(nsizes) 60 real*8, intent(in) :: rho_a,tk,dmin,dmax,rho_c,p1,p2,p3 61 62 real*8, intent(inout) :: apm,bpm 63 57 64 ! ----- OUTPUTS ----- 58 65 … … 60 67 61 68 ! ----- INTERNAL ----- 62 69 70 real*8 :: fc(nsizes) 71 63 72 real*8 :: & 64 N0,D0,vu, np,dm,ld, &! gamma, exponential variables65 dmin_mm,dmax_mm,ahp,bhp, & 66 rg,log_sigma_g, & 67 rho_e 73 N0,D0,vu,local_np,dm,ld, & ! gamma, exponential variables 74 dmin_mm,dmax_mm,ahp,bhp, & ! power law variables 75 rg,log_sigma_g, & ! lognormal variables 76 rho_e ! particle density (kg m^-3) 68 77 69 78 real*8 :: tmp1, tmp2 70 real*8 :: pi,rc 79 real*8 :: pi,rc,tc 71 80 72 81 integer k,lidx,uidx 73 82 83 tc = tk - 273.15 74 84 pi = acos(-1.0) 75 85 76 ! // if density is constant, store equivalent values for apm and bpm86 ! // if density is constant, store equivalent values for apm and bpm 77 87 if ((rho_c > 0) .and. (apm < 0)) then 78 88 apm = (pi/6)*rho_c … … 80 90 endif 81 91 92 ! will preferentially use Re input over Np. 93 ! if only Np given then calculate Re 94 ! if neigher than use other defaults (p1,p2,p3) following quickbeam documentation 95 if(Re==0 .and. Np>0) then 96 97 call calc_Re(Q,Np,rho_a, & 98 dtype,dmin,dmax,apm,bpm,rho_c,p1,p2,p3, & 99 Re) 100 endif 101 102 82 103 select case(dtype) 83 104 … … 85 106 ! // modified gamma ! 86 107 ! ---------------------------------------------------------! 87 ! :: N0 = total number concentration (m^-3) 88 ! :: np = fixed number concentration (kg^-1) 108 ! :: np = total number concentration 89 109 ! :: D0 = characteristic diameter (um) 90 ! :: dm = mean diameter (um) 110 ! :: dm = mean diameter (um) - first moment over zeroth moment 91 111 ! :: vu = distribution width parameter 92 112 93 113 case(1) 94 if (abs(p1+1) < 1E-8) then 95 96 ! // D0, vu are given 114 115 if( abs(p3+2) < 1E-8) then 116 117 if( Np>1E-30) then 118 119 ! Morrison scheme with Martin 1994 shape parameter (NOTE: vu = pc +1) 120 ! fixed Roj. Dec. 2010 -- after comment by S. Mcfarlane 121 vu = (1/(0.2714 + 0.00057145*Np*rho_a*1E-6))**2.0 ! units of Nt = Np*rhoa = #/cm^3 122 else 123 print *, 'Error: Must specify a value for Np in each volume', & 124 ' with Morrison/Martin Scheme.' 125 stop 126 endif 127 128 elseif (abs(p3+1) > 1E-8) then 129 130 ! vu is fixed in hp structure 97 131 vu = p3 98 99 if(Re.le.0) then 100 dm = p2 101 D0 = gamma(vu)/gamma(vu+1)*dm 102 else 103 D0 = 2.0*Re*gamma(vu+2)/gamma(vu+3) 104 endif 105 106 if (scaled .eqv. .false.) then 107 132 133 else 134 135 ! vu isn't specified 136 137 print *, 'Error: Must specify a value for vu for Modified Gamma distribution' 138 stop 139 140 endif 141 142 if(Re>0) then 143 144 D0 = 2.0*Re*gamma(vu+2)/gamma(vu+3) 145 108 146 fc = ( & 109 147 ((D*1E-6)**(vu-1)*exp(-1*D/D0)) / & 110 148 (apm*((D0*1E-6)**(vu+bpm))*gamma(vu+bpm)) & 111 ) * 1E-12 112 scaled = .true. 113 114 endif 115 116 N = fc*rho_a*(Q*1E-3) 117 118 elseif (abs(p2+1) < 1E-8) then 119 120 ! // N0, vu are given 121 np = p1 122 vu = p3 123 tmp1 = (Q*1E-3)**(1./bpm) 124 125 if (scaled .eqv. .false.) then 126 127 fc = (D*1E-6 / (gamma(vu)/(apm*np*gamma(vu+bpm)))** & 149 ) * 1E-12 150 151 N = fc*rho_a*(Q*1E-3) 152 153 elseif( p2+1 > 1E-8) then ! use default value for MEAN diameter 154 155 dm = p2 156 D0 = gamma(vu)/gamma(vu+1)*dm 157 158 fc = ( & 159 ((D*1E-6)**(vu-1)*exp(-1*D/D0)) / & 160 (apm*((D0*1E-6)**(vu+bpm))*gamma(vu+bpm)) & 161 ) * 1E-12 162 163 N = fc*rho_a*(Q*1E-3) 164 165 elseif(abs(p3+1) > 1E-8) then! use default number concentration 166 167 local_np = p1 ! total number concentration / pa check 168 169 tmp1 = (Q*1E-3)**(1./bpm) 170 171 fc = (D*1E-6 / (gamma(vu)/(apm*local_np*gamma(vu+bpm)))** & 128 172 (1./bpm))**vu 129 130 scaled = .true. 131 173 174 N = ( & 175 (rho_a*local_np*fc*(D*1E-6)**(-1.))/(gamma(vu)*tmp1**vu) * & 176 exp(-1.*fc**(1./vu)/tmp1) & 177 ) * 1E-12 178 179 else 180 181 print *, 'Error: No default value for Dm or Np provided! ' 182 stop 183 132 184 endif 133 134 N = ( & 135 (rho_a*np*fc*(D*1E-6)**(-1.))/(gamma(vu)*tmp1**vu) * & 136 exp(-1.*fc**(1./vu)/tmp1) & 137 ) * 1E-12 138 139 else 140 141 ! // vu isn't given 142 print *, 'Error: Must specify a value for vu' 143 stop 144 145 endif 185 146 186 147 187 ! ---------------------------------------------------------! … … 152 192 153 193 case(2) 154 if (abs(p1+1) > 1E-8) then 155 156 ! // N0 has been specified, determine ld 157 N0 = p1 158 159 if(Re>0) then 160 161 ! if Re is set and No is set than the distribution is fully defined. 162 ! so we assume Re and No have already been chosen consistant with 163 ! the water content, Q. 164 165 ! print *,'using Re pass ...' 166 167 ld = 1.5/Re ! units 1/um 168 169 N = ( & 170 N0*exp(-1*ld*D) & 171 ) * 1E-12 172 173 else 174 175 tmp1 = 1./(1.+bpm) 176 177 if (scaled .eqv. .false.) then 178 fc = ((apm*gamma(1.+bpm)*N0)**tmp1)*(D*1E-6) 179 scaled = .true. 180 181 endif 194 195 if(Re>0) then 196 197 ld = 1.5/Re ! units 1/um 198 199 fc = (ld*1E6)**(1.+bpm)/(apm*gamma(1+bpm))* & 200 exp(-1.*(ld*1E6)*(D*1E-6))*1E-12 182 201 183 N = ( & 184 N0*exp(-1.*fc*(1./(rho_a*Q*1E-3))**tmp1) & 185 ) * 1E-12 186 187 endif 202 N = fc*rho_a*(Q*1E-3) 203 204 elseif (abs(p1+1) > 1E-8) then 205 206 ! use N0 default value 207 208 N0 = p1 209 210 tmp1 = 1./(1.+bpm) 211 212 fc = ((apm*gamma(1.+bpm)*N0)**tmp1)*(D*1E-6) 213 214 N = ( & 215 N0*exp(-1.*fc*(1./(rho_a*Q*1E-3))**tmp1) & 216 ) * 1E-12 188 217 189 218 elseif (abs(p2+1) > 1E-8) then 190 219 191 ! // ld has been specified, determine N0 192 ld = p2 193 194 if (scaled .eqv. .false.) then 220 ! used default value for lambda 221 ld = p2 195 222 196 223 fc = (ld*1E6)**(1.+bpm)/(apm*gamma(1+bpm))* & 197 224 exp(-1.*(ld*1E6)*(D*1E-6))*1E-12 198 scaled = .true. 199 200 endif 201 202 N = fc*rho_a*(Q*1E-3) 203 204 else 205 206 ! // ld will be determined from temperature, then N0 follows 225 226 N = fc*rho_a*(Q*1E-3) 227 228 else 229 230 ! ld "parameterized" from temperature (carry over from original Quickbeam). 207 231 ld = 1220*10.**(-0.0245*tc)*1E-6 208 232 N0 = ((ld*1E6)**(1+bpm)*Q*1E-3*rho_a)/(apm*gamma(1+bpm)) … … 223 247 224 248 case(3) 249 250 if(Re>0) then 251 print *, 'Variable Re not supported for ', & 252 'Power-Law distribution' 253 stop 254 elseif(Np>0) then 255 print *, 'Variable Np not supported for ', & 256 'Power-Law distribution' 257 stop 258 endif 225 259 226 260 ! :: br parameter … … 257 291 258 292 ! :: commented lines are original method with constant density 259 ! rc = 500. 293 ! rc = 500. ! (kg/m^3) 260 294 ! tmp1 = 6*rho_a*(bhp+4) 261 295 ! tmp2 = pi*rc*(dmax_mm**(bhp+4))*(1-(dmin_mm/dmax_mm)**(bhp+4)) … … 273 307 do k=lidx,uidx 274 308 275 309 N(k) = ( & 276 310 ahp*(D(k)*1E-3)**bhp & 277 311 ) * 1E-12 278 312 279 313 enddo 280 314 281 315 ! print *,'test=',ahp,bhp,ahp/(rho_a*Q),D(100),N(100),bpm,dmin_mm,dmax_mm 282 316 283 317 ! ---------------------------------------------------------! … … 288 322 case(4) 289 323 290 if (scaled .eqv. .false.) then 291 292 D0 = p1 324 if (Re>0) then 325 D0 = Re 326 else 327 D0 = p1 328 endif 329 293 330 rho_e = (6/pi)*apm*(D0*1E-6)**(bpm-3) 294 331 fc(1) = (6./(pi*D0**3*rho_e))*1E12 295 scaled = .true. 296 297 endif 298 299 N(1) = fc(1)*rho_a*(Q*1E-3) 332 N(1) = fc(1)*rho_a*(Q*1E-3) 300 333 301 334 ! ---------------------------------------------------------! … … 308 341 309 342 case(5) 310 if (abs(p1+1) < 1E-8 ) then343 if (abs(p1+1) < 1E-8 .or. Re>0 ) then 311 344 312 345 ! // rg, log_sigma_g are given … … 314 347 tmp2 = (bpm*log_sigma_g)**2. 315 348 if(Re.le.0) then 316 317 else 318 349 rg = p2 350 else 351 rg =Re*exp(-2.5*(log_sigma_g**2)) 319 352 endif 320 353 321 if (scaled .eqv. .false.) then 322 323 fc = 0.5 * ( & 324 (1./((2.*rg*1E-6)**(bpm)*apm*(2.*pi)**(0.5) * & 325 log_sigma_g*D*0.5*1E-6)) * & 326 exp(-0.5*((log(0.5*D/rg)/log_sigma_g)**2.+tmp2)) & 327 ) * 1E-12 328 scaled = .true. 329 354 fc = 0.5 * ( & 355 (1./((2.*rg*1E-6)**(bpm)*apm*(2.*pi)**(0.5) * & 356 log_sigma_g*D*0.5*1E-6)) * & 357 exp(-0.5*((log(0.5*D/rg)/log_sigma_g)**2.+tmp2)) & 358 ) * 1E-12 359 360 N = fc*rho_a*(Q*1E-3) 361 362 elseif (abs(p2+1) < 1E-8 .or. Np>0) then 363 364 ! // Np, log_sigma_g are given 365 if(Np>0) then 366 local_Np=Np 367 else 368 local_Np = p1 330 369 endif 331 332 N = fc*rho_a*(Q*1E-3) 333 334 elseif (abs(p2+1) < 1E-8) then 335 336 ! // N0, log_sigma_g are given 337 Np = p1 370 338 371 log_sigma_g = p3 339 N0 = np*rho_a372 N0 = local_np*rho_a 340 373 tmp1 = (rho_a*(Q*1E-3))/(2.**bpm*apm*N0) 341 374 tmp2 = exp(0.5*bpm**2.*(log_sigma_g))**2. … … 344 377 N = 0.5*( & 345 378 N0 / ((2.*pi)**(0.5)*log_sigma_g*D*0.5*1E-6) * & 346 exp((-0.5*(log(0.5*D/rg)/log_sigma_g)**2.)) & 347 ) * 1E-12 348 349 else 350 351 ! // vu isn't given 379 exp((-0.5*(log(0.5*D/rg)/log_sigma_g)**2.)) & 380 ) * 1E-12 381 382 else 383 352 384 print *, 'Error: Must specify a value for sigma_g' 353 385 stop -
LMDZ5/trunk/libf/phylmd/cosp/format_input.F90
r1907 r2428 1 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/format_input.f90 $ 1 3 ! FORMAT_INPUT: Procedures to prepare data for input to the simulator 2 4 ! Compiled/Modified: -
LMDZ5/trunk/libf/phylmd/cosp/gases.F90
r1907 r2428 1 ! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/gases.f90 $ 1 3 function gases(PRES_mb,T,RH,f) 2 4 implicit none … … 30 32 real*8, dimension(nbands_o2) :: v0, a1, a2, a3, a4, a5, a6 31 33 real*8, dimension(nbands_h2o) :: v1, b1, b2, b3 34 real*8 :: e_th,one_th,pth3,eth35,aux1,aux2,aux3,aux4 35 real*8 :: gm,delt,x,y,gm2 36 real*8 :: fpp_o2,fpp_h2o,s_o2,s_h2o 32 37 integer :: i 33 38 … … 110 115 111 116 ! // conversions 112 th = 300./T ! unitless 113 e = (RH*th**5)/(41.45*10**(9.834*th-10)) ! kPa 114 p = PRES_mb/10.-e ! kPa 117 th = 300./T ! unitless 118 e = (RH*th**5)/(41.45*10**(9.834*th-10)) ! kPa 119 p = PRES_mb/10.-e ! kPa 120 e_th = e*th 121 one_th = 1 - th 122 pth3 = p*th**(3) 123 eth35 = e*th**(3.5) 115 124 116 125 ! // term1 117 126 sumo = 0. 127 aux1 = 1.1*e_th 118 128 do i=1,nbands_o2 119 sumo = sumo + fpp_o2(p,th,e,a3(i),a4(i),a5(i),a6(i),f,v0(i)) & 120 * s_o2(p,th,a1(i),a2(i)) 129 aux2 = f/v0(i) 130 aux3 = v0(i)-f 131 aux4 = v0(i)+f 132 gm = a3(i)*(p*th**(0.8-a4(i))+aux1) 133 gm2 = gm**2 134 delt = a5(i)*p*th**a6(i) 135 x = aux3**2+gm2 136 y = aux4**2+gm2 137 fpp_o2 = (((1./x)+(1./y))*(gm*aux2) - (delt*aux2)*((aux3/(x))-(aux4/(x)))) 138 s_o2 = a1(i)*pth3*exp(a2(i)*one_th) 139 sumo = sumo + fpp_o2 * s_o2 121 140 enddo 122 141 term1 = sumo … … 131 150 ! // term3 132 151 sumo = 0. 152 aux1 = 4.8*e_th 133 153 do i=1,nbands_h2o 134 sumo = sumo + fpp_h2o(p,th,e,b3(i),f,v1(i)) & 135 * s_h2o(th,e,b1(i),b2(i)) 154 aux2 = f/v1(i) 155 aux3 = v1(i)-f 156 aux4 = v1(i)+f 157 gm = b3(i)*(p*th**(0.8)+aux1) 158 gm2 = gm**2 159 x = aux3**2+gm2 160 y = aux4**2+gm2 161 !delt = 0. 162 fpp_h2o = ((1./x)+(1./y))*(gm*aux2) ! - (delt*aux2)*((aux3/(x))-(aux4/(x))) 163 s_h2o = b1(i)*eth35*exp(b2(i)*one_th) 164 sumo = sumo + fpp_h2o * s_h2o 136 165 enddo 137 166 term3 = sumo … … 146 175 gases = 0.182*f*npp 147 176 148 ! ----- SUB FUNCTIONS -----149 150 contains151 152 function fpp_o2(p,th,e,a3,a4,a5,a6,f,v0)153 real*8 :: fpp_o2,p,th,e,a3,a4,a5,a6,f,v0154 real*8 :: gm, delt, x, y155 gm = a3*(p*th**(0.8-a4)+1.1*e*th)156 delt = a5*p*th**(a6)157 x = (v0-f)**2+gm**2158 y = (v0+f)**2+gm**2159 fpp_o2 = ((1./x)+(1./y))*(gm*f/v0) - (delt*f/v0)*(((v0-f)/(x))-((v0+f)/(x)))160 end function fpp_o2161 162 function fpp_h2o(p,th,e,b3,f,v0)163 real*8 :: fpp_h2o,p,th,e,b3,f,v0164 real*8 :: gm, delt, x, y165 gm = b3*(p*th**(0.8)+4.8*e*th)166 delt = 0.167 x = (v0-f)**2+gm**2168 y = (v0+f)**2+gm**2169 fpp_h2o = ((1./x)+(1./y))*(gm*f/v0) - (delt*f/v0)*(((v0-f)/(x))-((v0+f)/(x)))170 end function fpp_h2o171 172 function s_o2(p,th,a1,a2)173 real*8 :: s_o2,p,th,a1,a2174 s_o2 = a1*p*th**(3)*exp(a2*(1-th))175 end function s_o2176 177 function s_h2o(th,e,b1,b2)178 real*8 :: s_h2o,th,e,b1,b2179 s_h2o = b1*e*th**(3.5)*exp(b2*(1-th))180 end function s_h2o181 182 177 end function gases -
LMDZ5/trunk/libf/phylmd/cosp/icarus.F
r1907 r2428 1 ! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/icarus-scops-4.1-bsd/icarus.f $ 1 3 SUBROUTINE ICARUS( 2 4 & debug, -
LMDZ5/trunk/libf/phylmd/cosp/lidar_simulator.F90
r1907 r2428 1 1 ! Copyright (c) 2009, Centre National de la Recherche Scientifique 2 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/actsim/lidar_simulator.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 28 30 , q_lsliq, q_lsice, q_cvliq, q_cvice & 29 31 , ls_radliq, ls_radice, cv_radliq, cv_radice & 30 , frac_out, ice_type & 31 , pmol, pnorm, tautot, refl ) 32 , ice_type, pmol, pnorm, pnorm_perp_tot,tautot, refl ) 32 33 ! 33 34 !--------------------------------------------------------------------------------- … … 75 76 ! - Bug fix in computation of pmol and pnorm, thanks to Masaki Satoh: a factor 2 76 77 ! was missing. This affects the ATB values but not the cloud fraction. 78 ! 79 ! January 2013, G. Cesana and H. Chepfer: 80 ! - Add the perpendicular component of the backscattered signal (pnorm_perp_tot) in the arguments 81 ! - Add the temperature for each levels (temp) in the arguments 82 ! - Add the computation of the perpendicular component of the backscattered lidar signal 83 ! Reference: Cesana G. and H. Chepfer (2013): Evaluation of the cloud water phase 84 ! in a climate model using CALIPSO-GOCCP, J. Geophys. Res., doi: 10.1002/jgrd.50376 77 85 ! 78 86 !--------------------------------------------------------------------------------- … … 96 104 ! cv_radliq: effective radius of CONV liquid particles (meters) 97 105 ! cv_radice: effective radius of CONV ice particles (meters) 98 ! frac_out : cloud cover in each sub-column of the gridbox (output from scops)99 106 ! ice_type : ice particle shape hypothesis (ice_type=0 for spheres, ice_type=1 100 107 ! for non spherical particles) … … 103 110 ! pmol : molecular attenuated backscatter lidar signal power (m^-1.sr^-1) 104 111 ! pnorm: total attenuated backscatter lidar signal power (m^-1.sr^-1) 112 ! pnorm_perp_tot: perpendicular attenuated backscatter lidar signal power (m^-1.sr^-1) 105 113 ! tautot: optical thickess integrated from top to level z 106 114 ! refl : parasol(polder) reflectance … … 130 138 REAL pres(npoints,nlev) ! pressure full levels 131 139 REAL presf(npoints,nlev+1) ! pressure half levels 132 REAL temp(npoints,nlev)133 140 REAL q_lsliq(npoints,nlev), q_lsice(npoints,nlev) 134 141 REAL q_cvliq(npoints,nlev), q_cvice(npoints,nlev) 135 142 REAL ls_radliq(npoints,nlev), ls_radice(npoints,nlev) 136 143 REAL cv_radliq(npoints,nlev), cv_radice(npoints,nlev) 137 REAL frac_out(npoints,nlev)138 144 139 145 ! outputs (for each subcolumn): … … 168 174 169 175 ! sub-column variables: 170 REAL frac_sub(npoints,nlev)171 176 REAL qpart(npoints,nlev,npart) ! mixing ratio particles in each subcolumn 172 177 REAL alpha_part(npoints,nlev,npart) … … 177 182 REAL tautot_lay(npoints) ! temporary variable, total opt. thickness of layer k 178 183 ! Optical thickness from TOA to surface for Parasol 179 REAL tautot_S_liq(npoints),tautot_S_ice(npoints) ! for liq and ice clouds 180 181 ! Abderrahmane 8-2-2011 182 Logical iflag_testlidar 183 PARAMETER (iflag_testlidar=.false.) 184 REAL tautot_S_liq(npoints),tautot_S_ice(npoints) ! for liq and ice clouds 185 186 187 ! Local variables 188 REAL Alpha, Beta, Gamma ! Polynomial coefficient for ATBperp computation 189 REAL temp(npoints,nlev) ! temperature of layer k 190 REAL betatot_ice(npoints,nlev) ! backscatter coefficient for ice particles 191 REAL beta_perp_ice(npoints,nlev) ! perpendicular backscatter coefficient for ice 192 REAL betatot_liq(npoints,nlev) ! backscatter coefficient for liquid particles 193 REAL beta_perp_liq(npoints,nlev) ! perpendicular backscatter coefficient for liq 194 REAL tautot_ice(npoints,nlev) ! total optical thickness of ice 195 REAL tautot_liq(npoints,nlev) ! total optical thickness of liq 196 REAL tautot_lay_ice(npoints) ! total optical thickness of ice in the layer k 197 REAL tautot_lay_liq(npoints) ! total optical thickness of liq in the layer k 198 REAL pnorm_liq(npoints,nlev) ! lidar backscattered signal power for liquid 199 REAL pnorm_ice(npoints,nlev) ! lidar backscattered signal power for ice 200 REAL pnorm_perp_ice(npoints,nlev) ! perpendicular lidar backscattered signal power for ice 201 REAL pnorm_perp_liq(npoints,nlev) ! perpendicular lidar backscattered signal power for liq 202 203 ! Output variable 204 REAL pnorm_perp_tot (npoints,nlev) ! perpendicular lidar backscattered signal power 205 206 !------------------------------------------------------------ 207 !---- 0. Initialisation : 208 !------------------------------------------------------------ 209 betatot_ice(:,:)=0 210 betatot_liq(:,:)=0 211 beta_perp_ice(:,:)=0 212 beta_perp_liq(:,:)=0 213 tautot_ice(:,:)=0 214 tautot_liq(:,:)=0 215 tautot_lay_ice(:)=0; 216 tautot_lay_liq(:)=0; 217 pnorm_liq(:,:)=0 218 pnorm_ice(:,:)=0 219 pnorm_perp_ice(:,:)=0 220 pnorm_perp_liq(:,:)=0 221 pnorm_perp_tot(:,:)=0 222 223 224 ! Polynomial coefficients (Alpha, Beta, Gamma) which allow to compute the ATBperpendicular 225 ! as a function of the ATB for ice or liquid cloud particles derived from CALIPSO-GOCCP 226 ! observations at 120m vertical grid (Cesana and Chepfer, JGR, 2013). 227 ! 228 ! Relationship between ATBice and ATBperp,ice for ice particles 229 ! ATBperp,ice = Alpha*ATBice 230 Alpha = 0.2904 231 232 ! Relationship between ATBice and ATBperp,ice for liquid particles 233 ! ATBperp,ice = Beta*ATBice^2 + Gamma*ATBice 234 Beta = 0.4099 235 Gamma = 0.009 184 236 185 237 !------------------------------------------------------------ … … 201 253 ! We repeat the same coefficients for LS and CONV cloud to make code more readable 202 254 !* LS Liquid water coefficients: 203 polpart(INDX_LSLIQ,1) = 2.6980e-8 255 polpart(INDX_LSLIQ,1) = 2.6980e-8 204 256 polpart(INDX_LSLIQ,2) = -3.7701e-6 205 257 polpart(INDX_LSLIQ,3) = 1.6594e-4 … … 208 260 !* LS Ice coefficients: 209 261 if (ice_type.eq.0) then 210 polpart(INDX_LSICE,1) = -1.0176e-8 262 polpart(INDX_LSICE,1) = -1.0176e-8 211 263 polpart(INDX_LSICE,2) = 1.7615e-6 212 264 polpart(INDX_LSICE,3) = -1.0480e-4 … … 216 268 !* LS Ice NS coefficients: 217 269 if (ice_type.eq.1) then 218 polpart(INDX_LSICE,1) = 1.3615e-8 219 polpart(INDX_LSICE,2) = -2.04206e-6 270 polpart(INDX_LSICE,1) = 1.3615e-8 271 polpart(INDX_LSICE,2) = -2.04206e-6 220 272 polpart(INDX_LSICE,3) = 7.51799e-5 221 273 polpart(INDX_LSICE,4) = 0.00078213 … … 223 275 endif 224 276 !* CONV Liquid water coefficients: 225 polpart(INDX_CVLIQ,1) = 2.6980e-8 277 polpart(INDX_CVLIQ,1) = 2.6980e-8 226 278 polpart(INDX_CVLIQ,2) = -3.7701e-6 227 279 polpart(INDX_CVLIQ,3) = 1.6594e-4 … … 230 282 !* CONV Ice coefficients: 231 283 if (ice_type.eq.0) then 232 polpart(INDX_CVICE,1) = -1.0176e-8 284 polpart(INDX_CVICE,1) = -1.0176e-8 233 285 polpart(INDX_CVICE,2) = 1.7615e-6 234 286 polpart(INDX_CVICE,3) = -1.0480e-4 … … 268 320 -(presf(:,k)-presf(:,k-1))/(rhoair(:,k-1)*9.81) 269 321 enddo 270 271 ! cloud fraction (0 or 1) in each sub-column:272 ! (if frac_out=1or2 -> frac_sub=1; if frac_out=0 -> frac_sub=0)273 frac_sub = MIN( frac_out, 1.0 )274 322 275 323 !------------------------------------------------------------ … … 316 364 317 365 !------------------------------------------------------------ 318 !---- 4. Backscatter signal:366 !---- 4.1 Total Backscatter signal: 319 367 !------------------------------------------------------------ 320 368 … … 356 404 END WHERE 357 405 END DO 358 ! 406 359 407 ! Total signal (molecular + particules): 408 ! 360 409 ! 361 410 ! For performance reason on vector computers, the 2 following lines should not be used … … 373 422 pnorm(:,nlev) = betatot(:,nlev) / (2.*tautot(:,nlev)) & 374 423 & * (1.-exp(-2.0*tautot(:,nlev))) 424 375 425 ! Other layers 376 426 DO k= nlev-1, 1, -1 377 tautot_lay(:) = tautot(:,k)-tautot(:,k+1) ! optical thickness of layer k427 tautot_lay(:) = tautot(:,k)-tautot(:,k+1) ! optical thickness of layer k 378 428 WHERE (tautot_lay(:).GT.0.) 379 pnorm(:,k) = betatot(:,k) * EXP(-2.0*tautot(:,k+1)) / (2.*tautot_lay(:)) & 380 !correc pnorm(:,k) = betatot(:,k) * EXP(-2.0*tautot(:,k+1)) & ! correc Satoh 381 !correc & / (2.0*tautot_lay(:)) & ! correc Satoh 429 pnorm(:,k) = betatot(:,k) * EXP(-2.0*tautot(:,k+1)) / (2.*tautot_lay(:)) & 382 430 & * (1.-EXP(-2.0*tautot_lay(:))) 383 431 ELSEWHERE … … 387 435 END DO 388 436 389 if (iflag_testlidar) then 390 !+JLD test 391 ! do k=1,nlev 392 ! print*,'Min val de frac_out=',k,minval(frac_out(:,k)) 393 ! print*,'Max val de frac_out=',k,maxval(frac_out(:,k)) 394 ! enddo 395 where ( frac_out(:,:).ge.0.5) 396 ! Correction AI 9 5 11 pnorm(:,:) = pmol(:,:)*10. 397 pnorm(:,:) = pmol(:,:)*50. 398 elsewhere 399 pnorm(:,:) = pmol(:,:) 400 endwhere 401 !-JLD test 402 endif 437 !------------------------------------------------------------ 438 !---- 4.2 Ice/Liq Backscatter signal: 439 !------------------------------------------------------------ 440 441 ! Contribution of the molecular to beta 442 betatot_ice(:,:) = beta_mol(:,:) 443 betatot_liq(:,:) = beta_mol(:,:) 444 445 tautot_ice(:,:) = tau_mol(:,:) 446 tautot_liq(:,:) = tau_mol(:,:) 447 448 DO i = 2, npart,2 449 betatot_ice(:,:) = betatot_ice(:,:)+ kp_part(:,:,i)*alpha_part(:,:,i) 450 tautot_ice(:,:) = tautot_ice(:,:) + tau_part(:,:,i) 451 ENDDO ! i 452 DO i = 1, npart,2 453 betatot_liq(:,:) = betatot_liq(:,:)+ kp_part(:,:,i)*alpha_part(:,:,i) 454 tautot_liq(:,:) = tautot_liq(:,:) + tau_part(:,:,i) 455 ENDDO ! i 456 457 458 ! Computation of the ice and liquid lidar backscattered signal (ATBice and ATBliq) 459 ! Ice only 460 ! Upper layer 461 pnorm_ice(:,nlev) = betatot_ice(:,nlev) / (2.*tautot_ice(:,nlev)) & 462 & * (1.-exp(-2.0*tautot_ice(:,nlev))) 463 464 DO k= nlev-1, 1, -1 465 tautot_lay_ice(:) = tautot_ice(:,k)-tautot_ice(:,k+1) 466 WHERE (tautot_lay_ice(:).GT.0.) 467 pnorm_ice(:,k)=betatot_ice(:,k)*EXP(-2.0*tautot_ice(:,k+1))/(2.*tautot_lay_ice(:)) & 468 & * (1.-EXP(-2.0*tautot_lay_ice(:))) 469 ELSEWHERE 470 pnorm_ice(:,k)=betatot_ice(:,k)*EXP(-2.0*tautot_ice(:,k+1)) 471 END WHERE 472 ENDDO 473 474 ! Liquid only 475 ! Upper layer 476 pnorm_liq(:,nlev) = betatot_liq(:,nlev) / (2.*tautot_liq(:,nlev)) & 477 & * (1.-exp(-2.0*tautot_liq(:,nlev))) 478 479 DO k= nlev-1, 1, -1 480 tautot_lay_liq(:) = tautot_liq(:,k)-tautot_liq(:,k+1) 481 WHERE (tautot_lay_liq(:).GT.0.) 482 pnorm_liq(:,k)=betatot_liq(:,k)*EXP(-2.0*tautot_liq(:,k+1))/(2.*tautot_lay_liq(:)) & 483 & * (1.-EXP(-2.0*tautot_lay_liq(:))) 484 ELSEWHERE 485 pnorm_liq(:,k)=betatot_liq(:,k)*EXP(-2.0*tautot_liq(:,k+1)) 486 END WHERE 487 ENDDO 488 489 490 ! Computation of ATBperp,ice/liq from ATBice/liq including the multiple scattering 491 ! contribution (Cesana and Chepfer 2013, JGR) 492 ! ATBperp,ice = Alpha*ATBice 493 ! ATBperp,liq = Beta*ATBliq^2 + Gamma*ATBliq 494 495 DO k= nlev, 1, -1 496 pnorm_perp_ice(:,k) = Alpha * pnorm_ice(:,k) ! Ice particles 497 pnorm_perp_liq(:,k) = 1000*Beta * pnorm_liq(:,k)**2 + Gamma * pnorm_liq(:,k) ! Liquid particles 498 ENDDO 499 500 ! Computation of beta_perp_ice/liq using the lidar equation 501 ! Ice only 502 ! Upper layer 503 beta_perp_ice(:,nlev) = pnorm_perp_ice(:,nlev) * (2.*tautot_ice(:,nlev)) & 504 & / (1.-exp(-2.0*tautot_ice(:,nlev))) 505 506 DO k= nlev-1, 1, -1 507 tautot_lay_ice(:) = tautot_ice(:,k)-tautot_ice(:,k+1) 508 WHERE (tautot_lay_ice(:).GT.0.) 509 beta_perp_ice(:,k) = pnorm_perp_ice(:,k)/ EXP(-2.0*tautot_ice(:,k+1)) * (2.*tautot_lay_ice(:)) & 510 & / (1.-exp(-2.0*tautot_lay_ice(:))) 511 512 ELSEWHERE 513 beta_perp_ice(:,k)=pnorm_perp_ice(:,k)/EXP(-2.0*tautot_ice(:,k+1)) 514 END WHERE 515 ENDDO 516 517 ! Liquid only 518 ! Upper layer 519 beta_perp_liq(:,nlev) = pnorm_perp_liq(:,nlev) * (2.*tautot_liq(:,nlev)) & 520 & / (1.-exp(-2.0*tautot_liq(:,nlev))) 521 522 DO k= nlev-1, 1, -1 523 tautot_lay_liq(:) = tautot_liq(:,k)-tautot_liq(:,k+1) 524 WHERE (tautot_lay_liq(:).GT.0.) 525 beta_perp_liq(:,k) = pnorm_perp_liq(:,k)/ EXP(-2.0*tautot_liq(:,k+1)) * (2.*tautot_lay_liq(:)) & 526 & / (1.-exp(-2.0*tautot_lay_liq(:))) 527 528 ELSEWHERE 529 beta_perp_liq(:,k)=pnorm_perp_liq(:,k)/EXP(-2.0*tautot_liq(:,k+1)) 530 END WHERE 531 ENDDO 532 533 534 535 !------------------------------------------------------------ 536 !---- 4.3 Perpendicular Backscatter signal: 537 !------------------------------------------------------------ 538 539 ! Computation of the total perpendicular lidar signal (ATBperp for liq+ice) 540 ! Upper layer 541 WHERE(tautot(:,nlev).GT.0) 542 pnorm_perp_tot(:,nlev) = & 543 (beta_perp_ice(:,nlev)+beta_perp_liq(:,nlev)-(beta_mol(:,nlev)/(1+1/0.0284))) / (2.*tautot(:,nlev)) & 544 & * (1.-exp(-2.0*tautot(:,nlev))) 545 ELSEWHERE 546 pnorm_perp_tot(:,nlev) = 0. 547 ENDWHERE 548 549 ! Other layers 550 DO k= nlev-1, 1, -1 551 tautot_lay(:) = tautot(:,k)-tautot(:,k+1) ! optical thickness of layer k 552 553 ! The perpendicular component of the molecular backscattered signal (Betaperp) has been 554 ! taken into account two times (once for liquid and once for ice). 555 ! We remove one contribution using 556 ! Betaperp=beta_mol(:,k)/(1+1/0.0284)) [bodhaine et al. 1999] in the following equations: 557 WHERE (pnorm(:,k).eq.0) 558 pnorm_perp_tot(:,k)=0. 559 ELSEWHERE 560 WHERE (tautot_lay(:).GT.0.) 561 pnorm_perp_tot(:,k) = & 562 (beta_perp_ice(:,k)+beta_perp_liq(:,k)-(beta_mol(:,k)/(1+1/0.0284))) * & 563 EXP(-2.0*tautot(:,k+1)) / (2.*tautot_lay(:)) & 564 & * (1.-EXP(-2.0*tautot_lay(:))) 565 ELSEWHERE 566 ! This must never happen, but just in case, to avoid div. by 0 567 pnorm_perp_tot(:,k) = & 568 (beta_perp_ice(:,k)+beta_perp_liq(:,k)-(beta_mol(:,k)/(1+1/0.0284))) * & 569 EXP(-2.0*tautot(:,k+1)) 570 END WHERE 571 ENDWHERE 572 573 END DO 403 574 404 575 !-------- End computation Lidar -------------------------- -
LMDZ5/trunk/libf/phylmd/cosp/llnl_stats.F90
r1907 r2428 1 1 ! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation. 2 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/llnl/llnl_stats.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 22 24 ! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 23 25 ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 ! 27 ! History 28 ! 29 ! Jan 2013 - G. Cesana - Added betaperp_tot and temp_tot arguments 30 ! 31 24 32 25 33 MODULE MOD_LLNL_STATS … … 81 89 !------------- SUBROUTINE COSP_LIDAR_ONLY_CLOUD ----------------- 82 90 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 83 SUBROUTINE COSP_LIDAR_ONLY_CLOUD(Npoints,Ncolumns,Nlevels,beta_tot,beta_mol,Ze_tot,lidar_only_freq_cloud,tcc) 91 SUBROUTINE COSP_LIDAR_ONLY_CLOUD(Npoints,Ncolumns,Nlevels,temp_tot,beta_tot, & 92 betaperp_tot,beta_mol,Ze_tot,lidar_only_freq_cloud,tcc) 84 93 ! Input arguments 85 94 integer,intent(in) :: Npoints,Ncolumns,Nlevels 86 95 real,dimension(Npoints,Nlevels),intent(in) :: beta_mol ! Molecular backscatter 87 96 real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: beta_tot ! Total backscattered signal 97 real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: temp_tot ! Total backscattered signal 98 real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: betaperp_tot ! perpendicular Total backscattered signal 88 99 real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: Ze_tot ! Radar reflectivity 89 100 ! Output arguments 90 101 real,dimension(Npoints,Nlevels),intent(out) :: lidar_only_freq_cloud 91 102 real,dimension(Npoints),intent(out) :: tcc 92 103 93 104 ! local variables 94 105 real :: sc_ratio 95 106 real :: s_cld, s_att 96 ! parameter (S_cld = 3.0) ! Previous thresold for cloud detection 97 parameter (S_cld = 5.0) ! New (dec 2008) thresold for cloud detection 107 parameter (S_cld = 5.0) 98 108 parameter (s_att = 0.01) 99 109 integer :: flag_sat !first saturated level encountered from top 100 110 integer :: flag_cld !cloudy column 101 111 integer :: pr,i,j 102 112 103 113 lidar_only_freq_cloud = 0.0 104 114 tcc = 0.0 … … 109 119 do j=Nlevels,1,-1 !top->surf 110 120 sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j) 111 ! if ((pr == 1).and.(j==8)) print *, pr,i,j,sc_ratio,Ze_tot(pr,i,j)112 121 if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j 113 122 if (Ze_tot(pr,i,j) .lt. -30.) then !radar can't detect cloud 114 123 if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then !lidar sense cloud 115 ! if ((pr == 1).and.(j==8)) print *, 'L'116 124 lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf 117 125 flag_cld=1 118 126 endif 119 127 else !radar sense cloud (z%Ze_tot(pr,i,j) .ge. -30.) 120 ! if ((pr == 1).and.(j==8)) print *, 'R'121 128 flag_cld=1 122 129 endif … … 124 131 if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1. 125 132 enddo !columns 126 ! if (tcc(pr) > Ncolumns) then127 ! print *, 'tcc(',pr,'): ', tcc(pr)128 ! tcc(pr) = Ncolumns129 ! endif130 133 enddo !points 131 134 lidar_only_freq_cloud=lidar_only_freq_cloud/Ncolumns -
LMDZ5/trunk/libf/phylmd/cosp/lmd_ipsl_stats.F90
r1907 r2428 1 1 ! Copyright (c) 2009, Centre National de la Recherche Scientifique 2 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/actsim/lmd_ipsl_stats.F90 $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 33 35 CONTAINS 34 36 SUBROUTINE diag_lidar(npoints,ncol,llm,max_bin,nrefl & 35 , pnorm,pmol,refl,land,pplay,undef,ok_lidar_cfad &36 ,cfad2,srbval &37 , ncat,lidarcld,cldlayer,parasolrefl)37 ,tmp,pnorm,pnorm_perp,pmol,refl,land,pplay,undef,ok_lidar_cfad & 38 ,cfad2,srbval,ncat,lidarcld,lidarcldphase,cldlayer,cldlayerphase & 39 ,lidarcldtmp,parasolrefl) 38 40 ! 39 41 ! ----------------------------------------------------------------------------------- 40 42 ! Lidar outputs : 41 43 ! 42 ! Diagnose cloud fraction (3D cloud fraction + low/middle/high/total cloud fraction 43 ! from the lidar signals (ATB and molecular ATB) computed from model outputs 44 ! Diagnose cloud fraction (3D cloud fraction + low/middle/high/total cloud fraction) 45 ! and phase cloud fraction (3D, low/mid/high/total and 3D temperature) 46 ! from the lidar signals (ATB, ATBperp and molecular ATB) computed from model outputs 44 47 ! + 45 48 ! Compute CFADs of lidar scattering ratio SR and of depolarization index … … 60 63 ! Optimisation of COSP_CFAD_SR 61 64 ! 62 ! Version 1.0 (June 2007) 63 ! Version 1.1 (May 2008) 64 ! Version 1.2 (June 2008) 65 ! Version 2.0 (October 2008) 66 ! Version 2.1 (December 2008) 67 ! c------------------------------------------------------------------------------------ 65 ! January 2013, G. Cesana, H. Chepfer: 66 ! - Add the perpendicular component of the backscattered signal (pnorm_perp) in the arguments 67 ! - Add the temperature (tmp) in the arguments 68 ! - Add the 3D Phase cloud fraction (lidarcldphase) in the arguments 69 ! - Add the Phase low mid high cloud fraction (cldlayerphase) in the arguments 70 ! - Add the 3D Phase cloud fraction as a function of temperature (lidarcldtmp) in the arguments 71 ! - Modification of the phase diagnosis within the COSP_CLDFRAC routine to integrate the phase 72 ! diagnosis (3D, low/mid/high, 3D temperature) 73 ! Reference: Cesana G. and H. Chepfer (2013): Evaluation of the cloud water phase 74 ! in a climate model using CALIPSO-GOCCP, J. Geophys. Res., doi: 10.1002/jgrd.50376 75 ! 76 ! ------------------------------------------------------------------------------------ 68 77 69 78 ! c inputs : … … 82 91 logical ok_lidar_cfad ! true if lidar CFAD diagnostics need to be computed 83 92 real refl(npoints,ncol,nrefl) ! subgrid parasol reflectance ! parasol 93 real tmp(npoints,llm) ! temp at each levels 94 real pnorm_perp(npoints,ncol,llm) ! lidar perpendicular ATB 84 95 85 96 ! c outputs : 86 97 real lidarcld(npoints,llm) ! 3D "lidar" cloud fraction 87 real cldlayer(npoints,ncat) ! "lidar" cloud fraction (low, mid, high, total) 98 real sub(npoints,llm) ! 3D "lidar" indice 99 real cldlayer(npoints,ncat) ! "lidar" cloud layer fraction (low, mid, high, total) 100 88 101 real cfad2(npoints,max_bin,llm) ! CFADs of SR 89 102 real srbval(max_bin) ! SR bins in CFADs … … 94 107 parameter (S_clr = 1.2) 95 108 real S_cld 96 ! parameter (S_cld = 3.0) ! Previous thresold for cloud detection 97 parameter (S_cld = 5.0) ! New (dec 2008) thresold for cloud detection 109 parameter (S_cld = 5.) ! Thresold for cloud detection 98 110 real S_att 99 111 parameter (S_att = 0.01) 100 112 101 113 ! c local variables : 102 integer ic,k 114 integer ic,k,i,j 103 115 real x3d(npoints,ncol,llm) 104 116 real x3d_c(npoints,llm),pnorm_c(npoints,llm) 105 117 real xmax 118 119 ! Output variables 120 integer,parameter :: nphase = 6 ! nb of cloud layer phase types (ice,liquid,undefined,false ice,false liquid,Percent of ice) 121 real lidarcldphase(npoints,llm,nphase) ! 3D "lidar" phase cloud fraction 122 real lidarcldtmp(npoints,40,5) ! 3D "lidar" phase cloud fraction as a function of temp 123 real cldlayerphase(npoints,ncat,nphase) ! "lidar" phase low mid high cloud fraction 124 125 ! SR detection threshold 126 real, parameter :: S_cld_att = 30. ! New threshold for undefine cloud phase detection 127 128 106 129 ! 107 130 ! c ------------------------------------------------------- … … 109 132 ! c ------------------------------------------------------- 110 133 ! 111 112 134 ! Should be modified in future version 113 135 xmax=undef-1.0 … … 116 138 ! c 1- Lidar scattering ratio : 117 139 ! c ------------------------------------------------------- 118 ! 119 ! where ((pnorm.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 )) 120 ! x3d = pnorm/pmol 121 ! elsewhere 122 ! x3d = undef 123 ! end where 124 ! A.B-S: pmol reduced to 2D (npoints,llm) (Dec 08) 140 125 141 do ic = 1, ncol 126 142 pnorm_c = pnorm(:,ic,:) … … 130 146 x3d_c = undef 131 147 end where 132 x3d(:,ic,:) = x3d_c148 x3d(:,ic,:) = x3d_c 133 149 enddo 134 150 … … 138 154 ! c ------------------------------------------------------- 139 155 140 CALL COSP_CLDFRAC(npoints,ncol,llm,ncat, &141 x3d,pplay, S_att,S_cld,undef,lidarcld, &142 cldlayer )156 CALL COSP_CLDFRAC(npoints,ncol,llm,ncat,nphase, & 157 tmp,x3d,pnorm,pnorm_perp,pplay, S_att,S_cld,S_cld_att,undef,lidarcld, & 158 cldlayer,lidarcldphase,sub,cldlayerphase,lidarcldtmp) 143 159 144 160 ! c ------------------------------------------------------- … … 242 258 ! c c- Compute CFAD 243 259 ! c ------------------------------------------------------- 244 245 260 do j = 1, Nlevels 246 261 do ib = 1, Nbins … … 264 279 END SUBROUTINE COSP_CFAD_SR 265 280 281 266 282 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 267 283 !-------------------- SUBROUTINE COSP_CLDFRAC ------------------- 268 284 ! c Purpose: Cloud fraction diagnosed from lidar measurements 269 285 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 270 SUBROUTINE COSP_CLDFRAC(Npoints,Ncolumns,Nlevels,Ncat, & 271 x,pplay,S_att,S_cld,undef,lidarcld, & 272 cldlayer) 286 SUBROUTINE COSP_CLDFRAC(Npoints,Ncolumns,Nlevels,Ncat,Nphase, & 287 tmp,x,ATB,ATBperp,pplay,S_att,S_cld,S_cld_att,undef,lidarcld, & 288 cldlayer,lidarcldphase,nsub,cldlayerphase,lidarcldtemp) 289 290 273 291 IMPLICIT NONE 274 292 ! Input arguments 275 293 integer Npoints,Ncolumns,Nlevels,Ncat 276 294 real x(Npoints,Ncolumns,Nlevels) 295 296 297 ! Local parameters 298 integer nphase ! nb of cloud layer phase types 299 ! (ice,liquid,undefined,false ice,false liquid,Percent of ice) 300 integer,parameter :: Ntemp=40 ! indice of the temperature vector 301 integer ip, k, iz, ic, ncol, nlev, i, itemp ! loop indice 302 real S_cld_att ! New threshold for undefine cloud phase detection (SR=30) 303 integer toplvlsat ! level of the first cloud with SR>30 304 real alpha50, beta50, gamma50, delta50, epsilon50, zeta50 ! Polynomial Coef of the phase 305 ! discrimination line 306 307 ! Input variables 308 real tmp(Npoints,Nlevels) ! temperature 309 real ATB(Npoints,Ncolumns,Nlevels) ! 3D Attenuated backscatter 310 real ATBperp(Npoints,Ncolumns,Nlevels) ! 3D perpendicular attenuated backscatter 277 311 real pplay(Npoints,Nlevels) 278 312 real S_att,S_cld 279 313 real undef 280 ! Output : 314 315 ! Output variables 316 real lidarcldtemp(Npoints,Ntemp,5) ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq 317 real tempmod(Ntemp+1) ! temperature bins 318 real lidarcldphase(Npoints,Nlevels,Nphase) ! 3D cloud phase fraction 319 real cldlayerphase(Npoints,Ncat,Nphase) ! low, middle, high, total cloud fractions for ice liquid and undefine phase 281 320 real lidarcld(Npoints,Nlevels) ! 3D cloud fraction 282 321 real cldlayer(Npoints,Ncat) ! low, middle, high, total cloud fractions 322 283 323 ! Local variables 284 integer ip, k, iz, ic 324 real tmpi(Npoints,Ncolumns,Nlevels) ! temperature of ice cld 325 real tmpl(Npoints,Ncolumns,Nlevels) ! temperature of liquid cld 326 real tmpu(Npoints,Ncolumns,Nlevels) ! temperature of undef cld 327 328 real checktemp, ATBperp_tmp ! temporary variable 329 real checkcldlayerphase, checkcldlayerphase2 ! temporary variable 330 real sumlidarcldtemp(Npoints,Ntemp) ! temporary variable 331 332 real cldlayphase(Npoints,Ncolumns,Ncat,Nphase) ! subgrided low mid high phase cloud fraction 333 real cldlayerphasetmp(Npoints,Ncat) ! temporary variable 334 real cldlayerphasesum(Npoints,Ncat) ! temporary variable 335 real lidarcldtempind(Npoints,Ntemp) ! 3D Temperature indice 336 real lidarcldphasetmp(Npoints,Nlevels) ! 3D sum of ice and liquid cloud occurences 337 338 339 ! Local variables 285 340 real p1 286 341 real cldy(Npoints,Ncolumns,Nlevels) … … 290 345 real nsub(Npoints,Nlevels) 291 346 347 #ifdef SYS_SX 292 348 real cldlay1(Npoints,Ncolumns) 293 349 real cldlay2(Npoints,Ncolumns) … … 296 352 real nsublay2(Npoints,Ncolumns) 297 353 real nsublay3(Npoints,Ncolumns) 354 #endif 355 356 298 357 299 358 … … 311 370 cldlay = 0.0 312 371 nsublay = 0.0 372 373 ATBperp_tmp = 0. 374 lidarcldphase(:,:,:) = 0. 375 cldlayphase(:,:,:,:) = 0. 376 cldlayerphase(:,:,:) = 0. 377 tmpi(:,:,:) = 0. 378 tmpl(:,:,:) = 0. 379 tmpu(:,:,:) = 0. 380 cldlayerphasesum(:,:) = 0. 381 lidarcldtemp(:,:,:) = 0. 382 lidarcldtempind(:,:) = 0. 383 sumlidarcldtemp(:,:) = 0. 384 toplvlsat=0 385 lidarcldphasetmp(:,:) = 0. 386 387 ! temperature bins 388 tempmod=(/-273.15,-90.,-87.,-84.,-81.,-78.,-75.,-72.,-69.,-66.,-63.,-60.,-57., & 389 -54.,-51.,-48.,-45.,-42.,-39.,-36.,-33.,-30.,-27.,-24.,-21.,-18., & 390 -15.,-12.,-9.,-6.,-3.,0.,3.,6.,9.,12.,15.,18.,21.,24.,200. /) 391 392 ! convert C to K 393 tempmod=tempmod+273.15 394 395 ! Polynomial coefficient of the phase discrimination line used to separate liquid from ice 396 ! (Cesana and Chepfer, JGR, 2013) 397 ! ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 + ATB*epsilon50 + zeta50 398 alpha50 = 9.0322e+15 399 beta50 = -2.1358e+12 400 gamma50 = 173.3963e06 401 delta50 = -3.9514e03 402 epsilon50 = 0.2559 403 zeta50 = -9.4776e-07 404 313 405 314 406 ! --------------------------------------------------------------- … … 334 426 enddo ! k 335 427 428 336 429 ! --------------------------------------------------------------- 337 430 ! 3- grid-box 3D cloud fraction and layered cloud fractions (ISCCP pressure … … 340 433 lidarcld = 0.0 341 434 nsub = 0.0 342 435 #ifdef SYS_SX 343 436 !! XXX: Use cldlay[1-3] and nsublay[1-3] to avoid bank-conflicts. 344 437 cldlay1 = 0.0 … … 350 443 nsublay3 = 0.0 351 444 nsublay(:,:,4) = 0.0 445 352 446 do k = Nlevels, 1, -1 353 447 do ic = 1, Ncolumns 354 448 do ip = 1, Npoints 449 450 if(srok(ip,ic,k).gt.0.)then 451 ! Computation of the cloud fraction as a function of the temperature 452 ! instead of height, for ice,liquid and all clouds 453 do itemp=1,Ntemp 454 if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then 455 lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1. 456 endif 457 enddo 458 endif 459 460 if (cldy(ip,ic,k).eq.1.) then 461 do itemp=1,Ntemp 462 if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then 463 lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1. 464 endif 465 enddo 466 endif 467 355 468 p1 = pplay(ip,k) 356 469 … … 379 492 nsublay(:,:,2) = nsublay2 380 493 nsublay(:,:,3) = nsublay3 494 #else 495 cldlay = 0.0 496 nsublay = 0.0 497 do k = Nlevels, 1, -1 498 do ic = 1, Ncolumns 499 do ip = 1, Npoints 500 501 ! Computation of the cloud fraction as a function of the temperature 502 ! instead of height, for ice,liquid and all clouds 503 if(srok(ip,ic,k).gt.0.)then 504 do itemp=1,Ntemp 505 if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then 506 lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1. 507 endif 508 enddo 509 endif 510 511 if(cldy(ip,ic,k).eq.1.)then 512 do itemp=1,Ntemp 513 if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then 514 lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1. 515 endif 516 enddo 517 endif 518 ! 519 520 iz=1 521 p1 = pplay(ip,k) 522 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds 523 iz=3 524 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid clouds 525 iz=2 526 endif 527 528 cldlay(ip,ic,iz) = MAX(cldlay(ip,ic,iz),cldy(ip,ic,k)) 529 cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4),cldy(ip,ic,k)) 530 lidarcld(ip,k)=lidarcld(ip,k) + cldy(ip,ic,k) 531 532 nsublay(ip,ic,iz) = MAX(nsublay(ip,ic,iz),srok(ip,ic,k)) 533 nsublay(ip,ic,4) = MAX(nsublay(ip,ic,4),srok(ip,ic,k)) 534 nsub(ip,k)=nsub(ip,k) + srok(ip,ic,k) 535 536 enddo 537 enddo 538 enddo 539 #endif 540 381 541 382 542 ! -- grid-box 3D cloud fraction … … 407 567 endwhere 408 568 409 RETURN 569 ! --------------------------------------------------------------- 570 ! 4- grid-box 3D cloud Phase : 571 ! --------------------------------------------------------------- 572 ! --------------------------------------------------------------- 573 ! 4.1 - For Cloudy pixels with 8.16km < z < 19.2km 574 ! --------------------------------------------------------------- 575 do ncol=1,Ncolumns 576 do i=1,Npoints 577 578 do nlev=Nlevels,18,-1 ! from 19.2km until 8.16km 579 p1 = pplay(i,nlev) 580 581 582 ! Avoid zero values 583 if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then 584 ! Computation of the ATBperp along the phase discrimination line 585 ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + & 586 (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + & 587 ATB(i,ncol,nlev)*epsilon50 + zeta50 588 589 !____________________________________________________________________________________________________ 590 ! 591 !4.1.a Ice: ATBperp above the phase discrimination line 592 !____________________________________________________________________________________________________ 593 ! 594 if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then ! Ice clouds 595 ! ICE with temperature above 273,15°K = Liquid (false ice) 596 if(tmp(i,nlev).gt.273.15)then ! Temperature above 273,15 K 597 ! Liquid: False ice corrected by the temperature to Liquid 598 lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1. ! false ice detection ==> added to Liquid 599 tmpl(i,ncol,nlev)=tmp(i,nlev) 600 lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1. ! keep the information "temperature criterium used" 601 ! to classify the phase cloud 602 cldlayphase(i,ncol,4,2) = 1. ! tot cloud 603 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 604 cldlayphase(i,ncol,3,2) = 1. 605 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 606 cldlayphase(i,ncol,2,2) = 1. 607 else ! low cloud 608 cldlayphase(i,ncol,1,2) = 1. 609 endif 610 cldlayphase(i,ncol,4,5) = 1. ! tot cloud 611 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 612 cldlayphase(i,ncol,3,5) = 1. 613 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 614 cldlayphase(i,ncol,2,5) = 1. 615 else ! low cloud 616 cldlayphase(i,ncol,1,5) = 1. 617 endif 618 619 else 620 ! ICE with temperature below 273,15°K 621 lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1. 622 tmpi(i,ncol,nlev)=tmp(i,nlev) 623 cldlayphase(i,ncol,4,1) = 1. ! tot cloud 624 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 625 cldlayphase(i,ncol,3,1) = 1. 626 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 627 cldlayphase(i,ncol,2,1) = 1. 628 else ! low cloud 629 cldlayphase(i,ncol,1,1) = 1. 630 endif 631 632 endif 633 634 !____________________________________________________________________________________________________ 635 ! 636 ! 4.1.b Liquid: ATBperp below the phase discrimination line 637 !____________________________________________________________________________________________________ 638 ! 639 else ! Liquid clouds 640 ! Liquid with temperature above 231,15°K 641 if(tmp(i,nlev).gt.231.15)then 642 lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1. 643 tmpl(i,ncol,nlev)=tmp(i,nlev) 644 cldlayphase(i,ncol,4,2) = 1. ! tot cloud 645 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 646 cldlayphase(i,ncol,3,2) = 1. 647 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 648 cldlayphase(i,ncol,2,2) = 1. 649 else ! low cloud 650 cldlayphase(i,ncol,1,2) = 1. 651 endif 652 653 else 654 ! Liquid with temperature below 231,15°K = Ice (false liquid) 655 tmpi(i,ncol,nlev)=tmp(i,nlev) 656 lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1. ! false liquid detection ==> added to ice 657 lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1. ! keep the information "temperature criterium used" 658 ! to classify the phase cloud 659 cldlayphase(i,ncol,4,4) = 1. ! tot cloud 660 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 661 cldlayphase(i,ncol,3,4) = 1. 662 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 663 cldlayphase(i,ncol,2,4) = 1. 664 else ! low cloud 665 cldlayphase(i,ncol,1,4) = 1. 666 endif 667 cldlayphase(i,ncol,4,1) = 1. ! tot cloud 668 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 669 cldlayphase(i,ncol,3,1) = 1. 670 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 671 cldlayphase(i,ncol,2,1) = 1. 672 else ! low cloud 673 cldlayphase(i,ncol,1,1) = 1. 674 endif 675 676 endif 677 678 endif ! end of discrimination condition 679 endif ! end of cloud condition 680 enddo ! end of altitude loop 681 682 683 684 ! --------------------------------------------------------------- 685 ! 4.2 - For Cloudy pixels with 0km < z < 8.16km 686 ! --------------------------------------------------------------- 687 688 toplvlsat=0 689 do nlev=17,1,-1 ! from 8.16km until 0km 690 p1 = pplay(i,nlev) 691 692 if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then 693 ! Phase discrimination line : ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 694 ! + ATB*epsilon50 + zeta50 695 ! Computation of the ATBperp of the phase discrimination line 696 ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + & 697 (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + & 698 ATB(i,ncol,nlev)*epsilon50 + zeta50 699 !____________________________________________________________________________________________________ 700 ! 701 ! 4.2.a Ice: ATBperp above the phase discrimination line 702 !____________________________________________________________________________________________________ 703 ! 704 ! ICE with temperature above 273,15°K = Liquid (false ice) 705 if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then ! Ice clouds 706 if(tmp(i,nlev).gt.273.15)then 707 lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1. ! false ice ==> liq 708 tmpl(i,ncol,nlev)=tmp(i,nlev) 709 lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1. 710 711 cldlayphase(i,ncol,4,2) = 1. ! tot cloud 712 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 713 cldlayphase(i,ncol,3,2) = 1. 714 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 715 cldlayphase(i,ncol,2,2) = 1. 716 else ! low cloud 717 cldlayphase(i,ncol,1,2) = 1. 718 endif 719 720 cldlayphase(i,ncol,4,5) = 1. ! tot cloud 721 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 722 cldlayphase(i,ncol,3,5) = 1. 723 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 724 cldlayphase(i,ncol,2,5) = 1. 725 else ! low cloud 726 cldlayphase(i,ncol,1,5) = 1. 727 endif 728 729 else 730 ! ICE with temperature below 273,15°K 731 lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1. 732 tmpi(i,ncol,nlev)=tmp(i,nlev) 733 734 cldlayphase(i,ncol,4,1) = 1. ! tot cloud 735 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 736 cldlayphase(i,ncol,3,1) = 1. 737 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 738 cldlayphase(i,ncol,2,1) = 1. 739 else ! low cloud 740 cldlayphase(i,ncol,1,1) = 1. 741 endif 742 743 endif 744 745 !____________________________________________________________________________________________________ 746 ! 747 ! 4.2.b Liquid: ATBperp below the phase discrimination line 748 !____________________________________________________________________________________________________ 749 ! 750 else 751 ! Liquid with temperature above 231,15°K 752 if(tmp(i,nlev).gt.231.15)then 753 lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1. 754 tmpl(i,ncol,nlev)=tmp(i,nlev) 755 756 cldlayphase(i,ncol,4,2) = 1. ! tot cloud 757 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 758 cldlayphase(i,ncol,3,2) = 1. 759 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 760 cldlayphase(i,ncol,2,2) = 1. 761 else ! low cloud 762 cldlayphase(i,ncol,1,2) = 1. 763 endif 764 765 else 766 ! Liquid with temperature below 231,15°K = Ice (false liquid) 767 tmpi(i,ncol,nlev)=tmp(i,nlev) 768 lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1. ! false liq ==> ice 769 lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1. ! false liq ==> ice 770 771 cldlayphase(i,ncol,4,4) = 1. ! tot cloud 772 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 773 cldlayphase(i,ncol,3,4) = 1. 774 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 775 cldlayphase(i,ncol,2,4) = 1. 776 else ! low cloud 777 cldlayphase(i,ncol,1,4) = 1. 778 endif 779 780 cldlayphase(i,ncol,4,1) = 1. ! tot cloud 781 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 782 cldlayphase(i,ncol,3,1) = 1. 783 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 784 cldlayphase(i,ncol,2,1) = 1. 785 else ! low cloud 786 cldlayphase(i,ncol,1,1) = 1. 787 endif 788 789 endif 790 endif ! end of discrimination condition 791 792 toplvlsat=0 793 794 ! Find the level of the highest cloud with SR>30 795 if(x(i,ncol,nlev).gt.S_cld_att)then ! SR > 30. 796 toplvlsat=nlev-1 797 goto 99 798 endif 799 800 endif ! end of cloud condition 801 enddo ! end of altitude loop 802 803 99 continue 804 805 !____________________________________________________________________________________________________ 806 ! 807 ! Undefined phase: For a cloud located below another cloud with SR>30 808 ! see Cesana and Chepfer 2013 Sect.III.2 809 !____________________________________________________________________________________________________ 810 ! 811 if(toplvlsat.ne.0)then 812 do nlev=toplvlsat,1,-1 813 p1 = pplay(i,nlev) 814 if(cldy(i,ncol,nlev).eq.1.)then 815 lidarcldphase(i,nlev,3)=lidarcldphase(i,nlev,3)+1. 816 tmpu(i,ncol,nlev)=tmp(i,nlev) 817 818 cldlayphase(i,ncol,4,3) = 1. ! tot cloud 819 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high cloud 820 cldlayphase(i,ncol,3,3) = 1. 821 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud 822 cldlayphase(i,ncol,2,3) = 1. 823 else ! low cloud 824 cldlayphase(i,ncol,1,3) = 1. 825 endif 826 827 endif 828 enddo 829 endif 830 831 toplvlsat=0 832 833 enddo 834 enddo 835 836 837 838 !____________________________________________________________________________________________________ 839 ! 840 ! Computation of final cloud phase diagnosis 841 !____________________________________________________________________________________________________ 842 ! 843 844 ! Compute the Ice percentage in cloud = ice/(ice+liq) as a function 845 ! of the occurrences 846 lidarcldphasetmp(:,:)=lidarcldphase(:,:,1)+lidarcldphase(:,:,2); 847 WHERE (lidarcldphasetmp(:,:).gt. 0.) 848 lidarcldphase(:,:,6)=lidarcldphase(:,:,1)/lidarcldphasetmp(:,:) 849 ELSEWHERE 850 lidarcldphase(:,:,6) = undef 851 ENDWHERE 852 853 ! Compute Phase 3D Cloud Fraction 854 WHERE ( nsub(:,:).gt.0.0 ) 855 lidarcldphase(:,:,1)=lidarcldphase(:,:,1)/nsub(:,:) 856 lidarcldphase(:,:,2)=lidarcldphase(:,:,2)/nsub(:,:) 857 lidarcldphase(:,:,3)=lidarcldphase(:,:,3)/nsub(:,:) 858 lidarcldphase(:,:,4)=lidarcldphase(:,:,4)/nsub(:,:) 859 lidarcldphase(:,:,5)=lidarcldphase(:,:,5)/nsub(:,:) 860 ELSEWHERE 861 lidarcldphase(:,:,1) = undef 862 lidarcldphase(:,:,2) = undef 863 lidarcldphase(:,:,3) = undef 864 lidarcldphase(:,:,4) = undef 865 lidarcldphase(:,:,5) = undef 866 ENDWHERE 867 868 869 ! Compute Phase low mid high cloud fractions 870 do iz = 1, Ncat 871 do i=1,Nphase-3 872 do ic = 1, Ncolumns 873 cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i) 874 cldlayerphasesum(:,iz)=cldlayerphasesum(:,iz)+cldlayphase(:,ic,iz,i) 875 enddo 876 enddo 877 enddo 878 879 do iz = 1, Ncat 880 do i=4,5 881 do ic = 1, Ncolumns 882 cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i) 883 enddo 884 enddo 885 enddo 886 887 ! Compute the Ice percentage in cloud = ice/(ice+liq) 888 cldlayerphasetmp(:,:)=cldlayerphase(:,:,1)+cldlayerphase(:,:,2) 889 WHERE (cldlayerphasetmp(:,:).gt. 0.) 890 cldlayerphase(:,:,6)=cldlayerphase(:,:,1)/cldlayerphasetmp(:,:) 891 ELSEWHERE 892 cldlayerphase(:,:,6) = undef 893 ENDWHERE 894 895 do i=1,Nphase-1 896 WHERE ( cldlayerphasesum(:,:).gt.0.0 ) 897 cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:) 898 ENDWHERE 899 enddo 900 901 902 do i=1,Npoints 903 do iz=1,Ncat 904 checkcldlayerphase=0. 905 checkcldlayerphase2=0. 906 907 if (cldlayerphasesum(i,iz).gt.0.0 )then 908 do ic=1,Nphase-3 909 checkcldlayerphase=checkcldlayerphase+cldlayerphase(i,iz,ic) 910 enddo 911 checkcldlayerphase2=cldlayer(i,iz)-checkcldlayerphase 912 if( (checkcldlayerphase2.gt.0.01).or.(checkcldlayerphase2.lt.-0.01) ) print *, checkcldlayerphase,cldlayer(i,iz) 913 914 endif 915 916 enddo 917 enddo 918 919 do i=1,Nphase-1 920 WHERE ( nsublayer(:,:).eq.0.0 ) 921 cldlayerphase(:,:,i) = undef 922 ENDWHERE 923 enddo 924 925 926 927 ! Compute Phase 3D as a function of temperature 928 do nlev=1,Nlevels 929 do ncol=1,Ncolumns 930 do i=1,Npoints 931 do itemp=1,Ntemp 932 if(tmpi(i,ncol,nlev).gt.0.)then 933 if( (tmpi(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpi(i,ncol,nlev).lt.tempmod(itemp+1)) )then 934 lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1. 935 endif 936 elseif(tmpl(i,ncol,nlev).gt.0.)then 937 if( (tmpl(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpl(i,ncol,nlev).lt.tempmod(itemp+1)) )then 938 lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1. 939 endif 940 elseif(tmpu(i,ncol,nlev).gt.0.)then 941 if( (tmpu(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpu(i,ncol,nlev).lt.tempmod(itemp+1)) )then 942 lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1. 943 endif 944 endif 945 enddo 946 enddo 947 enddo 948 enddo 949 950 ! Check temperature cloud fraction 951 do i=1,Npoints 952 do itemp=1,Ntemp 953 checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4) 954 955 if(checktemp.NE.lidarcldtemp(i,itemp,1))then 956 print *, i,itemp 957 print *, lidarcldtemp(i,itemp,1:4) 958 endif 959 960 enddo 961 enddo 962 963 ! Compute the Ice percentage in cloud = ice/(ice+liq) 964 ! sumlidarcldtemp=sum(lidarcldtemp(:,:,2:3),3) 965 sumlidarcldtemp(:,:)=lidarcldtemp(:,:,2)+lidarcldtemp(:,:,3) 966 967 WHERE(sumlidarcldtemp(:,:)>0.) 968 lidarcldtemp(:,:,5)=lidarcldtemp(:,:,2)/sumlidarcldtemp(:,:) 969 ELSEWHERE 970 lidarcldtemp(:,:,5)=undef 971 ENDWHERE 972 973 do i=1,4 974 WHERE(lidarcldtempind(:,:).gt.0.) 975 lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:) 976 ELSEWHERE 977 lidarcldtemp(:,:,i) = undef 978 ENDWHERE 979 enddo 980 981 RETURN 410 982 END SUBROUTINE COSP_CLDFRAC 411 983 ! --------------------------------------------------------------- 412 984 985 413 986 END MODULE MOD_LMD_IPSL_STATS -
LMDZ5/trunk/libf/phylmd/cosp/math_lib.F90
r1907 r2428 1 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/math_lib.f90 $ 1 3 ! MATH_LIB: Mathematics procedures for F90 2 4 ! Compiled/Modified: … … 42 44 integer :: k,m1,m 43 45 44 pi = acos(-1.) 46 pi = acos(-1.) 45 47 if (x ==int(x)) then 46 48 if (x > 0.0) then -
LMDZ5/trunk/libf/phylmd/cosp/optics_lib.F90
r1907 r2428 1 ! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/optics_lib.f90 $ 1 3 ! OPTICS_LIB: Optical proecures for for F90 2 4 ! Compiled/Modified: … … 15 17 ! subroutine M_WAT 16 18 ! ---------------------------------------------------------------------------- 17 subroutine m_wat(freq, t , n_r, n_i)19 subroutine m_wat(freq, tk, n_r, n_i) 18 20 implicit none 19 21 ! … … 23 25 ! Inputs: 24 26 ! [freq] frequency (GHz) 25 ! [t ] temperature (C)27 ! [tk] temperature (K) 26 28 ! 27 29 ! Outputs: … … 36 38 37 39 ! ----- INPUTS ----- 38 real*8, intent(in) :: freq,t 40 real*8, intent(in) :: freq,tk 39 41 40 42 ! ----- OUTPUTS ----- … … 45 47 real*8 e_r,e_i 46 48 real*8 pi 49 real*8 tc 47 50 complex*16 e_comp, sq 48 51 52 tc = tk - 273.15 53 49 54 ld = 100.*2.99792458E8/(freq*1E9) 50 es = 78.54*(1-(4.579E-3*(t -25.)+1.19E-5*(t-25.)**2 &51 -2.8E-8*(t -25.)**3))52 ei = 5.27137+0.021647*t -0.00131198*t**253 a = -(16.8129/(t +273.))+0.060926554 ls = 0.00033836*exp(2513.98/(t +273.))55 es = 78.54*(1-(4.579E-3*(tc-25.)+1.19E-5*(tc-25.)**2 & 56 -2.8E-8*(tc-25.)**3)) 57 ei = 5.27137+0.021647*tc-0.00131198*tc**2 58 a = -(16.8129/(tc+273.))+0.0609265 59 ls = 0.00033836*exp(2513.98/(tc+273.)) 55 60 sg = 12.5664E8 56 61 … … 84 89 ! Inputs: 85 90 ! [freq] frequency (GHz) 86 ! [t] temperature ( C)91 ! [t] temperature (K) 87 92 ! 88 93 ! Outputs: … … 106 111 parameter(nwl=468,nwlt=62) 107 112 108 real*8 :: alam,cutice,pi,t1,t2, tk,wlmax,wlmin, &109 x,x1,x2,y,y1,y2,ylo,yhi 113 real*8 :: alam,cutice,pi,t1,t2,wlmax,wlmin, & 114 x,x1,x2,y,y1,y2,ylo,yhi,tk 110 115 111 116 real*8 :: & … … 502 507 n_i=0.0 503 508 509 tk = t 510 504 511 ! // convert frequency to wavelength (um) 505 512 alam=3E5/freq … … 508 515 stop 509 516 endif 510 511 ! // convert temperature to K512 tk = t + 273.16513 517 514 518 if (alam < cutice) then … … 706 710 Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc 707 711 If (N.Gt.1) then 708 712 Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN) 709 713 End If 710 714 Anm1 = A -
LMDZ5/trunk/libf/phylmd/cosp/pf_to_mr.F
r1907 r2428 1 1 ! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation. 2 2 ! All rights reserved. 3 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 4 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/llnl/pf_to_mr.f $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 35 37 INTEGER ncol ! number of subcolumns 36 38 37 INTEGER i,j,ilev,ibox39 INTEGER j,ilev,ibox 38 40 39 REAL rain_ls(npoints,nlev),snow_ls(npoints,nlev) ! large-scale precip itationflux41 REAL rain_ls(npoints,nlev),snow_ls(npoints,nlev) ! large-scale precip. flux 40 42 REAL grpl_ls(npoints,nlev) 41 REAL rain_cv(npoints,nlev),snow_cv(npoints,nlev) ! convective precip itationflux43 REAL rain_cv(npoints,nlev),snow_cv(npoints,nlev) ! convective precip. flux 42 44 43 45 REAL prec_frac(npoints,ncol,nlev) ! 0 -> clear sky … … 54 56 REAL term1x2r,term1x2s,term1x2g,t123r,t123s,t123g 55 57 56 ! method from Khairoutdinov and Randall (2003 JAS) 58 ! method from Khairoutdinov and Randall (2003 JAS) 57 59 58 60 ! --- List of constants from Appendix B -
LMDZ5/trunk/libf/phylmd/cosp/phys_cosp.F90
r2345 r2428 2 2 3 3 ! ISCCP, Radar (QuickBeam), Lidar et Parasol (ACTSIM), MISR, RTTOVS 4 !Idelkadi Abderrahmane Aout-Septembre 2009 4 !Idelkadi Abderrahmane Aout-Septembre 2009 First Version 5 !Idelkadi Abderrahmane Nov 2015 version v1.4.0 5 6 6 7 subroutine phys_cosp( itap,dtime,freq_cosp, & … … 67 68 ! meantbisccp, !Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator 68 69 ! meantbclrisccp !Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator 70 71 !!! AI rajouter les nouvelles sorties 69 72 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 70 73 74 !! AI rajouter 75 #include "cosp_defs.h" 71 76 USE MOD_COSP_CONSTANTS 72 77 USE MOD_COSP_TYPES … … 78 83 use cosp_output_mod 79 84 use cosp_output_write_mod 80 85 ! use MOD_COSP_Modis_Simulator, only : cosp_modis 86 81 87 IMPLICIT NONE 82 88 … … 100 106 type(cosp_sglidar) :: sglidar ! Output from lidar simulator 101 107 type(cosp_isccp) :: isccp ! Output from ISCCP simulator 108 !! AI rajout modis 109 type(cosp_modis) :: modis ! Output from MODIS simulator 110 !! 102 111 type(cosp_misr) :: misr ! Output from MISR simulator 112 !! AI rajout rttovs 113 ! type(cosp_rttov) :: rttov ! Output from RTTOV 114 !! 103 115 type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats 104 116 type(cosp_radarstats) :: stradar ! Summary statistics from radar simulator … … 106 118 107 119 integer :: t0,t1,count_rate,count_max 108 integer :: Nlon,Nlat ,geomode120 integer :: Nlon,Nlat 109 121 real,save :: radar_freq,k2,ZenAng,co2,ch4,n2o,co,emsfc_lw 110 122 !$OMP THREADPRIVATE(emsfc_lw) … … 134 146 integer :: itap,k,ip 135 147 real :: dtime,freq_cosp 148 real,dimension(2) :: time_bnds 136 149 137 !138 150 namelist/COSP_INPUT/overlap,isccp_topheight,isccp_topheight_direction, & 139 151 npoints_it,ncolumns,use_vgrid,nlr,csat_vgrid, & … … 167 179 168 180 print*,' Cles des differents simulateurs cosp :' 169 print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &170 cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%L rttov_sim181 print*,'Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lmodis_sim,Lrttov_sim', & 182 cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lmodis_sim,cfg%Lrttov_sim 171 183 172 184 endif ! debut_cosp 185 186 time_bnds(1) = dtime-dtime/2. 187 time_bnds(2) = dtime+dtime/2. 173 188 174 189 ! print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', & … … 178 193 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 179 194 print *, 'Allocating memory for gridbox type...' 180 181 call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, & 195 !! AI 196 ! call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, & 197 ! Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, & 198 ! lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, & 199 ! use_precipitation_fluxes,use_reff, & 200 ! Platform,Satellite,Instrument,Nchannels,ZenAng, & 201 ! channels(1:Nchannels),surfem(1:Nchannels),co2,ch4,n2o,co,gbx) 202 ! Surafce emissivity 203 emsfc_lw = 1. 204 205 call construct_cosp_gridbox(dtime,time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs, & 206 do_ray,melt_lay,k2, & 182 207 Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, & 183 208 lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, & … … 230 255 231 256 ! sunlit calcule a partir de la fraction d ensoleillement par jour 232 do ip = 1, Npoints 233 if (sunlit(ip).le.0.) then 234 gbx%sunlit(ip)=0. 235 else 236 gbx%sunlit(ip)=1. 237 endif 238 enddo 257 ! do ip = 1, Npoints 258 ! if (sunlit(ip).le.0.) then 259 ! gbx%sunlit(ip)=0. 260 ! else 261 ! gbx%sunlit(ip)=1. 262 ! endif 263 ! enddo 264 gbx%sunlit=sunlit 239 265 240 266 ! A voir l equivalent LMDZ … … 260 286 gbx%Reff(:,:,I_LSCLIQ) = ref_liq*1e-6 261 287 gbx%Reff(:,:,I_LSCICE) = ref_ice*1e-6 288 !! AI A revoir 262 289 gbx%Reff(:,:,I_CVCLIQ) = ref_liq*1e-6 263 290 gbx%Reff(:,:,I_CVCICE) = ref_ice*1e-6 … … 269 296 gbx%dem_c = 0. 270 297 271 ! Surafce emissivity272 emsfc_lw = 1.273 274 298 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 275 299 ! Define new vertical grid … … 288 312 call construct_cosp_lidarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar) 289 313 call construct_cosp_isccp(cfg,Npoints,Ncolumns,Nlevels,isccp) 314 !! AI rajout 315 call construct_cosp_modis(cfg,Npoints,modis) 316 !! 290 317 call construct_cosp_misr(cfg,Npoints,misr) 318 ! call construct_cosp_rttov(cfg,Npoints,Nchannels,rttov) 291 319 292 320 !+++++++++++++ Open output files and define output files axis !+++++++++++++ … … 306 334 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 307 335 print *, 'Calling simulator...' 308 call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 336 !! AI 337 ! call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 338 !#ifdef RTTOV 339 ! call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 340 !#else 341 call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 342 !#endif 343 !! 344 309 345 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 310 346 311 347 !!!!!!!!!!!!!!!!!! Ecreture des sorties Cosp !!!!!!!!!!!!!!r!!!!!!:!!!!! 348 312 349 print *, 'Calling write output' 313 350 call cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, & 314 cfg, gbx, vgrid, sglidar, stlidar, isccp) 351 cfg, gbx, vgrid, sglidar, sgradar, stlidar, stradar, & 352 isccp, misr, modis) 315 353 316 354 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ … … 326 364 call free_cosp_isccp(isccp) 327 365 call free_cosp_misr(misr) 366 !! AI 367 call free_cosp_modis(modis) 368 ! call free_cosp_rttov(rttov) 369 !! 328 370 call free_cosp_vgrid(vgrid) 329 371 -
LMDZ5/trunk/libf/phylmd/cosp/prec_scops.F
r1907 r2428 1 1 ! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation. 2 2 ! All rights reserved. 3 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 4 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/llnl/prec_scops.f $ 3 5 ! 4 6 ! Redistribution and use in source and binary forms, with or without modification, are permitted … … 45 47 ! 1 -> LS precipitation 46 48 ! 2 -> CONV precipitation 47 49 ! 3 -> both 48 50 !TOA to SURFACE!!!!!!!!!!!!!!!!!! 49 51 50 52 INTEGER flag_ls, flag_cv 51 53 INTEGER frac_out_ls(npoints,ncol),frac_out_cv(npoints,ncol) !flag variables for … … 56 58 57 59 do ilev=1,nlev 58 do ibox=1,ncol 59 do j=1,npoints 60 prec_frac(j,ibox,ilev) = 0 60 do ibox=1,ncol 61 do j=1,npoints 62 prec_frac(j,ibox,ilev) = 0 63 enddo 61 64 enddo 62 enddo63 65 enddo 64 66 65 67 do j=1,npoints 66 68 do ibox=1,ncol 67 frac_out_ls(j,ibox)=068 frac_out_cv(j,ibox)=069 flag_ls=070 flag_cv=069 frac_out_ls(j,ibox)=0 70 frac_out_cv(j,ibox)=0 71 flag_ls=0 72 flag_cv=0 71 73 do ilev=1,nlev 72 73 74 75 76 77 78 79 80 81 82 83 84 74 if (frac_out(j,ibox,ilev) .eq. 1) then 75 flag_ls=1 76 endif 77 if (frac_out(j,ibox,ilev) .eq. 2) then 78 flag_cv=1 79 endif 80 enddo !loop over nlev 81 if (flag_ls .eq. 1) then 82 frac_out_ls(j,ibox)=1 83 endif 84 if (flag_cv .eq. 1) then 85 frac_out_cv(j,ibox)=1 86 endif 85 87 enddo ! loop over ncol 86 88 enddo ! loop over npoints … … 89 91 do j=1,npoints 90 92 flag_ls=0 91 92 93 flag_cv=0 94 93 95 if (ls_p_rate(j,1) .gt. 0.) then 94 do ibox=1,ncol ! possibility ONE95 if (frac_out(j,ibox,1) .eq. 1) then96 prec_frac(j,ibox,1) = 197 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 !prec_frac(j,1:ncol,1) = 1119 120 121 122 96 do ibox=1,ncol ! possibility ONE 97 if (frac_out(j,ibox,1) .eq. 1) then 98 prec_frac(j,ibox,1) = 1 99 flag_ls=1 100 endif 101 enddo ! loop over ncol 102 if (flag_ls .eq. 0) then ! possibility THREE 103 do ibox=1,ncol 104 if (frac_out(j,ibox,2) .eq. 1) then 105 prec_frac(j,ibox,1) = 1 106 flag_ls=1 107 endif 108 enddo ! loop over ncol 109 endif 110 if (flag_ls .eq. 0) then ! possibility Four 111 do ibox=1,ncol 112 if (frac_out_ls(j,ibox) .eq. 1) then 113 prec_frac(j,ibox,1) = 1 114 flag_ls=1 115 endif 116 enddo ! loop over ncol 117 endif 118 if (flag_ls .eq. 0) then ! possibility Five 119 do ibox=1,ncol 120 ! prec_frac(j,1:ncol,1) = 1 121 prec_frac(j,ibox,1) = 1 122 enddo ! loop over ncol 123 endif 124 endif 123 125 ! There is large scale precipitation 124 126 125 127 if (cv_p_rate(j,1) .gt. 0.) then 126 128 do ibox=1,ncol ! possibility ONE 127 129 if (frac_out(j,ibox,1) .eq. 2) then 128 130 if (prec_frac(j,ibox,1) .eq. 0) then 129 130 131 132 133 134 135 136 137 138 139 if (prec_frac(j,ibox,1) .eq. 0) then140 141 142 143 144 145 146 147 148 149 150 151 if (prec_frac(j,ibox,1) .eq. 0) then152 153 154 155 156 157 158 159 160 161 162 if (prec_frac(j,ibox,1) .eq. 0) then163 164 165 166 167 168 169 170 ! There is convective precipitation171 172 enddo ! loop over npoints131 prec_frac(j,ibox,1) = 2 132 else 133 prec_frac(j,ibox,1) = 3 134 endif 135 flag_cv=1 136 endif 137 enddo ! loop over ncol 138 if (flag_cv .eq. 0) then ! possibility THREE 139 do ibox=1,ncol 140 if (frac_out(j,ibox,2) .eq. 2) then 141 if (prec_frac(j,ibox,1) .eq. 0) then 142 prec_frac(j,ibox,1) = 2 143 else 144 prec_frac(j,ibox,1) = 3 145 endif 146 flag_cv=1 147 endif 148 enddo ! loop over ncol 149 endif 150 if (flag_cv .eq. 0) then ! possibility Four 151 do ibox=1,ncol 152 if (frac_out_cv(j,ibox) .eq. 1) then 153 if (prec_frac(j,ibox,1) .eq. 0) then 154 prec_frac(j,ibox,1) = 2 155 else 156 prec_frac(j,ibox,1) = 3 157 endif 158 flag_cv=1 159 endif 160 enddo ! loop over ncol 161 endif 162 if (flag_cv .eq. 0) then ! possibility Five 163 do ibox=1,cv_col 164 if (prec_frac(j,ibox,1) .eq. 0) then 165 prec_frac(j,ibox,1) = 2 166 else 167 prec_frac(j,ibox,1) = 3 168 endif 169 enddo !loop over cv_col 170 endif 171 endif 172 ! There is convective precipitation 173 174 enddo ! loop over npoints 173 175 ! end of initializing the top layer 174 176 … … 179 181 do j=1,npoints 180 182 flag_ls=0 181 182 183 flag_cv=0 184 183 185 if (ls_p_rate(j,ilev) .gt. 0.) then 184 186 do ibox=1,ncol ! possibility ONE&TWO … … 187 189 & .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 188 190 prec_frac(j,ibox,ilev) = 1 189 191 flag_ls=1 190 192 endif 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 ! 211 212 213 214 215 193 enddo ! loop over ncol 194 if ((flag_ls .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE 195 do ibox=1,ncol 196 if (frac_out(j,ibox,ilev+1) .eq. 1) then 197 prec_frac(j,ibox,ilev) = 1 198 flag_ls=1 199 endif 200 enddo ! loop over ncol 201 endif 202 if (flag_ls .eq. 0) then ! possibility Four 203 do ibox=1,ncol 204 if (frac_out_ls(j,ibox) .eq. 1) then 205 prec_frac(j,ibox,ilev) = 1 206 flag_ls=1 207 endif 208 enddo ! loop over ncol 209 endif 210 if (flag_ls .eq. 0) then ! possibility Five 211 do ibox=1,ncol 212 ! prec_frac(j,1:ncol,ilev) = 1 213 prec_frac(j,ibox,ilev) = 1 214 enddo ! loop over ncol 215 endif 216 endif ! There is large scale precipitation 217 216 218 if (cv_p_rate(j,ilev) .gt. 0.) then 217 219 do ibox=1,ncol ! possibility ONE&TWO … … 220 222 & .or. (prec_frac(j,ibox,ilev-1) .eq. 3))) then 221 223 if (prec_frac(j,ibox,ilev) .eq. 0) then 222 223 224 225 226 227 228 229 230 231 232 if (prec_frac(j,ibox,ilev) .eq. 0) then233 234 235 236 237 238 239 240 241 242 243 244 if (prec_frac(j,ibox,ilev) .eq. 0) then245 246 247 248 249 250 251 252 253 254 255 if (prec_frac(j,ibox,ilev) .eq. 0) then256 257 258 259 260 261 262 263 264 enddo ! loop over npoints265 enddo ! loop over nlev224 prec_frac(j,ibox,ilev) = 2 225 else 226 prec_frac(j,ibox,ilev) = 3 227 endif 228 flag_cv=1 229 endif 230 enddo ! loop over ncol 231 if ((flag_cv .eq. 0) .and. (ilev .lt. nlev)) then ! possibility THREE 232 do ibox=1,ncol 233 if (frac_out(j,ibox,ilev+1) .eq. 2) then 234 if (prec_frac(j,ibox,ilev) .eq. 0) then 235 prec_frac(j,ibox,ilev) = 2 236 else 237 prec_frac(j,ibox,ilev) = 3 238 endif 239 flag_cv=1 240 endif 241 enddo ! loop over ncol 242 endif 243 if (flag_cv .eq. 0) then ! possibility Four 244 do ibox=1,ncol 245 if (frac_out_cv(j,ibox) .eq. 1) then 246 if (prec_frac(j,ibox,ilev) .eq. 0) then 247 prec_frac(j,ibox,ilev) = 2 248 else 249 prec_frac(j,ibox,ilev) = 3 250 endif 251 flag_cv=1 252 endif 253 enddo ! loop over ncol 254 endif 255 if (flag_cv .eq. 0) then ! possibility Five 256 do ibox=1,cv_col 257 if (prec_frac(j,ibox,ilev) .eq. 0) then 258 prec_frac(j,ibox,ilev) = 2 259 else 260 prec_frac(j,ibox,ilev) = 3 261 endif 262 enddo !loop over cv_col 263 endif 264 endif ! There is convective precipitation 265 266 enddo ! loop over npoints 267 enddo ! loop over nlev 266 268 267 269 end -
LMDZ5/trunk/libf/phylmd/cosp/radar_simulator.F90
r1907 r2428 1 subroutine radar_simulator(freq,k2,do_ray,use_gas_abs,use_mie_table,mt, & 2 nhclass,hp,nprof,ngate,nsizes,D,hgt_matrix,hm_matrix,re_matrix,p_matrix,t_matrix, & 3 rh_matrix,Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe, & 1 subroutine radar_simulator( & 2 hp, & 3 nprof,ngate, & 4 undef, & 5 hgt_matrix,hm_matrix,re_matrix,Np_matrix, & 6 p_matrix,t_matrix,rh_matrix, & 7 Ze_non,Ze_ray,a_to_vol,g_to_vol,dBZe, & 4 8 g_to_vol_in,g_to_vol_out) 5 6 ! rh_matrix,Ze_non,Ze_ray,kr_matrix,g_atten_to_vol,dBZe)7 9 8 10 use m_mrgrnk … … 11 13 use optics_lib 12 14 use radar_simulator_types 15 use scale_LUTs_io 13 16 implicit none 14 17 15 18 ! Purpose: 19 ! 16 20 ! Simulates a vertical profile of radar reflectivity 17 ! Part of QuickBeam v1.04 by John Haynes & Roger Marchand 21 ! Originally Part of QuickBeam v1.04 by John Haynes & Roger Marchand. 22 ! but has been substantially modified since that time by 23 ! Laura Fowler and Roger Marchand (see modifications below). 18 24 ! 19 25 ! Inputs: 20 ! [freq] radar frequency (GHz), can be anything unless 21 ! use_mie_table=1, in which case one of 94,35,13.8,9.6,3 22 ! [k2] |K|^2, the dielectric constant, set to -1 to use the 23 ! frequency dependent default 24 ! [do_ray] 1=do Rayleigh calcs, 0=not 25 ! [use_gas_abs] 1=do gaseous abs calcs, 0=not, 26 ! 2=use same as first profile (undocumented) 27 ! [use_mie_table] 1=use Mie tables, 0=not 28 ! [mt] Mie look up table 29 ! [nhclass] number of hydrometeor types 30 ! [hp] structure that defines hydrometeor types 26 ! 27 ! [hp] structure that defines hydrometeor types and other radar properties 28 ! 31 29 ! [nprof] number of hydrometeor profiles 32 30 ! [ngate] number of vertical layers 33 ! [nsizes] number of discrete particles in [D] 34 ! [D] array of discrete particles (um) 35 ! 31 ! 32 ! [undef] missing data value 36 33 ! (The following 5 arrays must be in order from closest to the radar 37 34 ! to farthest...) 35 ! 38 36 ! [hgt_matrix] height of hydrometeors (km) 37 ! [p_matrix] pressure profile (hPa) 38 ! [t_matrix] temperature profile (K) 39 ! [rh_matrix] relative humidity profile (%) -- only needed if gaseous aborption calculated. 40 ! 39 41 ! [hm_matrix] table of hydrometeor mixing rations (g/kg) 40 ! [re_matrix] OPTIONAL table of hydrometeor effective radii (microns) 41 ! [p_matrix] pressure profile (hPa) 42 ! [t_matrix] temperature profile (C) 43 ! [rh_matrix] relative humidity profile (%) 42 ! [re_matrix] table of hydrometeor effective radii. 0 ==> use defaults. (units=microns) 43 ! [Np_matrix] table of hydrometeor number concentration. 0 ==> use defaults. (units = 1/kg) 44 44 ! 45 45 ! Outputs: 46 ! 46 47 ! [Ze_non] radar reflectivity without attenuation (dBZ) 47 48 ! [Ze_ray] Rayleigh reflectivity (dBZ) … … 59 60 ! Created: 60 61 ! 11/28/2005 John Haynes (haynes@atmos.colostate.edu) 62 ! 61 63 ! Modified: 62 ! 09/2006 placed into subroutine form , scaling factors(Roger Marchand,JMH)64 ! 09/2006 placed into subroutine form (Roger Marchand,JMH) 63 65 ! 08/2007 added equivalent volume spheres, Z and N scalling most distrubtion types (Roger Marchand) 64 66 ! 01/2008 'Do while' to determine if hydrometeor(s) present in volume 65 67 ! changed for vectorization purposes (A. Bodas-Salcedo) 66 68 ! 69 ! 07/2010 V3.0 ... Modified to load or save scale factors to disk as a Look-Up Table (LUT) 70 ! ... All hydrometeor and radar simulator properties now included in hp structure 71 ! ... hp structure should be initialized by call to radar_simulator_init prior 72 ! ... to calling this subroutine. 73 ! Also ... Support of Morrison 2-moment style microphyscis (Np_matrix) added 74 ! ... Changes implement by Roj Marchand following work by Laura Fowler 75 ! 76 ! 10/2011 Modified ngate loop to go in either direction depending on flag 77 ! hp%radar_at_layer_one. This affects the direction in which attenuation is summed. 78 ! 79 ! Also removed called to AVINT for gas and hydrometeor attenuation and replaced with simple 80 ! summation. (Roger Marchand) 81 ! 82 ! 67 83 ! ----- INPUTS ----- 68 type(mie), intent(in) :: mt 84 85 logical, parameter :: DO_LUT_TEST = .false. 86 logical, parameter :: DO_NP_TEST = .false. 87 69 88 type(class_param), intent(inout) :: hp 70 real*8, intent(in) :: freq,k2 71 integer, intent(in) :: do_ray,use_gas_abs,use_mie_table, & 72 nhclass,nprof,ngate,nsizes 73 real*8, dimension(nsizes), intent(in) :: D 74 real*8, dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, & 75 t_matrix,rh_matrix 76 real*8, dimension(nhclass,nprof,ngate), intent(in) :: hm_matrix 77 real*8, dimension(nhclass,nprof,ngate), intent(inout) :: re_matrix 78 89 90 integer, intent(in) :: nprof,ngate 91 92 real undef 93 real*8, dimension(nprof,ngate), intent(in) :: & 94 hgt_matrix, p_matrix,t_matrix,rh_matrix 95 96 real*8, dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix 97 real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix 98 real*8, dimension(hp%nhclass,nprof,ngate), intent(in) :: Np_matrix 99 79 100 ! ----- OUTPUTS ----- 80 101 real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, & 81 g_atten_to_vol,dBZe,h_atten_to_vol102 g_to_vol,dBZe,a_to_vol 82 103 83 104 ! ----- OPTIONAL ----- 84 real*8, optional, dimension(n gate,nprof) :: &105 real*8, optional, dimension(nprof,ngate) :: & 85 106 g_to_vol_in,g_to_vol_out ! integrated atten due to gases, r>v (dB). This allows to output and then input 86 107 ! the same gaseous absorption in different calls. Optional to allow compatibility 87 108 ! with original version. A. Bodas April 2008. 88 89 109 ! real*8, dimension(nprof,ngate) :: kr_matrix 90 110 91 111 ! ----- INTERNAL ----- 112 113 real, parameter :: one_third = 1.0/3.0 114 real*8 :: t_kelvin 92 115 integer :: & 93 phase, & ! 0=liquid, 1=ice 94 ns ! number of discrete drop sizes 95 96 integer*4, dimension(ngate) :: & 97 hydro ! 1=hydrometeor in vol, 0=none 116 phase, & ! 0=liquid, 1=ice 117 ns ! number of discrete drop sizes 118 119 logical :: hydro ! true=hydrometeor in vol, false=none 98 120 real*8 :: & 99 rho_a, & 100 gases 121 rho_a, & ! air density (kg m^-3) 122 gases ! function: 2-way gas atten (dB/km) 101 123 102 124 real*8, dimension(:), allocatable :: & 103 Di, Deq, & 104 Ni, Ntemp, &! discrete concentrations (cm^-3 um^-1)105 rhoi 106 107 real*8, dimension(n gate) :: &108 z_vol, & 125 Di, Deq, & ! discrete drop sizes (um) 126 Ni, & ! discrete concentrations (cm^-3 um^-1) 127 rhoi ! discrete densities (kg m^-3) 128 129 real*8, dimension(nprof, ngate) :: & 130 z_vol, & ! effective reflectivity factor (mm^6/m^3) 109 131 z_ray, & ! reflectivity factor, Rayleigh only (mm^6/m^3) 110 kr_vol, & ! attenuation coefficient hydro (dB/km) 111 g_vol, & ! attenuation coefficient gases (dB/km) 112 a_to_vol, & ! integrated atten due to hydometeors, r>v (dB) 113 g_to_vol ! integrated atten due to gases, r>v (dB) 114 115 132 kr_vol, & ! attenuation coefficient hydro (dB/km) 133 g_vol ! attenuation coefficient gases (dB/km) 134 135 116 136 integer,parameter :: KR8 = selected_real_kind(15,300) 117 137 real*8, parameter :: xx = -1.0_KR8 118 138 real*8, dimension(:), allocatable :: xxa 119 real*8 :: kr, ze, zr, pi, scale_factor, tc, Re, ld, tmp1, ze2, kr2,apm,bpm 139 real*8 :: kr, ze, zr, pi, scale_factor, tc, Re, ld, tmp1, ze2, kr2, apm, bpm 140 real*8 :: half_a_atten_current,half_a_atten_above 141 real*8 :: half_g_atten_current,half_g_atten_above 120 142 integer*4 :: tp, i, j, k, pr, itt, iff 121 143 122 real*8 bin_length,step,base,step_list(25),base_list(25)144 real*8 step,base, Np 123 145 integer*4 iRe_type,n,max_bin 124 146 147 integer start_gate,end_gate,d_gate 148 125 149 logical :: g_to_vol_in_present, g_to_vol_out_present 126 150 127 151 ! Logicals to avoid calling present within the loops 128 152 g_to_vol_in_present = present(g_to_vol_in) 129 153 g_to_vol_out_present = present(g_to_vol_out) 130 131 ! set up Re bins for z_scalling 132 bin_length=50; 133 max_bin=25 134 135 step_list(1)=1 136 base_list(1)=75 137 do j=2,max_bin 138 step_list(j)=3*(j-1); 139 if(step_list(j)>bin_length) then 140 step_list(j)=bin_length; 141 endif 142 base_list(j)=base_list(j-1)+floor(bin_length/step_list(j-1)); 143 enddo 144 154 155 ! 156 ! load scaling matricies from disk -- but only the first time this subroutine is called 157 ! 158 if(hp%load_scale_LUTs) then 159 call load_scale_LUTs(hp) 160 hp%load_scale_LUTs=.false. 161 hp%Z_scale_added_flag = .false. ! will be set true if scaling Look Up Tables are modified during run 162 endif 145 163 146 164 pi = acos(-1.0) 147 if (use_mie_table == 1) iff = infind(mt%freq,freq,sort=1) 148 149 165 166 ! ----- Initialisation ----- 167 g_to_vol = 0.0 168 a_to_vol = 0.0 169 z_vol = 0.0 170 z_ray = 0.0 171 kr_vol = 0.0 172 173 ! // loop over each range gate (ngate) ... starting with layer closest to the radar ! 174 if(hp%radar_at_layer_one) then 175 start_gate=1 176 end_gate=ngate 177 d_gate=1 178 else 179 start_gate=ngate 180 end_gate=1 181 d_gate=-1 182 endif 183 do k=start_gate,end_gate,d_gate 150 184 ! // loop over each profile (nprof) 151 do pr=1,nprof 152 153 ! ----- calculations for each volume ----- 154 z_vol(:) = 0 155 z_ray(:) = 0 156 kr_vol(:) = 0 157 hydro(:) = 0 158 159 ! // loop over eacho range gate (ngate) 160 do k=1,ngate 161 185 do pr=1,nprof 186 t_kelvin = t_matrix(pr,k) 162 187 ! :: determine if hydrometeor(s) present in volume 163 hydro (k) = 0164 do j=1, nhclass ! Do while changed for vectorization purposes (A. B-S)188 hydro = .false. 189 do j=1,hp%nhclass 165 190 if ((hm_matrix(j,pr,k) > 1E-12) .and. (hp%dtype(j) > 0)) then 166 hydro (k) = 1191 hydro = .true. 167 192 exit 168 193 endif 169 194 enddo 170 195 171 if (hydro(k) == 1) then 172 ! :: if there is hydrometeor in the volume 173 174 rho_a = (p_matrix(pr,k)*100.)/(287*(t_matrix(pr,k)+273.15)) 175 196 ! :: if there is hydrometeor in the volume 197 if (hydro) then 198 199 rho_a = (p_matrix(pr,k)*100.)/(287.0*(t_kelvin)) 176 200 ! :: loop over hydrometeor type 177 do tp=1,nhclass 178 201 do tp=1,hp%nhclass 179 202 if (hm_matrix(tp,pr,k) <= 1E-12) cycle 180 181 phase = hp%phase(tp) 182 if(phase==0) then 183 itt = infind(mt_ttl,t_matrix(pr,k)) 184 else 185 itt = infind(mt_tti,t_matrix(pr,k)) 203 phase = hp%phase(tp) 204 if (phase==0) then 205 itt = infind(hp%mt_ttl,t_kelvin) 206 else 207 itt = infind(hp%mt_tti,t_kelvin) 208 endif 209 if (re_matrix(tp,pr,k).eq.0) then 210 call calc_Re(hm_matrix(tp,pr,k),Np_matrix(tp,pr,k),rho_a, & 211 hp%dtype(tp),hp%dmin(tp),hp%dmax(tp),hp%apm(tp),hp%bpm(tp), & 212 hp%rho(tp),hp%p1(tp),hp%p2(tp),hp%p3(tp),Re) 213 re_matrix(tp,pr,k)=Re 214 else 215 if (Np_matrix(tp,pr,k)>0) then 216 print *, 'Warning: Re and Np set for the same ', & 217 'volume & hydrometeor type. Np is being ignored.' 218 endif 219 Re = re_matrix(tp,pr,k) 220 endif 221 222 iRe_type=1 223 if(Re.gt.0) then 224 ! determine index in to scale LUT 225 ! 226 ! distance between Re points (defined by "base" and "step") for 227 ! each interval of size Re_BIN_LENGTH 228 ! Integer asignment, avoids calling floor intrinsic 229 n=Re/Re_BIN_LENGTH 230 if (n>=Re_MAX_BIN) n=Re_MAX_BIN-1 231 step=hp%step_list(n+1) 232 base=hp%base_list(n+1) 233 iRe_type=Re/step 234 if (iRe_type.lt.1) iRe_type=1 235 236 Re=step*(iRe_type+0.5) ! set value of Re to closest value allowed in LUT. 237 iRe_type=iRe_type+base-int(n*Re_BIN_LENGTH/step) 238 239 ! make sure iRe_type is within bounds 240 if (iRe_type.ge.nRe_types) then 241 ! write(*,*) 'Warning: size of Re exceed value permitted ', & 242 ! 'in Look-Up Table (LUT). Will calculate. ' 243 ! no scaling allowed 244 iRe_type=nRe_types 245 hp%Z_scale_flag(tp,itt,iRe_type)=.false. 246 else 247 ! set value in re_matrix to closest values in LUT 248 if (.not. DO_LUT_TEST) re_matrix(tp,pr,k)=Re 249 endif 250 endif 251 ! use Ze_scaled, Zr_scaled, and kr_scaled ... if know them 252 ! if not we will calculate Ze, Zr, and Kr from the distribution parameters 253 if( (.not. hp%Z_scale_flag(tp,itt,iRe_type)) .or. DO_LUT_TEST) then 254 ! :: create a distribution of hydrometeors within volume 255 select case(hp%dtype(tp)) 256 case(4) 257 ns = 1 258 allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns)) 259 Di = hp%p1(tp) 260 Ni = 0. 261 case default 262 ns = nd ! constant defined in radar_simulator_types.f90 263 allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns)) 264 Di = hp%D 265 Ni = 0. 266 end select 267 call dsd(hm_matrix(tp,pr,k),re_matrix(tp,pr,k),Np_matrix(tp,pr,k), & 268 Di,Ni,ns,hp%dtype(tp),rho_a,t_kelvin, & 269 hp%dmin(tp),hp%dmax(tp),hp%apm(tp),hp%bpm(tp), & 270 hp%rho(tp),hp%p1(tp),hp%p2(tp),hp%p3(tp)) 271 272 ! calculate particle density 273 if (phase == 1) then 274 if (hp%rho(tp) < 0) then 275 ! Use equivalent volume spheres. 276 hp%rho_eff(tp,1:ns,iRe_type) = 917 ! solid ice == equivalent volume approach 277 Deq = ( ( 6/pi*hp%apm(tp)/917 ) ** (1.0/3.0) ) * ( (Di*1E-6) ** (hp%bpm(tp)/3.0) ) * 1E6 278 ! alternative is to comment out above two lines and use the following block 279 ! MG Mie approach - adjust density of sphere with D = D_characteristic to match particle density 280 ! 281 ! hp%rho_eff(tp,1:ns,iRe_type) = (6/pi)*hp%apm(tp)*(Di*1E-6)**(hp%bpm(tp)-3) !MG Mie approach 282 283 ! as the particle size gets small it is possible that the mass to size relationship of 284 ! (given by power law in hclass.data) can produce impossible results 285 ! where the mass is larger than a solid sphere of ice. 286 ! This loop ensures that no ice particle can have more mass/density larger than an ice sphere. 287 ! do i=1,ns 288 ! if(hp%rho_eff(tp,i,iRe_type) > 917 ) then 289 ! hp%rho_eff(tp,i,iRe_type) = 917 290 ! endif 291 ! enddo 292 else 293 ! Equivalent volume sphere (solid ice rho_ice=917 kg/m^3). 294 hp%rho_eff(tp,1:ns,iRe_type) = 917 295 Deq=Di * ((hp%rho(tp)/917)**(1.0/3.0)) 296 ! alternative ... coment out above two lines and use the following for MG-Mie 297 ! hp%rho_eff(tp,1:ns,iRe_type) = hp%rho(tp) !MG Mie approach 298 endif 299 else 300 ! I assume here that water phase droplets are spheres. 301 ! hp%rho should be ~ 1000 or hp%apm=524 .and. hp%bpm=3 302 Deq = Di 303 endif 304 305 ! calculate effective reflectivity factor of volume 306 xxa = -9.9 307 rhoi = hp%rho_eff(tp,1:ns,iRe_type) 308 call zeff(hp%freq,Deq,Ni,ns,hp%k2,t_kelvin,phase,hp%do_ray, & 309 ze,zr,kr,xxa,xxa,rhoi) 310 311 ! test code ... compare Np value input to routine with sum of DSD 312 ! NOTE: if .not. DO_LUT_TEST, then you are checking the LUT approximation 313 ! not just the DSD representation given by Ni 314 if(Np_matrix(tp,pr,k)>0 .and. DO_NP_TEST ) then 315 Np = path_integral(Ni,Di,1,ns-1)/rho_a*1E6 316 ! Note: Representation is not great or small Re < 2 317 if( (Np_matrix(tp,pr,k)-Np)/Np_matrix(tp,pr,k)>0.1 ) then 318 write(*,*) 'Error: Np input does not match sum(N)' 319 write(*,*) tp,pr,k,Re,Ni(1),Ni(ns),10*log10(ze) 320 write(*,*) Np_matrix(tp,pr,k),Np,(Np_matrix(tp,pr,k)-Np)/Np_matrix(tp,pr,k) 321 write(*,*) 322 endif 323 endif 324 325 deallocate(Di,Ni,rhoi,xxa,Deq) 326 327 ! LUT test code 328 ! This segment of code compares full calculation to scaling result 329 if ( hp%Z_scale_flag(tp,itt,iRe_type) .and. DO_LUT_TEST ) then 330 scale_factor=rho_a*hm_matrix(tp,pr,k) 331 ! if more than 2 dBZe difference print error message/parameters. 332 if ( abs(10*log10(ze) - 10*log10(hp%Ze_scaled(tp,itt,iRe_type) * & 333 scale_factor)) > 2 ) then 334 write(*,*) 'Roj Error: ',tp,itt,iRe_type,hp%Z_scale_flag(tp,itt,iRe_type),n,step,base 335 write(*,*) 10*log10(ze),10*log10(hp%Ze_scaled(tp,itt,iRe_type) * scale_factor) 336 write(*,*) hp%Ze_scaled(tp,itt,iRe_type),scale_factor 337 write(*,*) re_matrix(tp,pr,k),Re 338 write(*,*) 339 endif 340 endif 341 342 else ! can use z scaling 343 scale_factor=rho_a*hm_matrix(tp,pr,k) 344 zr = hp%Zr_scaled(tp,itt,iRe_type) * scale_factor 345 ze = hp%Ze_scaled(tp,itt,iRe_type) * scale_factor 346 kr = hp%kr_scaled(tp,itt,iRe_type) * scale_factor 347 endif ! end z_scaling 348 349 kr_vol(pr,k) = kr_vol(pr,k) + kr 350 z_vol(pr,k) = z_vol(pr,k) + ze 351 z_ray(pr,k) = z_ray(pr,k) + zr 352 353 ! construct Ze_scaled, Zr_scaled, and kr_scaled ... if we can 354 if ( .not. hp%Z_scale_flag(tp,itt,iRe_type) ) then 355 if (iRe_type>1) then 356 scale_factor=rho_a*hm_matrix(tp,pr,k) 357 hp%Ze_scaled(tp,itt,iRe_type) = ze/ scale_factor 358 hp%Zr_scaled(tp,itt,iRe_type) = zr/ scale_factor 359 hp%kr_scaled(tp,itt,iRe_type) = kr/ scale_factor 360 hp%Z_scale_flag(tp,itt,iRe_type) = .true. 361 hp%Z_scale_added_flag(tp,itt,iRe_type)=.true. 362 endif 363 endif 364 365 enddo ! end loop of tp (hydrometeor type) 366 367 else 368 ! :: volume is hydrometeor-free 369 kr_vol(pr,k) = 0 370 z_vol(pr,k) = undef 371 z_ray(pr,k) = undef 186 372 endif 187 373 188 ! calculate Re if we have an exponential distribution with fixed No ... precipitation type particle 189 if( hp%dtype(tp)==2 .and. abs(hp%p2(tp)+1) < 1E-8) then 190 191 apm=hp%apm(tp) 192 bpm=hp%bpm(tp) 193 194 if ((hp%rho(tp) > 0) .and. (apm < 0)) then 195 apm = (pi/6)*hp%rho(tp) 196 bpm = 3. 197 endif 198 199 tmp1 = 1./(1.+bpm) 200 ld = ((apm*gamma(1.+bpm)*hp%p1(tp))/(rho_a*hm_matrix(tp,pr,k)*1E-3))**tmp1 201 202 Re = 1.5E6/ld 203 204 re_matrix(tp,pr,k) = Re; 205 206 endif 207 208 if(re_matrix(tp,pr,k).eq.0) then 209 210 iRe_type=1 211 Re=0 212 else 213 iRe_type=1 214 Re=re_matrix(tp,pr,k) 215 216 n=floor(Re/bin_length) 217 if(n==0) then 218 if(Re<25) then 219 step=0.5 220 base=0 221 else 222 step=1 223 base=25 224 endif 225 else 226 if(n>max_bin) then 227 n=max_bin 228 endif 229 230 step=step_list(n) 231 base=base_list(n) 232 endif 233 234 iRe_type=floor(Re/step) 235 236 if(iRe_type.lt.1) then 237 iRe_type=1 238 endif 239 240 Re=step*(iRe_type+0.5) 241 iRe_type=iRe_type+base-floor(n*bin_length/step) 242 243 ! make sure iRe_type is within bounds 244 if(iRe_type.ge.nRe_types) then 245 246 ! print *, tp, re_matrix(tp,pr,k), Re, iRe_type 247 248 ! no scaling allowed 249 Re=re_matrix(tp,pr,k) 250 251 iRe_type=nRe_types 252 hp%z_flag(tp,itt,iRe_type)=.false. 253 hp%scaled(tp,iRe_type)=.false. 254 endif 255 endif 256 257 ! use Ze_scaled, Zr_scaled, and kr_scaled ... if know them 258 ! if not we will calculate Ze, Zr, and Kr from the distribution parameters 259 if( .not. hp%z_flag(tp,itt,iRe_type) ) then 260 261 ! :: create a distribution of hydrometeors within volume 262 select case(hp%dtype(tp)) 263 case(4) 264 ns = 1 265 allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns)) 266 if (use_mie_table == 1) allocate(mt_qext(ns),mt_qbsca(ns),Ntemp(ns)) 267 Di = hp%p1(tp) 268 Ni = 0. 269 case default 270 ns = nsizes 271 allocate(Di(ns),Ni(ns),rhoi(ns),xxa(ns),Deq(ns)) 272 if (use_mie_table == 1) allocate(mt_qext(ns),mt_qbsca(ns),Ntemp(ns)) 273 Di = D 274 Ni = 0. 275 end select 276 277 ! :: create a DSD (using scaling factor if applicable) 278 ! hp%scaled(tp,iRe_type)=.false. ! turn off N scaling 279 280 call dsd(hm_matrix(tp,pr,k),Re,Di,Ni,ns,hp%dtype(tp),rho_a, & 281 t_matrix(pr,k),hp%dmin(tp),hp%dmax(tp),hp%apm(tp),hp%bpm(tp), & 282 hp%rho(tp),hp%p1(tp),hp%p2(tp),hp%p3(tp),hp%fc(tp,1:ns,iRe_type), & 283 hp%scaled(tp,iRe_type)) 284 285 ! :: calculate particle density 286 ! if ((hp%rho_eff(tp,1,iRe_type) < 0) .and. (phase == 1)) then 287 if (phase == 1) then 288 if (hp%rho(tp) < 0) then 289 290 ! MG Mie approach - adjust density of sphere with D = D_characteristic to match particle density 291 ! hp%rho_eff(tp,1:ns,iRe_type) = (6/pi)*hp%apm(tp)*(Di*1E-6)**(hp%bpm(tp)-3) !MG Mie approach 292 293 ! as the particle size gets small it is possible that the mass to size relationship of 294 ! (given by power law in hclass.data) can produce impossible results 295 ! where the mass is larger than a solid sphere of ice. 296 ! This loop ensures that no ice particle can have more mass/density larger than an ice sphere. 297 ! do i=1,ns 298 ! if(hp%rho_eff(tp,i,iRe_type) > 917 ) then 299 ! hp%rho_eff(tp,i,iRe_type) = 917 300 !endif 301 !enddo 302 303 ! alternative is to use equivalent volume spheres. 304 hp%rho_eff(tp,1:ns,iRe_type) = 917 ! solid ice == equivalent volume approach 305 Deq = ( ( 6/pi*hp%apm(tp)/917 ) ** (1.0/3.0) ) * & 306 ( (Di*1E-6) ** (hp%bpm(tp)/3.0) ) * 1E6 ! Di now really Deq in microns. 307 374 ! :: attenuation due to hydrometeors between radar and volume 375 ! 376 ! NOTE old scheme integrates attenuation only for the layers ABOVE 377 ! the current layer ... i.e. 1 to k-1 rather than 1 to k ... 378 ! which may be a problem. ROJ 379 ! in the new scheme I assign half the attenuation to the current layer 380 if(d_gate==1) then 381 ! dheight calcuations assumes hgt_matrix points are the cell mid-points. 382 if (k>2) then 383 ! add to previous value to half of above layer + half of current layer 384 a_to_vol(pr,k)= a_to_vol(pr,k-1) + & 385 (kr_vol(pr,k-1)+kr_vol(pr,k))*(hgt_matrix(pr,k-1)-hgt_matrix(pr,k)) 386 else 387 a_to_vol(pr,k)= kr_vol(pr,k)*(hgt_matrix(pr,k)-hgt_matrix(pr,k+1)) 388 endif 389 else ! d_gate==-1 390 if(k<ngate) then 391 ! add to previous value half of above layer + half of current layer 392 a_to_vol(pr,k) = a_to_vol(pr,k+1) + & 393 (kr_vol(pr,k+1)+kr_vol(pr,k))*(hgt_matrix(pr,k+1)-hgt_matrix(pr,k)) 394 else 395 a_to_vol(pr,k)= kr_vol(pr,k)*(hgt_matrix(pr,k)-hgt_matrix(pr,k-1)) 396 endif 397 endif 398 399 ! :: attenuation due to gaseous absorption between radar and volume 400 if (g_to_vol_in_present) then 401 g_to_vol(pr,k) = g_to_vol_in(pr,k) 402 else 403 if ( (hp%use_gas_abs == 1) .or. ((hp%use_gas_abs == 2) .and. (pr == 1)) ) then 404 g_vol(pr,k) = gases(p_matrix(pr,k),t_kelvin,rh_matrix(pr,k),hp%freq) 405 if (d_gate==1) then 406 if (k>1) then 407 ! add to previous value to half of above layer + half of current layer 408 g_to_vol(pr,k) = g_to_vol(pr,k-1) + & 409 0.5*(g_vol(pr,k-1)+g_vol(pr,k))*(hgt_matrix(pr,k-1)-hgt_matrix(pr,k)) 308 410 else 309 310 ! hp%rho_eff(tp,1:ns,iRe_type) = hp%rho(tp) !MG Mie approach 311 312 ! Equivalent volume sphere (solid ice rho_ice=917 kg/m^3). 313 hp%rho_eff(tp,1:ns,iRe_type) = 917 314 Deq=Di * ((hp%rho(tp)/917)**(1.0/3.0)) 315 316 endif 317 318 ! if using equivalent volume spheres 319 if (use_mie_table == 1) then 320 321 Ntemp=Ni 322 323 ! Find N(Di) from N(Deq) which we know 324 do i=1,ns 325 j=infind(Deq,Di(i)) 326 Ni(i)=Ntemp(j) 327 enddo 328 else 329 ! just use Deq and D variable input to mie code 330 Di=Deq; 331 endif 332 333 endif 334 rhoi = hp%rho_eff(tp,1:ns,iRe_type) 335 336 ! :: calculate effective reflectivity factor of volume 337 if (use_mie_table == 1) then 338 339 if ((hp%dtype(tp) == 4) .and. (hp%idd(tp) < 0)) then 340 hp%idd(tp) = infind(mt%D,Di(1)) 341 endif 342 343 if (phase == 0) then 344 345 ! itt = infind(mt_ttl,t_matrix(pr,k)) 346 select case(hp%dtype(tp)) 347 case(4) 348 mt_qext(1) = mt%qext(hp%idd(tp),itt,1,iff) 349 mt_qbsca(1) = mt%qbsca(hp%idd(tp),itt,1,iff) 350 case default 351 mt_qext = mt%qext(:,itt,1,iff) 352 mt_qbsca = mt%qbsca(:,itt,1,iff) 353 end select 354 355 call zeff(freq,Di,Ni,ns,k2,mt_ttl(itt),0,do_ray, & 356 ze,zr,kr,mt_qext,mt_qbsca,xx) 357 358 else 359 360 ! itt = infind(mt_tti,t_matrix(pr,k)) 361 select case(hp%dtype(tp)) 362 case(4) 363 if (hp%ifc(tp,1,iRe_type) < 0) then 364 hp%ifc(tp,1,iRe_type) = infind(mt%f,rhoi(1)/917.) 365 endif 366 mt_qext(1) = & 367 mt%qext(hp%idd(tp),itt+cnt_liq,hp%ifc(tp,1,iRe_type),iff) 368 mt_qbsca(1) = & 369 mt%qbsca(hp%idd(tp),itt+cnt_liq,hp%ifc(tp,1,iRe_type),iff) 370 case default 371 do i=1,ns 372 if (hp%ifc(tp,i,iRe_type) < 0) then 373 hp%ifc(tp,i,iRe_type) = infind(mt%f,rhoi(i)/917.) 374 endif 375 mt_qext(i) = mt%qext(i,itt+cnt_liq,hp%ifc(tp,i,iRe_type),iff) 376 mt_qbsca(i) = mt%qbsca(i,itt+cnt_liq,hp%ifc(tp,i,iRe_type),iff) 377 enddo 378 end select 379 380 call zeff(freq,Di,Ni,ns,k2,mt_tti(itt),1,do_ray, & 381 ze,zr,kr,mt_qext,mt_qbsca,xx) 382 383 endif 384 385 else 386 387 xxa = -9.9 388 call zeff(freq,Di,Ni,ns,k2,t_matrix(pr,k),phase,do_ray, & 389 ze,zr,kr,xxa,xxa,rhoi) 390 391 392 endif ! end of use mie table 393 394 ! xxa = -9.9 395 !call zeff(freq,Di,Ni,ns,k2,t_matrix(pr,k),phase,do_ray, & 396 ! ze2,zr,kr2,xxa,xxa,rhoi) 397 398 ! if(abs(ze2-ze)/ze2 > 0.1) then 399 ! if(abs(kr2-kr)/kr2 > 0.1) then 400 401 ! write(*,*) pr,k,tp,ze2,ze2-ze,abs(ze2-ze)/ze2,itt+cnt_liq,iff 402 ! write(*,*) pr,k,tp,ze2,kr2,kr2-kr,abs(kr2-kr)/kr2 403 ! stop 404 405 !endif 406 407 deallocate(Di,Ni,rhoi,xxa,Deq) 408 if (use_mie_table == 1) deallocate(mt_qext,mt_qbsca,Ntemp) 409 410 else ! can use z scaling 411 412 if( hp%dtype(tp)==2 .and. abs(hp%p2(tp)+1) < 1E-8 ) then 413 414 ze = hp%Ze_scaled(tp,itt,iRe_type) 415 zr = hp%Zr_scaled(tp,itt,iRe_type) 416 kr = hp%kr_scaled(tp,itt,iRe_type) 417 418 else 419 scale_factor=rho_a*hm_matrix(tp,pr,k) 420 421 zr = hp%Zr_scaled(tp,itt,iRe_type) * scale_factor 422 ze = hp%Ze_scaled(tp,itt,iRe_type) * scale_factor 423 kr = hp%kr_scaled(tp,itt,iRe_type) * scale_factor 424 endif 425 426 endif ! end z_scaling 427 428 ! kr=0 429 430 kr_vol(k) = kr_vol(k) + kr 431 z_vol(k) = z_vol(k) + ze 432 z_ray(k) = z_ray(k) + zr 433 434 ! construct Ze_scaled, Zr_scaled, and kr_scaled ... if we can 435 if( .not. hp%z_flag(tp,itt,iRe_type) .and. 1.eq.1 ) then 436 437 if( ( (hp%dtype(tp)==1 .or. hp%dtype(tp)==5 .or. hp%dtype(tp)==2) .and. abs(hp%p1(tp)+1) < 1E-8 ) .or. & 438 ( hp%dtype(tp)==3 .or. hp%dtype(tp)==4 ) & 439 ) then 440 441 scale_factor=rho_a*hm_matrix(tp,pr,k) 442 443 hp%Ze_scaled(tp,itt,iRe_type) = ze/ scale_factor 444 hp%Zr_scaled(tp,itt,iRe_type) = zr/ scale_factor 445 hp%kr_scaled(tp,itt,iRe_type) = kr/ scale_factor 446 447 hp%z_flag(tp,itt,iRe_type)=.True. 448 449 elseif( hp%dtype(tp)==2 .and. abs(hp%p2(tp)+1) < 1E-8 ) then 450 451 hp%Ze_scaled(tp,itt,iRe_type) = ze 452 hp%Zr_scaled(tp,itt,iRe_type) = zr 453 hp%kr_scaled(tp,itt,iRe_type) = kr 454 455 hp%z_flag(tp,itt,iRe_type)=.True. 456 endif 457 458 endif 459 460 enddo ! end loop of tp (hydrometeor type) 461 411 g_to_vol(pr,k)= 0.5*g_vol(pr,k)*(hgt_matrix(pr,k)-hgt_matrix(pr,k+1)) 412 endif 413 else ! d_gate==-1 414 if (k<ngate) then 415 ! add to previous value to half of above layer + half of current layer 416 g_to_vol(pr,k) = g_to_vol(pr,k+1) + & 417 0.5*(g_vol(pr,k+1)+g_vol(pr,k))*(hgt_matrix(pr,k+1)-hgt_matrix(pr,k)) 418 else 419 g_to_vol(pr,k)= 0.5*g_vol(pr,k)*(hgt_matrix(pr,k)-hgt_matrix(pr,k-1)) 420 endif 421 endif 422 elseif(hp%use_gas_abs == 2) then 423 ! using value calculated for the first column 424 g_to_vol(pr,k) = g_to_vol(1,k) 425 elseif (hp%use_gas_abs == 0) then 426 g_to_vol(pr,k) = 0 427 endif 428 endif 429 430 ! Compute Rayleigh reflectivity, and full, attenuated reflectivity 431 if ((hp%do_ray == 1) .and. (z_ray(pr,k) > 0)) then 432 Ze_ray(pr,k) = 10*log10(z_ray(pr,k)) 462 433 else 463 ! :: volume is hydrometeor-free 464 465 kr_vol(k) = 0 466 z_vol(k) = -999 467 z_ray(k) = -999 468 434 Ze_ray(pr,k) = undef 469 435 endif 470 471 ! :: attenuation due to hydrometeors between radar and volume 472 a_to_vol(k) = 2*path_integral(kr_vol,hgt_matrix(pr,:),1,k-1) 473 474 ! :: attenuation due to gaseous absorption between radar and volume 475 if (g_to_vol_in_present) then 476 g_to_vol(k) = g_to_vol_in(k,pr) 436 if (z_vol(pr,k) > 0) then 437 Ze_non(pr,k) = 10*log10(z_vol(pr,k)) 438 dBZe(pr,k) = Ze_non(pr,k)-a_to_vol(pr,k)-g_to_vol(pr,k) 477 439 else 478 if ( (use_gas_abs == 1) .or. ((use_gas_abs == 2) .and. (pr == 1)) ) then 479 g_vol(k) = gases(p_matrix(pr,k),t_matrix(pr,k)+273.15, & 480 rh_matrix(pr,k),freq) 481 g_to_vol(k) = path_integral(g_vol,hgt_matrix(pr,:),1,k-1) 482 elseif (use_gas_abs == 0) then 483 g_to_vol(k) = 0 484 endif 440 dBZe(pr,k) = undef 441 Ze_non(pr,k) = undef 485 442 endif 486 487 ! kr_matrix(pr,:)=kr_vol 488 489 ! :: store results in matrix for return to calling program 490 h_atten_to_vol(pr,k)=a_to_vol(k) 491 g_atten_to_vol(pr,k)=g_to_vol(k) 492 if ((do_ray == 1) .and. (z_ray(k) > 0)) then 493 Ze_ray(pr,k) = 10*log10(z_ray(k)) 494 else 495 Ze_ray(pr,k) = -999 496 endif 497 if (z_vol(k) > 0) then 498 dBZe(pr,k) = 10*log10(z_vol(k))-a_to_vol(k)-g_to_vol(k) 499 Ze_non(pr,k) = 10*log10(z_vol(k)) 500 else 501 dBZe(pr,k) = -999 502 Ze_non(pr,k) = -999 503 endif 504 505 enddo ! end loop of k (range gate) 506 ! Output array with gaseous absorption 507 if (g_to_vol_out_present) g_to_vol_out(:,pr) = g_to_vol 508 enddo ! end loop over pr (profile) 443 444 enddo ! end loop over pr (profile) 445 446 enddo ! end loop of k (range gate) 447 448 ! Output array with gaseous absorption 449 if (g_to_vol_out_present) g_to_vol_out = g_to_vol 450 451 ! save any updates made 452 if (hp%update_scale_LUTs) call save_scale_LUTs(hp) 509 453 510 454 end subroutine radar_simulator 511 -
LMDZ5/trunk/libf/phylmd/cosp/radar_simulator_types.F90
r1907 r2428 3 3 ! Collection of common variables and types 4 4 ! Part of QuickBeam v1.03 by John Haynes 5 ! http://reef.atmos.colostate.edu/haynes/radarsim5 ! Updated by Roj Marchand June 2010 6 6 7 7 integer, parameter :: & 8 maxhclass = 20 ,& ! max number of hydrometeor classes 9 nd = 85 ,& ! number of discrete particles 10 nRe_types = 250 ! number or Re size bins allowed in N and Z_scaled look up table 8 maxhclass = 20 ,& ! max number of hydrometeor classes 9 nRe_types = 550 ! max number or Re size bins allowed in N and Z_scaled look up table 11 10 11 ! These variables define discrete diameters used to represent the DSDs. 12 integer, parameter :: & 13 nd = 85 ! number of discrete particles used in construction DSDs 12 14 real*8, parameter :: & 13 15 dmin = 0.1 ,& ! min size of discrete particle 14 dmax = 10000. 16 dmax = 10000. ! max size of discrete particle 15 17 16 integer, parameter :: & 18 integer, parameter :: & ! These parameters used to define temperature intervals in mie LUTs 17 19 mt_nfreq = 5 , & 18 mt_ntt = 39 , & ! num temperatures in table 19 mt_nf = 14 , & ! number of ice fractions in table 20 mt_nd = 85 ! num discrete mode-p drop sizes in table 20 mt_ntt = 39 , & ! num temperatures in table 21 mt_nf = 14 , & ! number of ice fractions in table 22 mt_nd = 85 ! num discrete mode-p drop sizes in table 23 24 integer, parameter :: & ! These parameters used to defines Re intervals in scale LUTs 25 Re_BIN_LENGTH=10, & 26 Re_MAX_BIN=250 27 28 integer, parameter :: & ! These parameters used to define Temperature invervals in scale LUTs 29 cnt_liq = 19, & ! liquid temperature count 30 cnt_ice = 20 ! ice temperature count 21 31 22 32 … … 24 34 25 35 type class_param 36 37 ! variables used to store hydrometeor "default" properties 26 38 real*8, dimension(maxhclass) :: p1,p2,p3,dmin,dmax,apm,bpm,rho 27 39 integer, dimension(maxhclass) :: dtype,col,cp,phase 28 logical, dimension(maxhclass,nRe_types) :: scaled 29 logical, dimension(maxhclass,mt_ntt,nRe_types) :: z_flag 40 41 ! Radar properties 42 real*8 :: freq,k2 43 integer :: nhclass ! number of hydrometeor classes in use 44 integer :: use_gas_abs, do_ray 45 46 ! defines location of radar relative to hgt_matrix. 47 logical :: radar_at_layer_one ! if true radar is assume to be at the edge 48 ! of the first layer, if the first layer is the 49 ! surface than a ground-based radar. If the 50 ! first layer is the top-of-atmosphere, then 51 ! a space borne radar. 52 53 ! variables used to store Z scale factors 54 character*240 :: scale_LUT_file_name 55 logical :: load_scale_LUTs, update_scale_LUTs 56 logical, dimension(maxhclass,nRe_types) :: N_scale_flag 57 logical, dimension(maxhclass,mt_ntt,nRe_types) :: Z_scale_flag,Z_scale_added_flag 30 58 real*8, dimension(maxhclass,mt_ntt,nRe_types) :: Ze_scaled,Zr_scaled,kr_scaled 31 59 real*8, dimension(maxhclass,nd,nRe_types) :: fc, rho_eff 32 integer, dimension(maxhclass,nd,nRe_types) :: ifc 33 integer, dimension(maxhclass) :: idd 60 61 ! used to determine Re index 62 real*8 :: step_list(Re_MAX_BIN),base_list(Re_MAX_BIN) 63 64 ! used to determine temperature index 65 real*8 :: & 66 mt_ttl(cnt_liq), & ! liquid temperatures (K) 67 mt_tti(cnt_ice) ! ice temperatures (K) 68 69 real*8 :: D(nd) ! set of discrete diameters used to represent DSDs 70 34 71 end type class_param 35 36 ! ----- mie table structure -----37 72 38 type mie 39 real*8 :: freq(mt_nfreq), tt(mt_ntt), f(mt_nf), D(mt_nd) 40 real*8, dimension(mt_nd,mt_ntt,mt_nf,mt_nfreq) :: qext, qbsca 41 integer :: phase(mt_ntt) 42 end type mie 43 44 real*8, dimension(:), save, allocatable :: & 45 mt_ttl, & ! liquid temperatures (C) 46 mt_tti, & ! ice temperatures (C) 47 mt_qext, mt_qbsca ! extincion/backscatter efficiency 48 !$OMP THREADPRIVATE(mt_ttl,mt_tti,mt_qext, mt_qbsca) 49 50 integer*4,save :: & 51 cnt_liq, & ! liquid temperature count 52 cnt_ice ! ice temperature count 53 !$OMP THREADPRIVATE(cnt_liq,cnt_ice) 54 73 55 74 end module radar_simulator_types -
LMDZ5/trunk/libf/phylmd/cosp/read_cosp_output_nl.F90
r1907 r2428 11 11 integer :: i 12 12 13 logical, save :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim, & 14 Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, & 15 Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2,Lcllcalipso, & 16 Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp,Ltclisccp, & 17 Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 18 Lfrac_out,Lbeta_mol532,Ltbrttov 19 20 namelist/COSP_OUTPUT/Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim, & 21 Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, & 22 Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2, & 23 Lcllcalipso,Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp, & 24 Ltclisccp,Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 25 Lfrac_out,Lbeta_mol532,Ltbrttov 26 13 !! AI 14 ! logical, save :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim, & 15 ! Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, & 16 ! Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2,Lcllcalipso, & 17 ! Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp,Ltclisccp, & 18 ! Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 19 ! Lfrac_out,Lbeta_mol532,Ltbrttov 20 21 ! namelist/COSP_OUTPUT/Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim, & 22 ! Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,Lcfad_dbze94, & 23 ! Lcfad_lidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp2, & 24 ! Lcllcalipso,Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lctpisccp,Ldbze94,Ltauisccp, & 25 ! Ltclisccp,Llongitude,Llatitude,Lparasol_refl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 26 ! Lfrac_out,Lbeta_mol532,Ltbrttov 27 !! 28 29 logical, save :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim, & 30 Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,LcfadDbze94, & 31 LcfadLidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp,Lcllcalipso, & 32 Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lpctisccp,Ldbze94,Ltauisccp,Lcltisccp, & 33 Lclcalipsoliq,Lclcalipsoice,Lclcalipsoun, & 34 Lclcalipsotmp,Lclcalipsotmpliq,Lclcalipsotmpice,Lclcalipsotmpun, & 35 Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun, & 36 Lclhcalipsoliq,Lclhcalipsoice,Lclhcalipsoun, & 37 Lclmcalipsoliq,Lclmcalipsoice,Lclmcalipsoun, & 38 Lcllcalipsoliq,Lcllcalipsoice,Lcllcalipsoun, & 39 Ltoffset,LparasolRefl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 40 Lfracout,LlidarBetaMol532,Ltbrttov, & 41 Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, & 42 Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, & 43 Liwpmodis,Lclmodis 44 45 namelist/COSP_OUTPUT/Lradar_sim,Llidar_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim, & 46 Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,LcfadDbze94, & 47 LcfadLidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp, & 48 Lcllcalipso,Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lpctisccp,Ldbze94,Ltauisccp, & 49 Lclcalipsoliq,Lclcalipsoice,Lclcalipsoun, & 50 Lclcalipsotmp,Lclcalipsotmpliq,Lclcalipsotmpice,Lclcalipsotmpun, & 51 Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun, & 52 Lclhcalipsoliq,Lclhcalipsoice,Lclhcalipsoun, & 53 Lclmcalipsoliq,Lclmcalipsoice,Lclmcalipsoun, & 54 Lcllcalipsoliq,Lcllcalipsoice,Lcllcalipsoun, & 55 Lcltisccp,Ltoffset,LparasolRefl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, & 56 Lfracout,LlidarBetaMol532,Ltbrttov, & 57 Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, & 58 Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, & 59 Liwpmodis,Lclmodis 60 27 61 do i=1,N_OUT_LIST 28 62 cfg%out_list(i)='' … … 38 72 CALL bcast(Llidar_sim) 39 73 CALL bcast(Lisccp_sim) 74 CALL bcast(Lmodis_sim) 40 75 CALL bcast(Lmisr_sim) 41 76 CALL bcast(Lrttov_sim) … … 49 84 CALL bcast(Lclcalipso) 50 85 CALL bcast(Lclhcalipso) 86 CALL bcast(Lclcalipsoliq) 87 CALL bcast(Lclcalipsoice) 88 CALL bcast(Lclcalipsoun) 89 CALL bcast(Lclcalipsotmp) 90 CALL bcast(Lclcalipsotmpliq) 91 CALL bcast(Lclcalipsotmpice) 92 CALL bcast(Lclcalipsotmpun) 93 CALL bcast(Lcltcalipsoliq) 94 CALL bcast(Lcltcalipsoice) 95 CALL bcast(Lcltcalipsoun) 96 CALL bcast(Lclhcalipsoliq) 97 CALL bcast(Lclhcalipsoice) 98 CALL bcast(Lclhcalipsoun) 99 CALL bcast(Lclmcalipsoliq) 100 CALL bcast(Lclmcalipsoice) 101 CALL bcast(Lclmcalipsoun) 102 CALL bcast(Lcllcalipsoliq) 103 CALL bcast(Lcllcalipsoice) 104 CALL bcast(Lcllcalipsoun) 51 105 CALL bcast(Lclisccp2) 52 106 CALL bcast(Lcllcalipso) … … 57 111 CALL bcast(Ldbze94) 58 112 CALL bcast(Ltauisccp) 59 CALL bcast(Ltclisccp) 60 CALL bcast(Llongitude) 61 CALL bcast(Llatitude) 113 CALL bcast(Lcltisccp) 62 114 CALL bcast(Lparasol_refl) 63 115 CALL bcast(LclMISR) … … 66 118 CALL bcast(Lfrac_out) 67 119 CALL bcast(Lbeta_mol532) 120 CALL bcast(Lcltmodis) 121 CALL bcast(Lclwmodis) 122 CALL bcast(Lclimodis) 123 CALL bcast(Lclhmodis) 124 CALL bcast(Lclmmodis) 125 CALL bcast(Lcllmodis) 126 CALL bcast(Ltautmodis) 127 CALL bcast(Ltauwmodis) 128 CALL bcast(Ltauimodis) 129 CALL bcast(Ltautlogmodis) 130 CALL bcast(Ltauwlogmodis) 131 CALL bcast(Ltauilogmodis) 132 CALL bcast(Lreffclwmodis) 133 CALL bcast(Lreffclimodis) 134 CALL bcast(Lpctmodis) 135 CALL bcast(Llwpmodis) 136 CALL bcast(Liwpmodis) 137 CALL bcast(Lclmodis) 68 138 CALL bcast(Ltbrttov) 69 139 !$OMP BARRIER … … 92 162 Lparasol_refl = .false. 93 163 Lbeta_mol532 = .false. 164 !! AI 165 Lclcalipsoliq = .false. 166 Lclcalipsoice = .false. 167 Lclcalipsoun = .false. 168 Lclcalipsotmp = .false. 169 Lclcalipsotmpun = .false. 170 Lclcalipsotmpliq = .false. 171 Lclcalipsotmpice = .false. 172 Lclhcalipsoliq = .false. 173 Lcllcalipsoliq = .false. 174 Lclmcalipsoliq = .false. 175 Lcltcalipsoliq = .false. 176 Lclhcalipsoice = .false. 177 Lcllcalipsoice = .false. 178 Lclmcalipsoice = .false. 179 Lcltcalipsoice = .false. 180 Lclhcalipsoun = .false. 181 Lcllcalipsoun = .false. 182 Lclmcalipsoun = .false. 183 Lcltcalipsoun = .false. 94 184 endif 95 185 if (.not.Lisccp_sim) then … … 114 204 Lfrac_out = .false. 115 205 endif 206 if (.not.Lmodis_sim) then 207 Lcltmodis=.false. 208 Lclwmodis=.false. 209 Lclimodis=.false. 210 Lclhmodis=.false. 211 Lclmmodis=.false. 212 Lcllmodis=.false. 213 Ltautmodis=.false. 214 Ltauwmodis=.false. 215 Ltauimodis=.false. 216 Ltautlogmodis=.false. 217 Ltauwlogmodis=.false. 218 Ltauilogmodis=.false. 219 Lreffclwmodis=.false. 220 Lreffclimodis=.false. 221 Lpctmodis=.false. 222 Llwpmodis=.false. 223 Liwpmodis=.false. 224 Lclmodis=.false. 225 endif 226 if (Lmodis_sim) Lisccp_sim = .true. 116 227 117 228 ! Diagnostics that use Radar and Lidar … … 130 241 cfg%Llidar_sim = Llidar_sim 131 242 cfg%Lisccp_sim = Lisccp_sim 243 cfg%Lmodis_sim = Lmodis_sim 132 244 cfg%Lmisr_sim = Lmisr_sim 133 245 cfg%Lrttov_sim = Lrttov_sim … … 149 261 if (Lboxtauisccp) cfg%out_list(i) = 'boxtauisccp' 150 262 i = i+1 151 if (Lcfad _dbze94) cfg%out_list(i) = 'cfad_dbze94'152 i = i+1 153 if (Lcfad _lidarsr532) cfg%out_list(i) = 'cfad_lidarsr532'263 if (LcfadDbze94) cfg%out_list(i) = 'cfadDbze94' 264 i = i+1 265 if (LcfadLidarsr532) cfg%out_list(i) = 'cfadLidarsr532' 154 266 i = i+1 155 267 if (Lclcalipso2) cfg%out_list(i) = 'clcalipso2' … … 159 271 if (Lclhcalipso) cfg%out_list(i) = 'clhcalipso' 160 272 i = i+1 161 if (Lclisccp 2) cfg%out_list(i) = 'clisccp2'273 if (Lclisccp) cfg%out_list(i) = 'clisccp' 162 274 i = i+1 163 275 if (Lcllcalipso) cfg%out_list(i) = 'cllcalipso' … … 167 279 if (Lcltcalipso) cfg%out_list(i) = 'cltcalipso' 168 280 i = i+1 281 282 if (Lcllcalipsoice) cfg%out_list(i) = 'cllcalipsoice' 283 i = i+1 284 if (Lclmcalipsoice) cfg%out_list(i) = 'clmcalipsoice' 285 i = i+1 286 if (Lclhcalipsoice) cfg%out_list(i) = 'clhcalipsoice' 287 i = i+1 288 if (Lcltcalipsoice) cfg%out_list(i) = 'cltcalipsoice' 289 i = i+1 290 if (Lcllcalipsoliq) cfg%out_list(i) = 'cllcalipsoliq' 291 i = i+1 292 if (Lclmcalipsoliq) cfg%out_list(i) = 'clmcalipsoliq' 293 i = i+1 294 if (Lclhcalipsoliq) cfg%out_list(i) = 'clhcalipsoliq' 295 i = i+1 296 if (Lcltcalipsoliq) cfg%out_list(i) = 'cltcalipsoliq' 297 i = i+1 298 if (Lcllcalipsoun) cfg%out_list(i) = 'cllcalipsoun' 299 i = i+1 300 if (Lclmcalipsoun) cfg%out_list(i) = 'clmcalipsoun' 301 i = i+1 302 if (Lclhcalipsoun) cfg%out_list(i) = 'clhcalipsoun' 303 i = i+1 304 if (Lcltcalipsoun) cfg%out_list(i) = 'cltcalipsoun' 305 i = i+1 306 307 if (Lclcalipsoice) cfg%out_list(i) = 'clcalipsoice' 308 i = i+1 309 if (Lclcalipsoliq) cfg%out_list(i) = 'clcalipsoliq' 310 i = i+1 311 if (Lclcalipsoun) cfg%out_list(i) = 'clcalipsoun' 312 i = i+1 313 314 if (Lclcalipsotmp) cfg%out_list(i) = 'clcalipsotmp' 315 i = i+1 316 if (Lclcalipsotmpice) cfg%out_list(i) = 'clcalipsotmpice' 317 i = i+1 318 if (Lclcalipsotmpliq) cfg%out_list(i) = 'clcalipsotmpliq' 319 i = i+1 320 if (Lclcalipsotmpun) cfg%out_list(i) = 'clcalipsotmpun' 321 i = i+1 169 322 if (Lcltlidarradar) cfg%out_list(i) = 'cltlidarradar' 170 323 i = i+1 171 if (L ctpisccp) cfg%out_list(i) = 'ctpisccp'324 if (Lpctisccp) cfg%out_list(i) = 'pctisccp' 172 325 i = i+1 173 326 if (Ldbze94) cfg%out_list(i) = 'dbze94' … … 175 328 if (Ltauisccp) cfg%out_list(i) = 'tauisccp' 176 329 i = i+1 177 if (Ltclisccp) cfg%out_list(i) = 'tclisccp' 178 i = i+1 179 if (Llongitude) cfg%out_list(i) = 'lon' 180 i = i+1 181 if (Llatitude) cfg%out_list(i) = 'lat' 182 i = i+1 183 if (Lparasol_refl) cfg%out_list(i) = 'parasol_refl' 330 if (Lcltisccp) cfg%out_list(i) = 'cltisccp' 331 i = i+1 332 if (Ltoffset) cfg%out_list(i) = 'toffset' 333 i = i+1 334 if (LparasolRefl) cfg%out_list(i) = 'parasolRefl' 184 335 i = i+1 185 336 if (LclMISR) cfg%out_list(i) = 'clMISR' … … 189 340 if (Lmeantbclrisccp) cfg%out_list(i) = 'meantbclrisccp' 190 341 i = i+1 191 if (Lfrac _out) cfg%out_list(i) = 'frac_out'192 i = i+1 193 if (L beta_mol532) cfg%out_list(i) = 'beta_mol532'342 if (Lfracout) cfg%out_list(i) = 'fracout' 343 i = i+1 344 if (LlidarBetaMol532) cfg%out_list(i) = 'lidarBetaMol532' 194 345 i = i+1 195 346 if (Ltbrttov) cfg%out_list(i) = 'tbrttov' 196 347 i = i+1 348 if (Lcltmodis) cfg%out_list(i) = 'cltmodis' 349 i = i+1 350 if (Lclwmodis) cfg%out_list(i) = 'clwmodis' 351 i = i+1 352 if (Lclimodis) cfg%out_list(i) = 'climodis' 353 i = i+1 354 if (Lclhmodis) cfg%out_list(i) = 'clhmodis' 355 i = i+1 356 if (Lclmmodis) cfg%out_list(i) = 'clmmodis' 357 i = i+1 358 if (Lcllmodis) cfg%out_list(i) = 'cllmodis' 359 i = i+1 360 if (Ltautmodis) cfg%out_list(i) = 'tautmodis' 361 i = i+1 362 if (Ltauwmodis) cfg%out_list(i) = 'tauwmodis' 363 i = i+1 364 if (Ltauimodis) cfg%out_list(i) = 'tauimodis' 365 i = i+1 366 if (Ltautlogmodis) cfg%out_list(i) = 'tautlogmodis' 367 i = i+1 368 if (Ltauwlogmodis) cfg%out_list(i) = 'tauwlogmodis' 369 i = i+1 370 if (Ltauilogmodis) cfg%out_list(i) = 'tauilogmodis' 371 i = i+1 372 if (Lreffclwmodis) cfg%out_list(i) = 'reffclwmodis' 373 i = i+1 374 if (Lreffclimodis) cfg%out_list(i) = 'reffclimodis' 375 i = i+1 376 if (Lpctmodis) cfg%out_list(i) = 'pctmodis' 377 i = i+1 378 if (Llwpmodis) cfg%out_list(i) = 'lwpmodis' 379 i = i+1 380 if (Liwpmodis) cfg%out_list(i) = 'iwpmodis' 381 i = i+1 382 if (Lclmodis) cfg%out_list(i) = 'clmodis' 383 197 384 if (i /= N_OUT_LIST) then 198 385 print *, 'COSP_IO: wrong number of output diagnostics' 386 print *, i,N_OUT_LIST 199 387 stop 200 388 endif 201 389 202 390 ! Copy diagnostic flags to cfg structure 391 ! ISCCP simulator 203 392 cfg%Lalbisccp = Lalbisccp 204 393 cfg%Latb532 = Latb532 205 394 cfg%Lboxptopisccp = Lboxptopisccp 206 395 cfg%Lboxtauisccp = Lboxtauisccp 207 cfg%Lcfad_dbze94 = Lcfad_dbze94 208 cfg%Lcfad_lidarsr532 = Lcfad_lidarsr532 396 cfg%Lmeantbisccp = Lmeantbisccp 397 cfg%Lmeantbclrisccp = Lmeantbclrisccp 398 cfg%Lclisccp = Lclisccp 399 cfg%Lpctisccp = Lpctisccp 400 cfg%Ltauisccp = Ltauisccp 401 cfg%Lcltisccp = Lcltisccp 402 ! CloudSat simulator 403 cfg%Ldbze94 = Ldbze94 404 cfg%LcfadDbze94 = LcfadDbze94 405 ! CALIPSO/PARASOL simulator 406 cfg%LcfadLidarsr532 = LcfadLidarsr532 209 407 cfg%Lclcalipso2 = Lclcalipso2 210 408 cfg%Lclcalipso = Lclcalipso 211 409 cfg%Lclhcalipso = Lclhcalipso 212 cfg%Lclisccp2 = Lclisccp2213 410 cfg%Lcllcalipso = Lcllcalipso 214 411 cfg%Lclmcalipso = Lclmcalipso 215 412 cfg%Lcltcalipso = Lcltcalipso 413 cfg%Lclhcalipsoice = Lclhcalipsoice 414 cfg%Lcllcalipsoice = Lcllcalipsoice 415 cfg%Lclmcalipsoice = Lclmcalipsoice 416 cfg%Lcltcalipsoice = Lcltcalipsoice 417 cfg%Lclhcalipsoliq = Lclhcalipsoliq 418 cfg%Lcllcalipsoliq = Lcllcalipsoliq 419 cfg%Lclmcalipsoliq = Lclmcalipsoliq 420 cfg%Lcltcalipsoliq = Lcltcalipsoliq 421 cfg%Lclhcalipsoun = Lclhcalipsoun 422 cfg%Lcllcalipsoun = Lcllcalipsoun 423 cfg%Lclmcalipsoun = Lclmcalipsoun 424 cfg%Lcltcalipsoun = Lcltcalipsoun 425 cfg%Lclcalipsoice = Lclcalipsoice 426 cfg%Lclcalipsoliq = Lclcalipsoliq 427 cfg%Lclcalipsoun = Lclcalipsoun 428 cfg%Lclcalipsotmp = Lclcalipsotmp 429 cfg%Lclcalipsotmpice = Lclcalipsotmpice 430 cfg%Lclcalipsotmpliq = Lclcalipsotmpliq 431 cfg%Lclcalipsotmpun = Lclcalipsotmpun 216 432 cfg%Lcltlidarradar = Lcltlidarradar 217 cfg%Lctpisccp = Lctpisccp 218 cfg%Ldbze94 = Ldbze94 219 cfg%Ltauisccp = Ltauisccp 220 cfg%Ltclisccp = Ltclisccp 221 cfg%Llongitude = Llongitude 222 cfg%Llatitude = Llatitude 223 cfg%Lparasol_refl = Lparasol_refl 433 cfg%LparasolRefl = LparasolRefl 434 ! MISR simulator 224 435 cfg%LclMISR = LclMISR 225 cfg%Lmeantbisccp = Lmeantbisccp 226 cfg%Lmeantbclrisccp = Lmeantbclrisccp 227 cfg%Lfrac_out = Lfrac_out 228 cfg%Lbeta_mol532 = Lbeta_mol532 436 ! Other 437 cfg%Ltoffset = Ltoffset 438 cfg%Lfracout = Lfracout 439 cfg%LlidarBetaMol532 = LlidarBetaMol532 440 ! RTTOV 229 441 cfg%Ltbrttov = Ltbrttov 230 442 ! MODIS simulator 443 cfg%Lcltmodis=Lcltmodis 444 cfg%Lclwmodis=Lclwmodis 445 cfg%Lclimodis=Lclimodis 446 cfg%Lclhmodis=Lclhmodis 447 cfg%Lclmmodis=Lclmmodis 448 cfg%Lcllmodis=Lcllmodis 449 cfg%Ltautmodis=Ltautmodis 450 cfg%Ltauwmodis=Ltauwmodis 451 cfg%Ltauimodis=Ltauimodis 452 cfg%Ltautlogmodis=Ltautlogmodis 453 cfg%Ltauwlogmodis=Ltauwlogmodis 454 cfg%Ltauilogmodis=Ltauilogmodis 455 cfg%Lreffclwmodis=Lreffclwmodis 456 cfg%Lreffclimodis=Lreffclimodis 457 cfg%Lpctmodis=Lpctmodis 458 cfg%Llwpmodis=Llwpmodis 459 cfg%Liwpmodis=Liwpmodis 460 cfg%Lclmodis=Lclmodis 461 231 462 END SUBROUTINE READ_COSP_OUTPUT_NL 232 463 -
LMDZ5/trunk/libf/phylmd/cosp/scops.F
r1907 r2428 6 6 ! (c) British Crown Copyright 2009, the Met Office. 7 7 ! All rights reserved. 8 ! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $ 9 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/icarus-scops-4.1-bsd/scops.f $ 8 10 ! 9 11 ! Redistribution and use in source and binary forms, with or without … … 39 41 ! *****************************COPYRIGHT******************************* 40 42 41 USE mod_phys_lmdz_para42 USE mod_grid_phy_lmdz43 44 43 implicit none 45 44 … … 178 177 ELSE 179 178 DO ibox=1,ncol 180 ! include 'congvec_para.h' 181 include 'congvec.h' 179 include 'congvec.h' 182 180 ! select random pixels from the non-convective 183 181 ! part the gridbox ( some will be converted into … … 209 207 do j=1,npoints 210 208 if (boxpos(j,ibox).le.conv(j,ilev)) then 211 maxocc(j,ibox) = 1 .209 maxocc(j,ibox) = 1 212 210 else 213 maxocc(j,ibox) = 0 .211 maxocc(j,ibox) = 0 214 212 end if 215 213 enddo -
LMDZ5/trunk/libf/phylmd/cosp/zeff.F90
r1907 r2428 1 ! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $ 2 ! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/zeff.f90 $ 1 3 subroutine zeff(freq,D,N,nsizes,k2,tt,ice,xr,z_eff,z_ray,kr,qe,qs,rho_e) 2 4 use math_lib … … 15 17 ! [nsizes] number of discrete drop sizes 16 18 ! [k2] |K|^2, -1=use frequency dependent default 17 ! [tt] hydrometeor temperature ( C)19 ! [tt] hydrometeor temperature (K) 18 20 ! [ice] indicates volume consists of ice 19 21 ! [xr] perform Rayleigh calculations? … … 42 44 ! ----- INTERNAL ----- 43 45 integer :: & 44 correct_for_rho 46 correct_for_rho ! correct for density flag 45 47 real*8, dimension(nsizes) :: & 46 D0, & ! D in (m) 47 N0, & ! N in m^-3 m^-1 48 sizep, & ! size parameter 49 qext, & ! extinction efficiency 50 qbsca, & ! backscatter efficiency 51 rho_ice, & ! bulk density ice (kg m^-3) 52 f ! ice fraction 48 D0, & ! D in (m) 49 N0, & ! N in m^-3 m^-1 50 sizep, & ! size parameter 51 qext, & ! extinction efficiency 52 qbsca, & ! backscatter efficiency 53 rho_ice, & ! bulk density ice (kg m^-3) 54 f ! ice fraction 55 real*8, dimension(nsizes) :: xtemp 53 56 real*8 :: & 54 wl, & 57 wl, & ! wavelength (m) 55 58 cr ! kr(dB/km) = cr * kr(1/km) 56 59 complex*16 :: & 57 m 60 m ! complex index of refraction of bulk form 58 61 complex*16, dimension(nsizes) :: & 59 m0 62 m0 ! complex index of refraction 60 63 61 64 integer*4 :: i,one 62 65 real*8 :: pi 63 66 real*8 :: eta_sum, eta_mie, const, z0_eff, z0_ray, k_sum, & 64 n_r, n_i, dqv(1), dq xt, dqsc, dbsc, dg, dph(1)67 n_r, n_i, dqv(1), dqsc, dg, dph(1) 65 68 integer*4 :: err 66 69 complex*16 :: Xs1(1), Xs2(1) … … 72 75 73 76 ! // conversions 74 D0 = d*1E-6 75 N0 = n*1E12 76 wl = 2.99792458/(freq*10) 77 D0 = d*1E-6 ! m 78 N0 = n*1E12 ! 1/(m^3 m) 79 wl = 2.99792458/(freq*10) ! m 77 80 78 81 ! // dielectric constant |k^2| defaults … … 127 130 eta_sum = qbsca(1)*(n(1)*1E6)*D0(1)**2 128 131 else 129 call avint(qbsca*N0*D0**2,D0,nsizes,D0(1),D0(size(D0,1)),eta_sum) 132 xtemp = qbsca*N0*D0**2 133 call avint(xtemp,D0,nsizes,D0(1),D0(size(D0,1)),eta_sum) 130 134 endif 131 135 … … 140 144 k_sum = qext(1)*(n(1)*1E6)*D0(1)**2 141 145 else 142 call avint(qext*N0*D0**2,D0,nsizes,D0(1),D0(size(D0,1)),k_sum) 146 xtemp = qext*N0*D0**2 147 call avint(xtemp,D0,nsizes,D0(1),D0(size(D0,1)),k_sum) 143 148 endif 144 149 cr = 10./log(10.) 145 150 kr = k_sum*0.25*pi*(1000.*cr) 146 151 147 152 ! // z_ray = sum[D^6*N(D)*deltaD] 148 153 if (xr == 1) then … … 151 156 z0_ray = (n(1)*1E6)*D0(1)**6 152 157 else 153 call avint(N0*D0**6,D0,nsizes,D0(1),D0(size(D0)),z0_ray) 158 xtemp = N0*D0**6 159 call avint(xtemp,D0,nsizes,D0(1),D0(size(D0)),z0_ray) 154 160 endif 155 161 endif -
LMDZ5/trunk/libf/phylmd/physiq_mod.F90
r2424 r2428 4041 4041 ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, & 4042 4042 klon,klev,longitude_deg,latitude_deg,presnivs,overlap, & 4043 fract,ref_liq,ref_ice, &4043 JrNt,ref_liq,ref_ice, & 4044 4044 pctsrf(:,is_ter)+pctsrf(:,is_lic), & 4045 4045 zu10m,zv10m,pphis, &
Note: See TracChangeset
for help on using the changeset viewer.
