- Timestamp:
- Jul 15, 2010, 5:34:00 PM (14 years ago)
- Location:
- LMDZ4/branches/LMDZ4_AR5/libf/cosp
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4_AR5/libf/cosp/cosp.F90
r1327 r1415 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 26 MODULE MOD_COSP 26 27 USE MOD_COSP_TYPES … … 128 129 ! and reff_zero == .false. Reff use in lidar and set to 0 for radar 129 130 endif 130 if ((gbx%use_reff) .and. (reff_zero)) then ! Inconsistent choice. Want to use Reff but not inputs passed131 print *, '---------- COSP ERROR ------------'132 print *, ''133 print *, 'use_reff==.true. but Reff is always zero'134 print *, ''135 print *, '----------------------------------'136 stop137 endif131 ! if ((gbx%use_reff) .and. (reff_zero)) then ! Inconsistent choice. Want to use Reff but not inputs passed 132 ! print *, '---------- COSP ERROR ------------' 133 ! print *, '' 134 ! print *, 'use_reff==.true. but Reff is always zero' 135 ! print *, '' 136 ! print *, '----------------------------------' 137 ! stop 138 ! endif 138 139 if ((.not. gbx%use_reff) .and. (reff_zero)) then ! No Reff in radar. Default in lidar 139 140 gbx%Reff = DEFAULT_LIDAR_REFF … … 322 323 integer :: Niter ! Number of calls to cosp_simulator 323 324 integer :: i,j,k 325 integer :: I_HYDRO 324 326 real,dimension(:,:),pointer :: column_frac_out ! Array with one column of frac_out 325 327 integer,parameter :: scops_debug=0 ! set to non-zero value to print out inputs for debugging in SCOPS … … 330 332 real,dimension(:,:),allocatable :: frac_ls,prec_ls,frac_cv,prec_cv ! Cloud/Precipitation fraction in each model level 331 333 ! Levels are from SURFACE to TOA 334 real,dimension(:,:),allocatable :: rho ! (Npoints, Nlevels). Atmospheric dens 332 335 type(cosp_sghydro) :: sghydro ! Subgrid info for hydrometeors en each iteration 333 336 … … 378 381 do k=1,Nlevels,1 379 382 do i=1,Ncolumns,1 380 if (sgx%frac_out (j,i,Nlevels+1-k) .eq. 1) frac_ls(j,k)=frac_ls(j,k)+1.381 if (sgx%frac_out (j,i,Nlevels+1-k) .eq. 2) frac_cv(j,k)=frac_cv(j,k)+1.383 if (sgx%frac_out (j,i,Nlevels+1-k) == I_LSC) frac_ls(j,k)=frac_ls(j,k)+1. 384 if (sgx%frac_out (j,i,Nlevels+1-k) == I_CVC) frac_cv(j,k)=frac_cv(j,k)+1. 382 385 if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 1) prec_ls(j,k)=prec_ls(j,k)+1. 383 386 if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 2) prec_cv(j,k)=prec_cv(j,k)+1. … … 414 417 !--------- Mixing ratios for clouds and Reff for Clouds and precip ------- 415 418 column_frac_out => sgx%frac_out(:,k,:) 416 where (column_frac_out == 1) !+++++++++++ LS clouds ++++++++419 where (column_frac_out == I_LSC) !+++++++++++ LS clouds ++++++++ 417 420 sghydro%mr_hydro(:,k,:,I_LSCLIQ) = gbx%mr_hydro(:,:,I_LSCLIQ) 418 421 sghydro%mr_hydro(:,k,:,I_LSCICE) = gbx%mr_hydro(:,:,I_LSCICE) … … 423 426 sghydro%Reff(:,k,:,I_LSSNOW) = gbx%Reff(:,:,I_LSSNOW) 424 427 sghydro%Reff(:,k,:,I_LSGRPL) = gbx%Reff(:,:,I_LSGRPL) 425 elsewhere (column_frac_out == 2) !+++++++++++ CONV clouds ++++++++428 elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV clouds ++++++++ 426 429 sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ) 427 430 sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE) … … 434 437 !--------- Precip ------- 435 438 if (.not. gbx%use_precipitation_fluxes) then 436 where (column_frac_out == 1) !+++++++++++ LS Precipitation ++++++++439 where (column_frac_out == I_LSC) !+++++++++++ LS Precipitation ++++++++ 437 440 sghydro%mr_hydro(:,k,:,I_LSRAIN) = gbx%mr_hydro(:,:,I_LSRAIN) 438 441 sghydro%mr_hydro(:,k,:,I_LSSNOW) = gbx%mr_hydro(:,:,I_LSSNOW) 439 442 sghydro%mr_hydro(:,k,:,I_LSGRPL) = gbx%mr_hydro(:,:,I_LSGRPL) 440 elsewhere (column_frac_out == 2) !+++++++++++ CONV Precipitation ++++++++443 elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV Precipitation ++++++++ 441 444 sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN) 442 445 sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW) … … 488 491 sghydro%mr_hydro(:,:,:,I_LSRAIN),sghydro%mr_hydro(:,:,:,I_LSSNOW),sghydro%mr_hydro(:,:,:,I_LSGRPL), & 489 492 sghydro%mr_hydro(:,:,:,I_CVRAIN),sghydro%mr_hydro(:,:,:,I_CVSNOW)) 490 493 endif 491 494 !++++++++++ CRM mode ++++++++++ 492 495 else -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/cosp_constants.F90
r1279 r1415 51 51 ! Number of possible output variables 52 52 integer,parameter :: N_OUT_LIST = 27 53 ! Value for forward model result from a level that is under the ground 54 real,parameter :: R_GROUND = -1.0E20 55 56 ! Stratiform and convective clouds in frac_out 57 integer, parameter :: I_LSC = 1, & ! Large-scale clouds 58 I_CVC = 2 ! Convective clouds 53 59 54 60 !--- Radar constants … … 56 62 integer,parameter :: DBZE_BINS = 15 ! Number of dBZe bins in histogram (cfad) 57 63 real,parameter :: DBZE_MIN = -100.0 ! Minimum value for radar reflectivity 58 real,parameter :: DBZE_MAX = 30.0 ! Maximum value for radar reflectivity64 real,parameter :: DBZE_MAX = 80.0 ! Maximum value for radar reflectivity 59 65 real,parameter :: CFAD_ZE_MIN = -50.0 ! Lower value of the first CFAD Ze bin 60 66 real,parameter :: CFAD_ZE_WIDTH = 5.0 ! Bin width (dBZe) … … 69 75 integer,parameter :: LIDAR_NCAT = 4 70 76 integer,parameter :: PARASOL_NREFL = 5 ! parasol 71 ! real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/0.0, 15.0, 30.0, 45.0, 60.0/)72 real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/1.0, 2.0, 3.0, 4.0, 5.0/)77 real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/0.0, 20.0, 40.0, 6.0, 80.0/) 78 ! real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/1.0, 2.0, 3.0, 4.0, 5.0/) 73 79 real,parameter :: DEFAULT_LIDAR_REFF = 30.0e-6 ! Default lidar effective radius 74 80 -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/cosp_isccp_simulator.F90
r1279 r1415 85 85 86 86 ! Change boxptop from hPa to Pa. This avoids using UDUNITS in CMOR 87 y%boxptop = y%boxptop*100.087 ! y%boxptop = y%boxptop*100.0 88 88 89 89 ! Check if there is any value slightly greater than 1 -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/cosp_simulator.F90
r1279 r1415 65 65 !+++++++++ Radar model ++++++++++ 66 66 if (cfg%Lradar_sim) then 67 call system_clock(t0,count_rate,count_max)68 67 call cosp_radar(gbx,sgx,sghydro,sgradar) 69 call system_clock(t1,count_rate,count_max)70 print *, '%%%%%% Radar:', (t1-t0)*1.0/count_rate, ' s'71 else72 print *, '%%%%%% Radar not used'73 68 endif 74 69 75 70 !+++++++++ Lidar model ++++++++++ 76 71 if (cfg%Llidar_sim) then 77 call system_clock(t0,count_rate,count_max)78 72 call cosp_lidar(gbx,sgx,sghydro,sglidar) 79 call system_clock(t1,count_rate,count_max)80 print *, '%%%%%% Lidar:', (t1-t0)*1.0/count_rate, ' s'81 else82 print *, '%%%%%% Lidar not used'83 73 endif 84 74 … … 86 76 !+++++++++ ISCCP simulator ++++++++++ 87 77 if (cfg%Lisccp_sim) then 88 call system_clock(t0,count_rate,count_max)89 78 call cosp_isccp_simulator(gbx,sgx,isccp) 90 call system_clock(t1,count_rate,count_max)91 print *, '%%%%%% ISCCP:', (t1-t0)*1.0/count_rate, ' s'92 else93 print *, '%%%%%% ISCCP not used'94 79 endif 95 80 96 81 !+++++++++ MISR simulator ++++++++++ 97 82 if (cfg%Lmisr_sim) then 98 call system_clock(t0,count_rate,count_max)99 83 call cosp_misr_simulator(gbx,sgx,misr) 100 call system_clock(t1,count_rate,count_max)101 print *, '%%%%%% MISR:', (t1-t0)*1.0/count_rate, ' s'102 else103 print *, '%%%%%% MISR not used'104 84 endif 105 85 106 86 107 87 !+++++++++++ Summary statistics +++++++++++ 108 ! write(*,*) 'Stats:'109 ! read(*,*) c110 88 if (cfg%Lstats) then 111 call system_clock(t0,count_rate,count_max)112 89 call cosp_stats(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar) 113 call system_clock(t1,count_rate,count_max) 114 print *, '%%%%%% Stats:', (t1-t0)*1.0/count_rate, ' s' 115 endif 116 !+++++++++++ change of units after computation of statistics +++++++++++ 117 if (cfg%Llidar_sim) then 118 where((sglidar%beta_tot > 0.0) .and. (sglidar%beta_tot /= R_UNDEF)) 119 sglidar%beta_tot = log10(sglidar%beta_tot) 120 elsewhere 121 sglidar%beta_tot = R_UNDEF 122 end where 90 ! print *, '%%%%%% Stats:', (t1-t0)*1.0/count_rate, ' s' 123 91 endif 124 92 93 125 94 END SUBROUTINE COSP_SIMULATOR 126 95 -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/cosp_stats.F90
r1396 r1415 1 1 ! (c) British Crown Copyright 2008, the Met Office. 2 2 ! All rights reserved. 3 ! 4 ! Redistribution and use in source and binary forms, with or without modification, are permitted 3 ! 4 ! Redistribution and use in source and binary forms, with or without modification, are permitted 5 5 ! provided that the following conditions are met: 6 ! 7 ! * Redistributions of source code must retain the above copyright notice, this list 6 ! 7 ! * Redistributions of source code must retain the above copyright notice, this list 8 8 ! of conditions and the following disclaimer. 9 9 ! * Redistributions in binary form must reproduce the above copyright notice, this list 10 ! of conditions and the following disclaimer in the documentation and/or other materials 10 ! of conditions and the following disclaimer in the documentation and/or other materials 11 11 ! provided with the distribution. 12 ! * Neither the name of the Met Office nor the names of its contributors may be used 13 ! to endorse or promote products derived from this software without specific prior written 12 ! * Neither the name of the Met Office nor the names of its contributors may be used 13 ! to endorse or promote products derived from this software without specific prior written 14 14 ! permission. 15 ! 16 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 17 ! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 18 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 19 ! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 ! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 22 ! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 15 ! 16 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 17 ! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 18 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 19 ! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 ! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 22 ! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 23 23 ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 24 … … 29 29 ! Oct 2008 - J.-L. Dufresne - Bug fixed. Assignment of Npoints,Nlevels,Nhydro,Ncolumns in COSP_STATS 30 30 ! Oct 2008 - H. Chepfer - Added PARASOL reflectance arguments 31 ! May 2010 - L. Fairhead - Optimisation of COSP_CHANGE_VERTICAL_GRID routine for NEC SX8 computer32 ! 33 ! 31 ! Jun 2010 - T. Yokohata, T. Nishimura and K. Ogochi - Added NEC SXs optimisations 32 ! 33 ! 34 34 MODULE MOD_COSP_STATS 35 35 USE MOD_COSP_CONSTANTS … … 45 45 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 46 46 SUBROUTINE COSP_STATS(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar) 47 47 48 48 ! Input arguments 49 49 type(cosp_gridbox),intent(in) :: gbx … … 55 55 ! Output arguments 56 56 type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics for radar 57 type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics for lidar 58 59 ! Local variables 57 type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics for lidar 58 59 ! Local variables 60 60 integer :: Npoints !# of grid points 61 61 integer :: Nlevels !# of levels … … 66 66 real,dimension(:,:,:),allocatable :: Ze_out,betatot_out,betamol_in,betamol_out,ph_in,ph_out 67 67 real,dimension(:,:),allocatable :: ph_c,betamol_c 68 68 69 69 Npoints = gbx%Npoints 70 70 Nlevels = gbx%Nlevels … … 73 73 Nlr = vgrid%Nlvgrid 74 74 75 if (cfg%Lcfad_ lidarsr532) ok_lidar_cfad=.true.75 if (cfg%Lcfad_Lidarsr532) ok_lidar_cfad=.true. 76 76 77 77 if (vgrid%use_vgrid) then ! Statistics in a different vertical grid … … 81 81 Ze_out = 0.0 82 82 betatot_out = 0.0 83 betamol_in(:,1,:) = sglidar%beta_mol(:,:)84 83 betamol_out= 0.0 85 84 betamol_c = 0.0 … … 89 88 !++++++++++++ Radar CFAD ++++++++++++++++ 90 89 if (cfg%Lradar_sim) then 91 call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sgradar%Ze_tot, &90 call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sgradar%Ze_tot, & 92 91 Nlr,vgrid%zl,vgrid%zu,Ze_out,log_units=.true.) 93 92 stradar%cfad_ze = cosp_cfad(Npoints,Ncolumns,Nlr,DBZE_BINS,Ze_out, & … … 96 95 !++++++++++++ Lidar CFAD ++++++++++++++++ 97 96 if (cfg%Llidar_sim) then 97 betamol_in(:,1,:) = sglidar%beta_mol(:,:) 98 98 call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,betamol_in, & 99 99 Nlr,vgrid%zl,vgrid%zu,betamol_out) … … 114 114 if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, & 115 115 betatot_out,betamol_c,Ze_out, & 116 stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc) 116 stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc) 117 117 ! Deallocate arrays at coarse resolution 118 118 deallocate(Ze_out,betatot_out,betamol_in,betamol_out,betamol_c,ph_in,ph_out,ph_c) … … 131 131 if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, & 132 132 sglidar%beta_tot,sglidar%beta_mol,sgradar%Ze_tot, & 133 stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc) 133 stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc) 134 134 endif 135 135 ! Replace undef 136 where (stlidar%cfad_sr == LIDAR_UNDEF) stlidar%cfad_sr = R_UNDEF 137 where (stlidar%lidarcld == LIDAR_UNDEF) stlidar%lidarcld = R_UNDEF 138 where (stlidar%cldlayer == LIDAR_UNDEF) stlidar%cldlayer = R_UNDEF 139 where (stlidar%parasolrefl == LIDAR_UNDEF) stlidar%parasolrefl = R_UNDEF 136 where (stlidar%cfad_sr == LIDAR_UNDEF) stlidar%cfad_sr = R_UNDEF 137 where (stlidar%lidarcld == LIDAR_UNDEF) stlidar%lidarcld = R_UNDEF 138 where (stlidar%cldlayer == LIDAR_UNDEF) stlidar%cldlayer = R_UNDEF 139 where (stlidar%parasolrefl == LIDAR_UNDEF) stlidar%parasolrefl = R_UNDEF 140 140 141 141 END SUBROUTINE COSP_STATS … … 162 162 163 163 ! Local variables 164 integer :: i,j,k ,c164 integer :: i,j,k 165 165 logical :: lunits 166 real :: ws(Npoints,M), ws_temp(Npoints,M) 167 real,dimension(Npoints,Nlevels) :: xl, xu ! Lower and upper boundaries of model grid 168 real,dimension(M) :: dz ! Layer depth 169 real,dimension(Npoints,Nlevels,M) :: w ! Weights to do the mean at each point 170 real,dimension(Npoints,Ncolumns,Nlevels) :: yp ! Variable to be changed to a different grid. 171 ! Local copy at a particular point. 172 ! This allows for change of units. 173 166 167 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 174 172 175 173 lunits=.false. 176 174 if (present(log_units)) lunits=log_units 177 175 178 r(:,:,:) = 0.0 179 yp(:,:,:) = y(:,:,:) 180 w(:,:,:) = 0.0 181 ws(:,:) = 0.0 182 ws_temp(:,:) = 0.0 183 dz = zu - zl 184 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 185 182 ! Check for dBZ and change if necessary 186 183 if (lunits) then 187 184 where (y /= R_UNDEF) 188 yp = 10.0**(y/10.0) 185 yp = 10.0**(y/10.0) 186 elsewhere 187 yp = 0.0 189 188 end where 190 189 endif 191 192 ! Vertical grids 193 xl(:,:) = zhalf(:,:) 194 xu(:,1:Nlevels-1) = zhalf(:,2:Nlevels) 195 xu(:,Nlevels) = zfull(:,Nlevels) + zfull(:,Nlevels) - zhalf(:,Nlevels) ! Top level symmetric 196 ! Find weights 197 do k=1, M 198 do j=1, Nlevels 199 do i=1, Npoints 190 do k=1,M 191 ! Find weights 192 w(:,:) = 0.0 193 do j=1,Nlevels 194 do i=1,Npoints 200 195 if ((xl(i,j) < zl(k)).and.(xu(i,j) > zl(k)).and.(xu(i,j) <= zu(k))) then 201 196 !xl(j)-----------------xu(j) 202 197 ! zl(k)------------------------------zu(k) 203 w(i,j ,k) = xu(i,j) - zl(k)198 w(i,j) = xu(i,j) - zl(k) 204 199 else if ((xl(i,j) >= zl(k)).and.(xu(i,j) <= zu(k))) then 205 200 ! xl(j)-----------------xu(j) 206 201 ! zl(k)------------------------------zu(k) 207 w(i,j ,k) = xl(i,j+1) - xl(i,j)202 w(i,j) = xu(i,j) - xl(i,j) 208 203 else if ((xl(i,j) >= zl(k)).and.(xl(i,j) < zu(k)).and.(xu(i,j) >= zu(k))) then 209 204 ! xl(j)-----------------xu(j) 210 205 ! zl(k)------------------------------zu(k) 211 w(i,j ,k) = zu(k) - xl(i,j)206 w(i,j) = zu(k) - xl(i,j) 212 207 else if ((xl(i,j) <= zl(k)).and.(xu(i,j) >= zu(k))) then 213 208 ! xl(j)---------------------------xu(j) 214 209 ! zl(k)--------------zu(k) 215 w(i,j,k) = dz(j) 210 w(i,j) = zu(k) - zl(k) 211 endif 212 enddo 213 enddo 214 ! Do the weighted mean 215 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) 223 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) 216 229 endif 217 230 enddo 218 231 enddo 219 232 enddo 220 221 ! Do the weighted mean222 do k=1,M223 do i = 1, Npoints224 ws(i,k) = sum(w(i,:,k))225 enddo226 enddo227 228 ws_temp = 1.229 where (ws(:,:) > 0.0) ws_temp(:,:)=ws(:,:)230 231 do c=1,Ncolumns232 do k=1,M233 do i = 1, Npoints234 r(i,c,k) = sum(w(i,:,k)*yp(i,c,:))/ws_temp(i,k)235 enddo236 enddo237 enddo238 239 do k=1,M240 do i = 1, Npoints241 if (ws(i,k) <= 0.0) r(i,:,k)=0.0242 enddo243 enddo244 245 233 ! Check for dBZ and change if necessary 246 234 if (lunits) then 247 where (r(:,:,:) <= 0.0) 248 r(:,:,:) = R_UNDEF 249 elsewhere 250 r(:,:,:) = 10.0*log10(r(:,:,:)) 251 end where 235 do k=1,M 236 do j=1,Ncolumns 237 do i=1,Npoints 238 if (zu(k) > zhalf(i,1)) then ! Level above model bottom level 239 if (r(i,j,k) <= 0.0) then 240 r(i,j,k) = R_UNDEF 241 else 242 r(i,j,k) = 10.0*log10(r(i,j,k)) 243 endif 244 endif 245 enddo 246 enddo 247 enddo 252 248 endif 253 254 END SUBROUTINE COSP_CHANGE_VERTICAL_GRID 249 250 251 252 END SUBROUTINE COSP_CHANGE_VERTICAL_GRID 255 253 256 254 END MODULE MOD_COSP_STATS -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/cosp_utils.F90
r1279 r1415 40 40 END INTERFACE 41 41 CONTAINS 42 43 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 44 !------------------- SUBROUTINE COSP_PRECIP_MXRATIO -------------- 45 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 46 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 50 ! Input arguments, (IN) 51 integer,intent(in) :: Npoints,Nlevels,Ncolumns 52 real,intent(in),dimension(Npoints,Nlevels) :: p,T,flux 53 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_type 55 ! Input arguments, (OUT) 56 real,intent(out),dimension(Npoints,Ncolumns,Nlevels) :: mxratio 57 ! Local variables 58 integer :: i,j,k 59 real :: sigma,one_over_xip1,xi,rho0,rho 60 61 mxratio = 0.0 62 63 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 xi = d_x/(alpha_x + b_x - n_bx + 1.0) 67 rho0 = 1.29 68 sigma = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi 69 one_over_xip1 = 1.0/(xi + 1.0) 70 71 do k=1,Nlevels 72 do j=1,Ncolumns 73 do i=1,Npoints 74 if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then 75 rho = p(i,k)/(287.05*T(i,k)) 76 mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1 77 mxratio(i,j,k)=mxratio(i,j,k)/rho 78 endif 79 enddo 80 enddo 81 enddo 82 endif 83 END SUBROUTINE COSP_PRECIP_MXRATIO 42 84 43 85 -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/icarus.F
r1279 r1415 33 33 &) 34 34 35 ! Id: icarus.f,v 4.0 2009/02/12 13:59:20hadmw Exp $35 !$Id: icarus.f,v 4.1 2010/05/27 16:30:18 hadmw Exp $ 36 36 37 37 ! *****************************COPYRIGHT**************************** … … 72 72 ! *****************************COPYRIGHT******************************* 73 73 ! *****************************COPYRIGHT******************************* 74 ! *****************************COPYRIGHT******************************* 74 75 75 76 implicit none … … 234 235 REAL attropmin (npoints) 235 236 REAL atmax(npoints) 236 REAL atmin(npoints)237 237 REAL btcmin(npoints) 238 238 REAL transmax(npoints) … … 356 356 do j=1,npoints 357 357 ptrop(j)=5000. 358 atmin(j) = 400.359 358 attropmin(j) = 400. 360 359 atmax(j) = 0. … … 373 372 itrop(j)=ilev 374 373 end if 375 if (at(j,ilev) .gt. atmax(j)) atmax(j)=at(j,ilev)376 if (at(j,ilev) .lt. atmin(j)) atmin(j)=at(j,ilev)377 374 enddo 378 375 12 continue 376 377 do 13 ilev=1,nlev 378 do j=1,npoints 379 if (at(j,ilev) .gt. atmax(j) .and. 380 & ilev .ge. itrop(j)) atmax(j)=at(j,ilev) 381 enddo 382 13 continue 379 383 380 384 end if -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/llnl_stats.F90
r1279 r1415 24 24 25 25 MODULE MOD_LLNL_STATS 26 USE MOD_COSP_CONSTANTS 26 27 IMPLICIT NONE 27 28 … … 62 63 do j = 1, Nlevels, 1 63 64 do k = 1, Ncolumns, 1 64 do i = 1, Npoints, 1 65 if ((x(i,k,j) >= xmin) .and. (x(i,k,j) <= xmax)) then 65 do i = 1, Npoints, 1 66 if (x(i,k,j) == R_GROUND) then 67 cosp_cfad(i,:,j) = R_UNDEF 68 elseif ((x(i,k,j) >= xmin) .and. (x(i,k,j) <= xmax)) then 66 69 ibin = ceiling((x(i,k,j) - bmin)/bwidth) 67 70 if (ibin > Nbins) ibin = Nbins … … 72 75 enddo !k 73 76 enddo !j 74 cosp_cfad = cosp_cfad / Ncolumns77 where ((cosp_cfad /= R_UNDEF).and.(cosp_cfad /= 0.0)) cosp_cfad = cosp_cfad / Ncolumns 75 78 END FUNCTION COSP_CFAD 76 79 … … 98 101 integer :: pr,i,j 99 102 100 !lidar_only_freq_cloud = 0.0101 !tcc = 0.0103 lidar_only_freq_cloud = 0.0 104 tcc = 0.0 102 105 do pr=1,Npoints 103 106 do i=1,Ncolumns -
LMDZ4/branches/LMDZ4_AR5/libf/cosp/lmd_ipsl_stats.F90
r1279 r1415 1 1 ! Copyright (c) 2009, Centre National de la Recherche Scientifique 2 2 ! All rights reserved. 3 ! 4 ! Redistribution and use in source and binary forms, with or without modification, are permitted 3 ! 4 ! Redistribution and use in source and binary forms, with or without modification, are permitted 5 5 ! provided that the following conditions are met: 6 ! 7 ! * Redistributions of source code must retain the above copyright notice, this list 6 ! 7 ! * Redistributions of source code must retain the above copyright notice, this list 8 8 ! of conditions and the following disclaimer. 9 9 ! * Redistributions in binary form must reproduce the above copyright notice, this list 10 ! of conditions and the following disclaimer in the documentation and/or other materials 10 ! of conditions and the following disclaimer in the documentation and/or other materials 11 11 ! provided with the distribution. 12 12 ! * Neither the name of the LMD/IPSL/CNRS/UPMC nor the names of its 13 ! contributors may be used to endorse or promote products derived from this software without 13 ! contributors may be used to endorse or promote products derived from this software without 14 14 ! specific prior written permission. 15 ! 16 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 17 ! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 18 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 19 ! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 ! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 22 ! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 15 ! 16 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 17 ! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 18 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 19 ! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 ! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 22 ! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 23 23 ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 24 … … 39 39 ! ----------------------------------------------------------------------------------- 40 40 ! Lidar outputs : 41 ! 41 ! 42 42 ! Diagnose cloud fraction (3D cloud fraction + low/middle/high/total cloud fraction 43 43 ! from the lidar signals (ATB and molecular ATB) computed from model outputs 44 44 ! + 45 45 ! Compute CFADs of lidar scattering ratio SR and of depolarization index 46 ! 46 ! 47 47 ! Authors: Sandrine Bony and Helene Chepfer (LMD/IPSL, CNRS, UPMC, France). 48 48 ! 49 ! December 2008, S. Bony, H. Chepfer and J-L. Dufresne : 49 ! December 2008, S. Bony, H. Chepfer and J-L. Dufresne : 50 50 ! - change of the cloud detection threshold S_cld from 3 to 5, for better 51 51 ! with both day and night observations. The optical thinest clouds are missed. … … 53 53 ! December 2008, A. Bodas-Salcedo: 54 54 ! - Dimensions of pmol reduced to (npoints,llm) 55 ! August 2009, A. Bodas-Salcedo: 56 ! - Warning message regarding PARASOL being valid only over ocean deleted. 57 ! February 2010, A. Bodas-Salcedo: 58 ! - Undef passed into cosp_cfad_sr 59 ! June 2010, T. Yokohata, T. Nishimura and K. Ogochi 60 ! Optimisation of COSP_CFAD_SR 55 61 ! 56 62 ! Version 1.0 (June 2007) … … 70 76 71 77 real undef ! undefined value 72 real pnorm(npoints,ncol,llm) ! lidar ATB 78 real pnorm(npoints,ncol,llm) ! lidar ATB 73 79 real pmol(npoints,llm) ! molecular ATB 74 real land(npoints) ! Landmask [0 - Ocean, 1 - Land] 80 real land(npoints) ! Landmask [0 - Ocean, 1 - Land] 75 81 real pplay(npoints,llm) ! pressure on model levels (Pa) 76 82 logical ok_lidar_cfad ! true if lidar CFAD diagnostics need to be computed … … 78 84 79 85 ! c outputs : 80 real lidarcld(npoints,llm) ! 3D "lidar" cloud fraction 86 real lidarcld(npoints,llm) ! 3D "lidar" cloud fraction 81 87 real cldlayer(npoints,ncat) ! "lidar" cloud fraction (low, mid, high, total) 82 real cfad2(npoints,max_bin,llm) ! CFADs of SR 83 real srbval(max_bin) ! SR bins in CFADs 88 real cfad2(npoints,max_bin,llm) ! CFADs of SR 89 real srbval(max_bin) ! SR bins in CFADs 84 90 real parasolrefl(npoints,nrefl)! grid-averaged parasol reflectance 85 91 86 92 ! c threshold for cloud detection : 87 real S_clr 88 parameter (S_clr = 1.2) 93 real S_clr 94 parameter (S_clr = 1.2) 89 95 real S_cld 90 96 ! parameter (S_cld = 3.0) ! Previous thresold for cloud detection … … 102 108 ! c 0- Initializations 103 109 ! c ------------------------------------------------------- 104 ! Parasol reflectance algorithm is not valid over land. Write 105 ! a warning if there is no land. Landmask [0 - Ocean, 1 - Land] 106 IF ( MAXVAL(land(:)) .EQ. 0.0) THEN 107 WRITE (*,*) 'WARNING. PARASOL reflectance is not valid over land' & 108 & ,' and there is only land' 109 END IF 110 ! 110 111 111 112 ! Should be modified in future version … … 116 117 ! c ------------------------------------------------------- 117 118 ! 118 ! where ((pnorm.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 )) 119 ! where ((pnorm.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 )) 119 120 ! x3d = pnorm/pmol 120 121 ! elsewhere … … 124 125 do ic = 1, ncol 125 126 pnorm_c = pnorm(:,ic,:) 126 where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 )) 127 where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 )) 127 128 x3d_c = pnorm_c/pmol 128 129 elsewhere … … 142 143 143 144 ! c ------------------------------------------------------- 144 ! c 3- CFADs 145 ! c 3- CFADs 145 146 ! c ------------------------------------------------------- 146 147 if (ok_lidar_cfad) then … … 148 149 ! c CFADs of subgrid-scale lidar scattering ratios : 149 150 ! c ------------------------------------------------------- 150 CALL COSP_CFAD_SR(npoints,ncol,llm,max_bin, &151 CALL COSP_CFAD_SR(npoints,ncol,llm,max_bin,undef, & 151 152 x3d, & 152 153 S_att,S_clr,xmax,cfad2,srbval) … … 172 173 ! if land=0 -> parasolrefl=parasolrefl 173 174 parasolrefl(:,k) = parasolrefl(:,k) * MAX(1.0-land(:),0.0) & 174 + (1.0 - MAX(1.0-land(:),0.0))*undef 175 + (1.0 - MAX(1.0-land(:),0.0))*undef 175 176 enddo 176 177 177 178 RETURN 178 179 END SUBROUTINE diag_lidar 179 180 180 181 181 182 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 182 183 !-------------------- FUNCTION COSP_CFAD_SR ------------------------ 183 184 ! Author: Sandrine Bony (LMD/IPSL, CNRS, Paris) 184 185 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 185 SUBROUTINE COSP_CFAD_SR(Npoints,Ncolumns,Nlevels,Nbins, &186 SUBROUTINE COSP_CFAD_SR(Npoints,Ncolumns,Nlevels,Nbins,undef, & 186 187 x,S_att,S_clr,xmax,cfad,srbval) 187 188 IMPLICIT NONE … … 205 206 ! Input arguments 206 207 integer Npoints,Ncolumns,Nlevels,Nbins 207 real xmax,S_att,S_clr 208 real xmax,S_att,S_clr,undef 208 209 ! Input-output arguments 209 210 real x(Npoints,Ncolumns,Nlevels) … … 213 214 ! Local variables 214 215 integer i, j, k, ib 216 real srbval_ext(0:Nbins) 215 217 216 218 ! c ------------------------------------------------------- … … 235 237 cfad(:,:,:) = 0.0 236 238 237 239 srbval_ext(1:Nbins) = srbval 240 srbval_ext(0) = -1.0 238 241 ! c ------------------------------------------------------- 239 242 ! c c- Compute CFAD 240 243 ! c ------------------------------------------------------- 241 244 242 do j = Nlevels, 1, -1 243 do k = 1, Ncolumns 244 where ( x(:,k,j).le.srbval(1) ) & 245 cfad(:,1,j) = cfad(:,1,j) + 1.0 246 enddo !k 247 enddo !j 248 249 do ib = 2, Nbins 250 do j = Nlevels, 1, -1 251 do k = 1, Ncolumns 252 where ( ( x(:,k,j).gt.srbval(ib-1) ) .and. ( x(:,k,j).le.srbval(ib) ) ) & 253 cfad(:,ib,j) = cfad(:,ib,j) + 1.0 254 enddo !k 255 enddo !j 256 enddo !ib 257 258 cfad(:,:,:) = cfad(:,:,:) / float(Ncolumns) 245 do j = 1, Nlevels 246 do ib = 1, Nbins 247 do k = 1, Ncolumns 248 do i = 1, Npoints 249 if (x(i,k,j) /= undef) then 250 if ((x(i,k,j).gt.srbval_ext(ib-1)).and.(x(i,k,j).le.srbval_ext(ib))) & 251 cfad(i,ib,j) = cfad(i,ib,j) + 1.0 252 else 253 cfad(i,ib,j) = undef 254 endif 255 enddo 256 enddo 257 enddo 258 enddo 259 260 where (cfad .ne. undef) cfad = cfad / float(Ncolumns) 259 261 260 262 ! c ------------------------------------------------------- … … 264 266 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 265 267 !-------------------- SUBROUTINE COSP_CLDFRAC ------------------- 266 ! c Purpose: Cloud fraction diagnosed from lidar measurements 268 ! c Purpose: Cloud fraction diagnosed from lidar measurements 267 269 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 268 270 SUBROUTINE COSP_CLDFRAC(Npoints,Ncolumns,Nlevels,Ncat, & … … 288 290 real nsub(Npoints,Nlevels) 289 291 290 291 ! --------------------------------------------------------------- 292 ! 1- initialization 292 real cldlay1(Npoints,Ncolumns) 293 real cldlay2(Npoints,Ncolumns) 294 real cldlay3(Npoints,Ncolumns) 295 real nsublay1(Npoints,Ncolumns) 296 real nsublay2(Npoints,Ncolumns) 297 real nsublay3(Npoints,Ncolumns) 298 299 300 ! --------------------------------------------------------------- 301 ! 1- initialization 293 302 ! --------------------------------------------------------------- 294 303 … … 317 326 318 327 ! number of usefull sub-columns: 319 where ( (x(:,:,k).gt.S_att) .and. (x(:,:,k).ne. undef) ) 328 where ( (x(:,:,k).gt.S_att) .and. (x(:,:,k).ne. undef) ) 320 329 srok(:,:,k)=1.0 321 330 elsewhere … … 329 338 ! categories) : 330 339 ! --------------------------------------------------------------- 331 ! Test abderr 340 lidarcld = 0.0 341 nsub = 0.0 342 343 !! XXX: Use cldlay[1-3] and nsublay[1-3] to avoid bank-conflicts. 344 cldlay1 = 0.0 345 cldlay2 = 0.0 346 cldlay3 = 0.0 347 cldlay(:,:,4) = 0.0 !! XXX: Ncat == 4 348 nsublay1 = 0.0 349 nsublay2 = 0.0 350 nsublay3 = 0.0 351 nsublay(:,:,4) = 0.0 332 352 do k = Nlevels, 1, -1 333 353 do ic = 1, Ncolumns 334 354 do ip = 1, Npoints 335 iz=1 336 p1 = pplay(ip,k) 337 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds 338 iz=3 339 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid clouds 340 iz=2 355 p1 = pplay(ip,k) 356 357 if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds 358 cldlay3(ip,ic) = MAX(cldlay3(ip,ic), cldy(ip,ic,k)) 359 nsublay3(ip,ic) = MAX(nsublay3(ip,ic), srok(ip,ic,k)) 360 else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid clouds 361 cldlay2(ip,ic) = MAX(cldlay2(ip,ic), cldy(ip,ic,k)) 362 nsublay2(ip,ic) = MAX(nsublay2(ip,ic), srok(ip,ic,k)) 363 else 364 cldlay1(ip,ic) = MAX(cldlay1(ip,ic), cldy(ip,ic,k)) 365 nsublay1(ip,ic) = MAX(nsublay1(ip,ic), srok(ip,ic,k)) 341 366 endif 342 367 343 cldlay(ip,ic,iz) = MAX(cldlay(ip,ic,iz),cldy(ip,ic,k)) 344 cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4),cldy(ip,ic,k)) 368 cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4), cldy(ip,ic,k)) 345 369 lidarcld(ip,k)=lidarcld(ip,k) + cldy(ip,ic,k) 346 347 nsublay(ip,ic,iz) = MAX(nsublay(ip,ic,iz),srok(ip,ic,k))348 370 nsublay(ip,ic,4) = MAX(nsublay(ip,ic,4),srok(ip,ic,k)) 349 371 nsub(ip,k)=nsub(ip,k) + srok(ip,ic,k) 350 351 372 enddo 352 373 enddo 353 374 enddo 375 cldlay(:,:,1) = cldlay1 376 cldlay(:,:,2) = cldlay2 377 cldlay(:,:,3) = cldlay3 378 nsublay(:,:,1) = nsublay1 379 nsublay(:,:,2) = nsublay2 380 nsublay(:,:,3) = nsublay3 354 381 355 382 ! -- grid-box 3D cloud fraction … … 369 396 do ic = 1, Ncolumns 370 397 371 cldlayer(:,iz)=cldlayer(:,iz) + cldlay(:,ic,iz) 372 nsublayer(:,iz)=nsublayer(:,iz) + nsublay(:,ic,iz) 398 cldlayer(:,iz)=cldlayer(:,iz) + cldlay(:,ic,iz) 399 nsublayer(:,iz)=nsublayer(:,iz) + nsublay(:,ic,iz) 373 400 374 401 enddo … … 383 410 END SUBROUTINE COSP_CLDFRAC 384 411 ! --------------------------------------------------------------- 385 412 386 413 END MODULE MOD_LMD_IPSL_STATS
Note: See TracChangeset
for help on using the changeset viewer.