source: LMDZ5/trunk/libf/dyn3dpar/dissip_p.F @ 4735

Last change on this file since 4735 was 2597, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.0 KB
Line 
1!
2! $Id: dissip_p.F 2597 2016-07-22 06:44:47Z oboucher $
3!
4      SUBROUTINE dissip_p( vcov,ucov,teta,p, dv,du,dh )
5c
6      USE parallel_lmdz
7      USE write_field_p
8      USE comconst_mod, ONLY: dtdiss
9      IMPLICIT NONE
10
11
12c ..  Avec nouveaux operateurs star :  gradiv2 , divgrad2, nxgraro2  ...
13c                                 (  10/01/98  )
14
15c=======================================================================
16c
17c   Auteur:  P. Le Van
18c   -------
19c
20c   Objet:
21c   ------
22c
23c   Dissipation horizontale
24c
25c=======================================================================
26c-----------------------------------------------------------------------
27c   Declarations:
28c   -------------
29
30#include "dimensions.h"
31#include "paramet.h"
32#include "comgeom.h"
33#include "comdissnew.h"
34#include "comdissipn.h"
35
36c   Arguments:
37c   ----------
38
39      REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
40      REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
41      REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potentail temperature
42      REAL,INTENT(IN) :: p(ip1jmp1,llmp1) ! pressure
43      ! tendencies (.../s) on covariant winds and potential temperature
44      REAL,INTENT(OUT) :: dv(ip1jm,llm)
45      REAL,INTENT(OUT) :: du(ip1jmp1,llm)
46      REAL,INTENT(OUT) :: dh(ip1jmp1,llm)
47
48c   Local:
49c   ------
50
51      REAL gdx(ip1jmp1,llm),gdy(ip1jm,llm)
52      REAL grx(ip1jmp1,llm),gry(ip1jm,llm)
53      REAL te1dt(llm),te2dt(llm),te3dt(llm)
54      REAL deltapres(ip1jmp1,llm)
55
56      INTEGER l,ij
57
58      REAL  SSUM
59      integer :: ijb,ije
60c-----------------------------------------------------------------------
61c   initialisations:
62c   ----------------
63
64c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
65      DO l=1,llm
66         te1dt(l) = tetaudiv(l) * dtdiss
67         te2dt(l) = tetaurot(l) * dtdiss
68         te3dt(l) = tetah(l)    * dtdiss
69      ENDDO
70c$OMP END DO NOWAIT
71c      CALL initial0( ijp1llm, du )
72c      CALL initial0( ijmllm , dv )
73c      CALL initial0( ijp1llm, dh )
74     
75      ijb=ij_begin
76      ije=ij_end
77
78c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
79      DO l=1,llm
80        du(ijb:ije,l)=0
81        dh(ijb:ije,l)=0
82      ENDDO
83c$OMP END DO NOWAIT
84     
85      if (pole_sud) ije=ij_end-iip1
86
87c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
88      DO l=1,llm
89        dv(ijb:ije,l)=0
90      ENDDO
91c$OMP END DO NOWAIT
92     
93c-----------------------------------------------------------------------
94c   Calcul de la dissipation:
95c   -------------------------
96
97c   Calcul de la partie   grad  ( div ) :
98c   -------------------------------------
99     
100     
101     
102      IF(lstardis) THEN
103c      IF (.FALSE.) THEN
104         CALL gradiv2_p( llm,ucov,vcov,nitergdiv,gdx,gdy )
105      ELSE
106         CALL gradiv_p ( llm,ucov,vcov,nitergdiv,gdx,gdy )
107      ENDIF
108
109
110      ijb=ij_begin
111      ije=ij_end
112      if (pole_sud) ije=ij_end-iip1
113
114c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
115      DO l=1,llm
116         if (pole_nord) then
117           DO ij = 1, iip1
118              gdx(     ij ,l) = 0.
119           ENDDO
120         endif
121         
122         if (pole_sud) then
123           DO ij = 1, iip1
124              gdx(ij+ip1jm,l) = 0.
125           ENDDO
126         endif
127         
128         if (pole_nord) ijb=ij_begin+iip1
129         DO ij = ijb,ije
130            du(ij,l) = du(ij,l) - te1dt(l) *gdx(ij,l)
131         ENDDO
132
133         if (pole_nord) ijb=ij_begin
134         DO ij = ijb,ije
135            dv(ij,l) = dv(ij,l) - te1dt(l) *gdy(ij,l)
136         ENDDO
137
138       ENDDO
139c$OMP END DO NOWAIT
140c   calcul de la partie   n X grad ( rot ):
141c   ---------------------------------------
142
143      IF(lstardis) THEN
144c      IF (.FALSE.) THEN
145         CALL nxgraro2_p( llm,ucov, vcov, nitergrot,grx,gry )
146      ELSE
147         CALL nxgrarot_p( llm,ucov, vcov, nitergrot,grx,gry )
148      ENDIF
149
150
151
152      ijb=ij_begin
153      ije=ij_end
154      if (pole_sud) ije=ij_end-iip1
155
156c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
157      DO l=1,llm
158         
159         if (pole_nord) then
160           DO ij = 1, iip1
161              grx(ij,l) = 0.
162           ENDDO
163         endif
164         
165         if (pole_nord) ijb=ij_begin+iip1
166         DO ij = ijb,ije
167            du(ij,l) = du(ij,l) - te2dt(l) * grx(ij,l)
168         ENDDO
169         
170         if (pole_nord) ijb=ij_begin
171         DO ij =  ijb, ije
172            dv(ij,l) = dv(ij,l) - te2dt(l) * gry(ij,l)
173         ENDDO
174     
175      ENDDO
176c$OMP END DO NOWAIT
177
178c   calcul de la partie   div ( grad ):
179c   -----------------------------------
180
181       
182      IF(lstardis) THEN
183c      IF (.FALSE.) THEN
184   
185      ijb=ij_begin
186      ije=ij_end
187
188c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
189       DO l = 1, llm
190          DO ij = ijb, ije
191            deltapres(ij,l) = AMAX1( 0.,  p(ij,l) - p(ij,l+1) )
192          ENDDO
193       ENDDO
194c$OMP END DO NOWAIT
195         CALL divgrad2_p( llm,teta, deltapres  ,niterh, gdx )
196      ELSE
197         CALL divgrad_p ( llm,teta, niterh, gdx        )
198      ENDIF
199
200c      call write_field3d_p('gdx2',reshape(gdx,(/iip1,jmp1,llm/)))
201c      stop
202
203      ijb=ij_begin
204      ije=ij_end
205     
206c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
207      DO l = 1,llm
208         DO ij = ijb,ije
209            dh( ij,l ) = dh( ij,l ) - te3dt(l) * gdx( ij,l )
210         ENDDO
211      ENDDO
212c$OMP END DO NOWAIT
213
214      RETURN
215      END
Note: See TracBrowser for help on using the repository browser.