Philippe 14/11/2016: minor: removed unused IO arguments
[MNH-git_open_source-lfs.git] / src / MNH / condsamp.f90
1 !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
3 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !MNH_LIC for details. version 1.
5 !-----------------------------------------------------------------
6 !--------------- special set of characters for RCS information
7 !-----------------------------------------------------------------
8 ! $Source$ $Revision$ $Date$
9 !-----------------------------------------------------------------
10 !     ######spl
11      MODULE MODI_CONDSAMP
12 !    ################## 
13 !
14 INTERFACE
15 !
16       SUBROUTINE CONDSAMP (PSFSV, KLUOUT, KVERB)
17 IMPLICIT NONE
18 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PSFSV ! surface flux of scalars
19 INTEGER, INTENT(IN)          :: KLUOUT     ! unit for output listing count
20 INTEGER, INTENT(IN)          :: KVERB      ! verbosity level
21 !
22 END SUBROUTINE CONDSAMP
23 !
24 END INTERFACE
25 !
26 END MODULE MODI_CONDSAMP
27 !     ######spl
28       SUBROUTINE CONDSAMP (PSFSV, KLUOUT, KVERB)
29 !     ############################################################
30 !
31 !
32 !
33 !!****  *PASPOL* -
34 !!
35 !!    PURPOSE
36 !!    -------
37 !!****  The purpose of this routine is to release tracers for conditional
38 !!       samplings according to Couvreux et al. (2010)
39 !
40 !!**  METHOD
41 !!    ------
42 !!    
43 !!
44 !!
45 !!    REFERENCE
46 !!    ---------
47 !!
48 !!    AUTHOR
49 !!    ------
50 !!      F.Couvreux, C.Lac         * Meteo-France *
51 !!
52 !!    MODIFICATIONS
53 !!    -------------
54 !!
55 !! --------------------------------------------------------------------------
56 !       
57 !!    EXTERNAL
58 !!    --------
59 !!
60 USE MODD_PARAMETERS , ONLY : JPVEXT
61 USE MODD_NSV        , ONLY : NSV_CSBEG, NSV_CSEND, NSV_CS
62 USE MODD_CONF_n     , ONLY : LUSERC
63 USE MODD_FIELD_n    , ONLY : XSVT, XRT
64 USE MODD_GRID_n     , ONLY : XZHAT
65 USE MODD_DYN        , ONLY : XTSTEP_MODEL1
66 USE MODD_CONDSAMP
67 USE MODE_ll
68 !
69 !*      0. DECLARATIONS
70 !          ------------
71 !
72 IMPLICIT NONE
73 !
74 !
75 !*      0.1    declarations of arguments
76 !
77 REAL, DIMENSION(:,:,:), INTENT(INOUT)   :: PSFSV ! surface flux of scalars
78 INTEGER, INTENT(IN)          :: KLUOUT     ! unit for output listing count
79 INTEGER, INTENT(IN)          :: KVERB      ! verbosity level
80 !
81 !*      0.2    declarations of local variables
82 !
83
84 INTEGER :: IIB,IIE,IJB,IJE, IKB, IKE
85 INTEGER :: IIU, IJU, IKU                      ! dimensional indexes
86 INTEGER :: JK,JSV,IBOT,ITOP ! Loop indice
87 INTEGER :: IINFO_ll       ! return code of parallel routine
88 REAL, DIMENSION(SIZE(XRT,1),SIZE(XRT,2),SIZE(XRT,3)) :: ZRT
89 !
90 !--------------------------------------------------------------------------------------
91 !
92 !
93 !*      0. Initialisation
94 !
95 !
96 CALL GET_DIM_EXT_ll('B',IIU,IJU)
97 IKU = SIZE(XRT,3)
98 IKB = 1 + JPVEXT
99 IKE = IKU - JPVEXT
100 CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
101 !
102 !
103 !
104 !
105 !*      1.  INITIALIZATION OF CONDITIONAL SAMPLING TRACERS
106 !           ----------------------------------------------
107 ! on veut initialiser le 1er traceur a la surface tout le temps
108 ! le 2E si cloud 100m en dessous de cloud base
109 ! le 3eme si cloud 100m au dessus de cloud top
110 !
111 IBOT=0
112 ITOP=0
113
114 IF (( NSV_CS >= 2) .AND.LUSERC .AND.  MAX_ll(XRT(:,:,:,2),IINFO_ll) > 1.E-6 )  THEN
115    ! calcul de la base et du sommet des nuages
116    ! on ne considere que l'eau liquide car que pour nuages de couche limite
117    DO JK=1,IKE
118     ZRT(:,:,:) = SPREAD(XRT(:,:,JK,2),3,IKU)
119     IF ((MAX_ll(ZRT(:,:,:),IINFO_ll) > 1.E-6).AND.(IBOT == 0)) IBOT=JK
120     IF ( MAX_ll(ZRT(:,:,:),IINFO_ll) > 1.E-6) ITOP=JK
121    END DO
122    IF (KVERB >= 10) THEN
123     WRITE(KLUOUT,'(A)') ' '
124     WRITE(KLUOUT,'(A,F7.1)') 'Base nuage  : ',XZHAT(IBOT)
125     WRITE(KLUOUT,'(A,F7.1)') 'Sommet nuage: ',XZHAT(ITOP)
126     WRITE(KLUOUT,'(A,I3.1)') 'JK Base   : ',IBOT
127     WRITE(KLUOUT,'(A,I3.1)') 'JK Sommet : ',ITOP
128    END IF
129    !
130 END IF
131
132 DO JSV=NSV_CSBEG, NSV_CSEND
133  !
134  IF (JSV== NSV_CSBEG ) THEN 
135   ! emission en surface
136   PSFSV(IIB:IIE,IJB:IJE,JSV) = 1.
137  ENDIF
138
139  IF ((JSV == NSV_CSBEG + 1 ).AND.(IBOT > 2)) THEN
140     ! emission XHEIGHT_BASE(m) below the base on XDEPTH_BASE(m)
141     !
142     DO JK=1,IKE
143      IF ((XZHAT(JK) > XZHAT(IBOT) - XHEIGHT_BASE - XDEPTH_BASE/2. ).AND. &
144          (XZHAT(JK) < XZHAT(IBOT) - XHEIGHT_BASE + XDEPTH_BASE/2. )) THEN
145          XSVT(IIB:IIE,IJB:IJE,JK,JSV) =  &
146            XSVT(IIB:IIE,IJB:IJE,JK,JSV)+1.  
147      END IF
148     END DO
149  END IF    
150
151  IF ((JSV == NSV_CSBEG + 2 ).AND.(ITOP > 2)) THEN
152     ! emission XHEIGHT_TOP(m) above the top on XDEPTH_TOP(m)
153     !
154     DO JK=1,IKE
155      IF ((XZHAT(JK) > XZHAT(ITOP) + XHEIGHT_TOP - XDEPTH_TOP/2. ).AND. &
156          (XZHAT(JK) < XZHAT(ITOP) + XHEIGHT_TOP + XDEPTH_TOP/2. )) THEN
157          XSVT(IIB:IIE,IJB:IJE,JK,JSV) = &
158            XSVT(IIB:IIE,IJB:IJE,JK,JSV)+1. 
159      END IF
160     END DO
161  END IF    !
162 !
163 END DO            
164          !
165 !
166 ! correction d'eventuelle concentration n├ęgative
167 WHERE (XSVT(:,:,:,NSV_CSBEG:NSV_CSEND) <0.0) &
168        XSVT(:,:,:,NSV_CSBEG:NSV_CSEND)=0.0
169 !
170 !
171 !  2: Radioactive decrease            
172 !
173 DO JSV=NSV_CSBEG, NSV_CSEND
174    XSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) *         &
175            EXP(-1.*XTSTEP_MODEL1/XRADIO(JSV-NSV_CSBEG+1)) 
176 END DO
177 !-------------------------------------------------------------------------------
178 !
179 !-------------------------------------------------------------------------------
180 !
181 END SUBROUTINE CONDSAMP