source: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_alpale.f90 @ 5134

Last change on this file since 5134 was 5134, checked in by abarral, 4 months ago

Replace academic.h, alpale.h, comdissip.h, comdissipn.h, comdissnew.h by modules
Remove unused clesph0.h
File size: 8.0 KB
Line 
1! Contains the alpale subroutine, as well as the old content from alpale.h
2
3MODULE lmdz_alpale
4  IMPLICIT NONE; PRIVATE
5  PUBLIC alpale
6
7  !=====================================================================
8  ! Specifique de Ale/Alp :
9  !=====================================================================
10  PUBLIC iflag_trig_bl, iflag_clos_bl, tau_trig_shallow, tau_trig_deep, iflag_strig, &
11          alp_bl_k, s_trig, h_trig, iflag_coupl, iflag_clos, iflag_wake
12  ! dans alealp_th, thermcell_alp, physiq_mod, conf_phys
13  INTEGER :: iflag_trig_bl, iflag_clos_bl, iflag_strig
14  INTEGER :: tau_trig_shallow, tau_trig_deep
15  REAL :: s_trig, h_trig
16  ! thermcell_alp et convection ...
17  INTEGER :: iflag_coupl, iflag_clos, iflag_wake
18  ! thermcell_alp
19  REAL :: alp_bl_k
20  !$OMP THREADPRIVATE(iflag_trig_bl, iflag_clos_bl, tau_trig_shallow, tau_trig_deep, iflag_strig)
21  !$OMP THREADPRIVATE(alp_bl_k, s_trig, h_trig, iflag_coupl, iflag_clos, iflag_wake)
22
23CONTAINS
24
25  SUBROUTINE alpale(debut, itap, dtime, paprs, omega, t_seri, &
26          alp_offset, it_wape_prescr, wape_prescr, fip_prescr, &
27          ale_bl_prescr, alp_bl_prescr, &
28          wake_pe, wake_fip, &
29          Ale_bl, Ale_bl_trig, Alp_bl, &
30          Ale, Alp, Ale_wake, Alp_wake)
31
32    ! **************************************************************
33    ! *
34    ! ALPALE                                                       *
35    ! *
36    ! *
37    ! written by   : Jean-Yves Grandpeix, 12/05/2016              *
38    ! modified by :                                               *
39    ! **************************************************************
40
41    USE dimphy
42    USE lmdz_ioipsl_getin_p, ONLY: getin_p
43    USE lmdz_print_control, ONLY: mydebug => debug, lunout, prt_level
44    USE phys_local_var_mod, ONLY: zw2       ! Variables internes non sauvegardees de la physique
45    USE lmdz_abort_physic, ONLY: abort_physic
46
47    IMPLICIT NONE
48
49    !================================================================
50    ! Auteur(s)   : Jean-Yves Grandpeix, 12/05/2016
51    ! Objet : Sums up all contributions to Ale and Alp
52    !================================================================
53
54    ! Input arguments
55    !----------------
56    LOGICAL, INTENT(IN) :: debut
57    INTEGER, INTENT(IN) :: itap
58    REAL, INTENT(IN) :: dtime
59    INTEGER, INTENT(IN) :: it_wape_prescr
60    REAL, INTENT(IN) :: wape_prescr, fip_prescr
61    REAL, INTENT(IN) :: Ale_bl_prescr, Alp_bl_prescr
62    REAL, INTENT(IN) :: alp_offset
63    REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs
64    REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri
65    REAL, DIMENSION(klon, klev), INTENT(IN) :: omega
66    REAL, DIMENSION(klon), INTENT(IN) :: wake_pe, wake_fip
67    REAL, DIMENSION(klon), INTENT(IN) :: Ale_bl, Ale_bl_trig, Alp_bl
68
69
70    ! Output arguments
71    !----------------
72    REAL, DIMENSION(klon), INTENT(OUT) :: Ale, Alp
73    REAL, DIMENSION(klon), INTENT(OUT) :: Ale_wake, Alp_wake
74
75    include "YOMCST.h"
76    include "YOETHF.h"
77
78    ! Local variables
79    !----------------
80    INTEGER :: i, k
81    REAL, DIMENSION(klon) :: www
82    REAL, SAVE :: ale_max = 1000.
83    REAL, SAVE :: alp_max = 2.
84    CHARACTER*20 modname
85    CHARACTER*80 abort_message
86
87
88    !$OMP THREADPRIVATE(ale_max,alp_max)
89
90    ! Calcul de l'energie disponible ALE (J/kg) et de la puissance
91    ! disponible ALP (W/m2) pour le soulevement des particules dans
92    ! le modele convectif
93
94    do i = 1, klon
95      ALE(i) = 0.
96      ALP(i) = 0.
97    enddo
98
99    !calcul de ale_wake et alp_wake
100    IF (iflag_wake>=1) THEN
101      IF (itap <= it_wape_prescr) THEN
102        do i = 1, klon
103          ale_wake(i) = wape_prescr
104          alp_wake(i) = fip_prescr
105        enddo
106      else
107        do i = 1, klon
108          !jyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
109          !cc           ale_wake(i) = 0.5*wake_cstar(i)**2
110          ale_wake(i) = wake_pe(i)
111          alp_wake(i) = wake_fip(i)
112        enddo
113      endif
114    else
115      do i = 1, klon
116        ale_wake(i) = 0.
117        alp_wake(i) = 0.
118      enddo
119    endif
120    !combinaison avec ale et alp de couche limite: constantes si pas
121    !de couplage, valeurs calculees dans le thermique sinon
122    IF (iflag_coupl==0) THEN
123      IF (debut.AND.prt_level>9) &
124              WRITE(lunout, *)'ALE et ALP imposes'
125      do i = 1, klon
126        !on ne couple que ale
127        !           ALE(i) = max(ale_wake(i),Ale_bl(i))
128        ALE(i) = max(ale_wake(i), ale_bl_prescr)
129        !on ne couple que alp
130        !           ALP(i) = alp_wake(i) + Alp_bl(i)
131        ALP(i) = alp_wake(i) + alp_bl_prescr
132      enddo
133    else
134      IF(prt_level>9)WRITE(lunout, *)'ALE et ALP couples au thermique'
135      !         do i = 1,klon
136      !             ALE(i) = max(ale_wake(i),Ale_bl(i))
137      ! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
138      !             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
139      !         WRITE(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
140      !         WRITE(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
141      !         enddo
142
143      ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
144      ! Modif FH 2010/04/27. Sans doute temporaire.
145      ! Deux options pour le alp_offset : constant si >?? 0 ou
146      ! proportionnel ??a w si <0
147      ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
148      ! Estimation d'une vitesse verticale effective pour ALP
149      IF (1==0) THEN
150        www(1:klon) = 0.
151        do k = 2, klev - 1
152          do i = 1, klon
153            www(i) = max(www(i), -omega(i, k) * RD * t_seri(i, k) &
154                    / (RG * paprs(i, k)) * zw2(i, k) * zw2(i, k))
155            ! if (paprs(i,k)>pbase(i)) THEN
156            ! calcul approche de la vitesse verticale en m/s
157            !  www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k))
158            !             endif
159            !   Le 0.1 est en gros H / ps = 1e4 / 1e5
160          enddo
161        enddo
162        do i = 1, klon
163          IF (www(i)>0. .AND. ale_bl(i)>0.) www(i) = www(i) / ale_bl(i)
164        enddo
165      ENDIF
166
167      do i = 1, klon
168        ALE(i) = max(ale_wake(i), Ale_bl(i))
169        !cc nrlmd le 10/04/2012----------Stochastic triggering------------
170        IF (iflag_trig_bl>=1) THEN
171          ALE(i) = max(ale_wake(i), Ale_bl_trig(i))
172        endif
173        !cc fin nrlmd le 10/04/2012
174        IF (alp_offset>=0.) THEN
175          ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
176        else
177          abort_message = 'Ne pas passer la car www non calcule'
178          CALL abort_physic (modname, abort_message, 1)
179
180          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
181          !                                _                  _
182          ! Ajout d'une composante 3 * A * w w'2 a w'3 avec
183          ! w=www : w max sous pbase ou A est la fraction
184          ! couverte par les ascendances w' on utilise le fait
185          ! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE)
186          ! (on ajoute 0.1 pour les singularites)
187          ALP(i) = alp_wake(i) * (1. + 3. * www(i) / (sqrt(ale_wake(i)) + 0.1)) &
188                  + alp_bl(i) * (1. + 3. * www(i) / (sqrt(ale_bl(i)) + 0.1))
189          !    ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
190          !             if (alp(i)<0.) THEN
191          !                PRINT*,'ALP ',alp(i),alp_wake(i) &
192          !                     ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
193          !             endif
194        endif
195      enddo
196      ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
197
198    endif
199    do i = 1, klon
200      IF (alp(i)>alp_max) THEN
201        IF(prt_level>9)WRITE(lunout, *)                             &
202                'WARNING SUPER ALP (seuil=', alp_max, &
203                '): i, alp, alp_wake,ale', i, alp(i), alp_wake(i), ale(i)
204        alp(i) = alp_max
205      endif
206      IF (ale(i)>ale_max) THEN
207        IF(prt_level>9)WRITE(lunout, *)                             &
208                'WARNING SUPER ALE (seuil=', ale_max, &
209                '): i, alp, alp_wake,ale', i, ale(i), ale_wake(i), alp(i)
210        ale(i) = ale_max
211      endif
212    enddo
213
214    !fin calcul ale et alp
215    !=======================================================================
216
217    RETURN
218  END
219
220END MODULE lmdz_alpale
Note: See TracBrowser for help on using the repository browser.