source: LMDZ5/branches/testing/libf/phylmd/cosp/cosp_isccp_simulator.F90 @ 5403

Last change on this file since 5403 was 2435, checked in by Laurent Fairhead, 9 years ago

Merged trunk changes r2396:2434 into testing branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 4.2 KB
Line 
1! (c) British Crown Copyright 2008, the Met Office.
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 $
5!
6! Redistribution and use in source and binary forms, with or without modification, are permitted
7! provided that the following conditions are met:
8!
9!     * Redistributions of source code must retain the above copyright notice, this list
10!       of conditions and the following disclaimer.
11!     * Redistributions in binary form must reproduce the above copyright notice, this list
12!       of conditions and the following disclaimer in the documentation and/or other materials
13!       provided with the distribution.
14!     * Neither the name of the Met Office nor the names of its contributors may be used
15!       to endorse or promote products derived from this software without specific prior written
16!       permission.
17!
18! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
19! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
20! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
21! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
24! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
25! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26
27MODULE MOD_COSP_ISCCP_SIMULATOR
28  USE MOD_COSP_CONSTANTS
29  USE MOD_COSP_TYPES
30  IMPLICIT NONE
31
32CONTAINS
33
34
35!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
36!-------------- SUBROUTINE COSP_ISCCP_SIMULATOR -----------------
37!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
38SUBROUTINE COSP_ISCCP_SIMULATOR(gbx,sgx,y)
39 
40  ! Arguments
41  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
42  type(cosp_subgrid),intent(in) :: sgx  ! Subgridbox info
43  type(cosp_isccp),intent(inout) :: y   ! ISCCP simulator output
44 
45  ! Local variables
46  integer :: Nlevels,Npoints
47  real :: pfull(gbx%Npoints, gbx%Nlevels)
48  real :: phalf(gbx%Npoints, gbx%Nlevels + 1)
49  real :: qv(gbx%Npoints, gbx%Nlevels)
50  real :: cc(gbx%Npoints, gbx%Nlevels)
51  real :: conv(gbx%Npoints, gbx%Nlevels)
52  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
53  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
54  real :: at(gbx%Npoints, gbx%Nlevels)
55  real :: dem_s(gbx%Npoints, gbx%Nlevels)
56  real :: dem_c(gbx%Npoints, gbx%Nlevels)
57  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
58  integer :: sunlit(gbx%Npoints)
59 
60  Nlevels = gbx%Nlevels
61  Npoints = gbx%Npoints
62  ! Flip inputs. Levels from TOA to surface
63  pfull  = gbx%p(:,Nlevels:1:-1)
64  phalf(:,1)         = 0.0 ! Top level
65  phalf(:,2:Nlevels+1) = gbx%ph(:,Nlevels:1:-1)
66  qv     = gbx%sh(:,Nlevels:1:-1)
67  cc     = 0.999999*gbx%tca(:,Nlevels:1:-1)
68  conv   = 0.999999*gbx%cca(:,Nlevels:1:-1)
69  dtau_s = gbx%dtau_s(:,Nlevels:1:-1)
70  dtau_c = gbx%dtau_c(:,Nlevels:1:-1)
71  at     = gbx%T(:,Nlevels:1:-1)
72  dem_s  = gbx%dem_s(:,Nlevels:1:-1)
73  dem_c  = gbx%dem_c(:,Nlevels:1:-1)
74  frac_out(1:Npoints,:,1:Nlevels) = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
75  sunlit = int(gbx%sunlit)
76  call icarus(0,0,gbx%npoints,sunlit,gbx%nlevels,gbx%ncolumns, &
77            pfull,phalf,qv,cc,conv,dtau_s,dtau_c, &
78            gbx%isccp_top_height,gbx%isccp_top_height_direction, &
79            gbx%isccp_overlap,frac_out, &
80            gbx%skt,gbx%isccp_emsfc_lw,at,dem_s,dem_c,y%fq_isccp,y%totalcldarea, &
81            y%meanptop,y%meantaucld,y%meanalbedocld, &
82            y%meantb,y%meantbclr,y%boxtau,y%boxptop)
83
84  ! Flip outputs. Levels from surface to TOA
85  ! --- (npoints,tau=7,pressure=7)
86  y%fq_isccp(:,:,:) = y%fq_isccp(:,:,7:1:-1)
87     
88 
89  ! Check if there is any value slightly greater than 1
90  where ((y%totalcldarea > 1.0-1.e-5) .and. (y%totalcldarea < 1.0+1.e-5))
91    y%totalcldarea = 1.0
92  endwhere
93             
94END SUBROUTINE COSP_ISCCP_SIMULATOR
95
96END MODULE MOD_COSP_ISCCP_SIMULATOR
Note: See TracBrowser for help on using the repository browser.