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