source: LMDZ6/trunk/libf/phylmd/alpale_mod.f90 @ 5815

Last change on this file since 5815 was 5815, checked in by rkazeroni, 2 months ago

For GPU porting of alpale routine:

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