source: LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.F90 @ 5133

Last change on this file since 5133 was 5117, checked in by abarral, 5 months ago

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