source: LMDZ6/trunk/libf/dyn3dmem/call_dissip_mod.f90 @ 5281

Last change on this file since 5281 was 5281, checked in by abarral, 4 days ago

Turn comgeom.h comgeom2.h into modules
  • 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
File size: 9.2 KB
Line 
1MODULE call_dissip_mod
2
3    REAL,POINTER,SAVE :: ucov(:,:)
4    REAL,POINTER,SAVE :: vcov(:,:)
5    REAL,POINTER,SAVE :: teta(:,:)
6    REAL,POINTER,SAVE :: p(:,: )
7    REAL,POINTER,SAVE :: pk(:,:)
8
9    REAL,POINTER,SAVE :: ucont(:,:)
10    REAL,POINTER,SAVE :: vcont(:,:)
11    REAL,POINTER,SAVE :: ecin(:,:)
12    REAL,POINTER,SAVE :: ecin0(:,:)
13    REAL,POINTER,SAVE :: dudis(:,:)
14    REAL,POINTER,SAVE :: dvdis(:,:)
15    REAL,POINTER,SAVE :: dtetadis(:,:)
16    REAL,POINTER,SAVE :: dtetaecdt(:,:)
17
18
19
20CONTAINS
21 
22  SUBROUTINE call_dissip_allocate
23  USE bands
24  USE allocate_field_mod
25  USE parallel_lmdz
26  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
27  USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
28          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
29  USE dissip_mod, ONLY : dissip_allocate
30  IMPLICIT NONE
31    TYPE(distrib),POINTER :: d
32    d=>distrib_dissip
33
34    CALL allocate_u(ucov,llm,d)
35    ucov(:,:)=0
36    CALL allocate_v(vcov,llm,d)
37    vcov(:,:)=0
38    CALL allocate_u(teta,llm,d)
39    CALL allocate_u(p,llmp1,d)
40    CALL allocate_u(pk,llm,d)
41    CALL allocate_u(ucont,llm,d)
42    CALL allocate_v(vcont,llm,d)
43    CALL allocate_u(ecin,llm,d)
44    CALL allocate_u(ecin0,llm,d)
45    CALL allocate_u(dudis,llm,d)
46    CALL allocate_v(dvdis,llm,d)
47    CALL allocate_u(dtetadis,llm,d)
48    CALL allocate_u(dtetaecdt,llm,d)
49
50
51    CALL dissip_allocate
52
53  END SUBROUTINE call_dissip_allocate
54
55  SUBROUTINE call_dissip_switch_dissip(dist)
56  USE allocate_field_mod
57  USE bands
58  USE parallel_lmdz
59  USE dissip_mod, ONLY : dissip_switch_dissip
60  IMPLICIT NONE
61    TYPE(distrib),INTENT(IN) :: dist
62
63    CALL switch_u(ucov,distrib_dissip,dist)
64    CALL switch_v(vcov,distrib_dissip,dist)
65    CALL switch_u(teta,distrib_dissip,dist)
66    CALL switch_u(p,distrib_dissip,dist)
67    CALL switch_u(pk,distrib_dissip,dist)
68    CALL switch_u(ucont,distrib_dissip,dist)
69    CALL switch_v(vcont,distrib_dissip,dist)
70    CALL switch_u(ecin,distrib_dissip,dist)
71    CALL switch_u(ecin0,distrib_dissip,dist)
72    CALL switch_u(dudis,distrib_dissip,dist)
73    CALL switch_v(dvdis,distrib_dissip,dist)
74    CALL switch_u(dtetadis,distrib_dissip,dist)
75    CALL switch_u(dtetaecdt,distrib_dissip,dist)
76
77    CALL dissip_switch_dissip(dist)
78
79  END SUBROUTINE call_dissip_switch_dissip
80
81
82
83  SUBROUTINE call_dissip(ucov_dyn,vcov_dyn,teta_dyn,p_dyn,pk_dyn,ps_dyn)
84  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
85  USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
86          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
87  USE parallel_lmdz
88  USE times
89  USE mod_hallo
90  USE Bands
91  USE vampir
92  USE write_field_loc
93  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
94  USE comgeom_mod_h
95  IMPLICIT NONE
96    REAL,INTENT(INOUT) :: ucov_dyn(ijb_u:ije_u,llm) ! covariant zonal wind
97    REAL,INTENT(INOUT) :: vcov_dyn(ijb_v:ije_v,llm) ! covariant meridional wind
98    REAL,INTENT(INOUT) :: teta_dyn(ijb_u:ije_u,llm) ! covariant meridional wind
99    REAL,INTENT(INOUT) :: p_dyn(ijb_u:ije_u,llmp1 ) ! pressure at interlayer
100    REAL,INTENT(INOUT) :: pk_dyn(ijb_u:ije_u,llm) ! Exner at midlayer
101    REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
102    REAL :: tppn(iim),tpps(iim)
103    REAL :: tpn,tps
104
105    REAL  SSUM
106    LOGICAL,PARAMETER :: dissip_conservative=.TRUE.
107    TYPE(Request),SAVE :: Request_dissip
108!$OMP THREADPRIVATE(Request_dissip )   
109    INTEGER :: ij,l,ijb,ije
110 
111   
112  !$OMP MASTER
113    CALL suspend_timer(timer_caldyn)
114       
115!       print*,'Entree dans la dissipation : Iteration No ',true_itau
116!   calcul de l'energie cinetique avant dissipation
117!       print *,'Passage dans la dissipation'
118
119    CALL VTb(VThallo)
120  !$OMP END MASTER
121
122  !$OMP BARRIER
123
124    CALL Register_SwapField_u(ucov_dyn,ucov,distrib_dissip, Request_dissip,up=1,down=1)
125    CALL Register_SwapField_v(vcov_dyn,vcov,distrib_dissip, Request_dissip,up=1,down=1)
126    CALL Register_SwapField_u(teta_dyn,teta,distrib_dissip, Request_dissip)
127    CALL Register_SwapField_u(p_dyn,p,distrib_dissip,Request_dissip)
128    CALL Register_SwapField_u(pk_dyn,pk,distrib_dissip,Request_dissip)
129
130    CALL SendRequest(Request_dissip)       
131  !$OMP BARRIER
132    CALL WaitRequest(Request_dissip)       
133
134  !$OMP BARRIER
135  !$OMP MASTER
136    CALL set_distrib(distrib_dissip)
137    CALL VTe(VThallo)
138    CALL VTb(VTdissipation)
139    CALL start_timer(timer_dissip)
140  !$OMP END MASTER
141  !$OMP BARRIER
142
143    CALL covcont_loc(llm,ucov,vcov,ucont,vcont)
144    CALL enercin_loc(vcov,ucov,vcont,ucont,ecin0)
145
146!   dissipation
147
148!        CALL FTRACE_REGION_BEGIN("dissip")
149    CALL dissip_loc(vcov,ucov,teta,p,dvdis,dudis,dtetadis)
150
151IF (CPPKEY_DEBUGIO) THEN
152    CALL WriteField_u('dudis',dudis)
153    CALL WriteField_v('dvdis',dvdis)
154    CALL WriteField_u('dtetadis',dtetadis)
155END IF
156 
157!      CALL FTRACE_REGION_END("dissip")
158         
159    ijb=ij_begin
160    ije=ij_end
161  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
162    DO l=1,llm
163      ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
164    ENDDO
165  !$OMP END DO NOWAIT       
166
167    IF (pole_sud) ije=ije-iip1
168   
169  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
170    DO l=1,llm
171      vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
172    ENDDO
173  !$OMP END DO NOWAIT       
174
175!       teta=teta+dtetadis
176
177
178!------------------------------------------------------------------------
179    IF (dissip_conservative) THEN
180!       On rajoute la tendance due a la transform. Ec -> E therm. cree
181!       lors de la dissipation
182    !$OMP BARRIER
183    !$OMP MASTER
184      CALL suspend_timer(timer_dissip)
185      CALL VTb(VThallo)
186    !$OMP END MASTER
187      CALL Register_Hallo_u(ucov,llm,1,1,1,1,Request_Dissip)
188      CALL Register_Hallo_v(vcov,llm,1,1,1,1,Request_Dissip)
189      CALL SendRequest(Request_Dissip)
190    !$OMP BARRIER
191      CALL WaitRequest(Request_Dissip)
192    !$OMP MASTER
193      CALL VTe(VThallo)
194      CALL resume_timer(timer_dissip)
195    !$OMP END MASTER
196    !$OMP BARRIER           
197      CALL covcont_loc(llm,ucov,vcov,ucont,vcont)
198      CALL enercin_loc(vcov,ucov,vcont,ucont,ecin)
199           
200      ijb=ij_begin
201      ije=ij_end
202    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
203      DO l=1,llm
204        DO ij=ijb,ije
205           dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
206           dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l)
207        ENDDO
208      ENDDO
209    !$OMP END DO NOWAIT           
210
211    ENDIF
212
213    ijb=ij_begin
214    ije=ij_end
215
216  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
217    DO l=1,llm
218      DO ij=ijb,ije
219         teta(ij,l)=teta(ij,l)+dtetadis(ij,l)
220      ENDDO
221    ENDDO
222  !$OMP END DO NOWAIT         
223
224!------------------------------------------------------------------------
225
226
227!    .......        P. Le Van (  ajout  le 17/04/96  )   ...........
228!   ...      Calcul de la valeur moyenne, unique de h aux poles  .....
229!
230
231    ijb=ij_begin
232    ije=ij_end
233         
234    IF (pole_nord) THEN
235 
236   !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
237      DO l  =  1, llm
238        DO ij =  1,iim
239          tppn(ij)  = aire(  ij    ) * teta(  ij    ,l)
240        ENDDO
241        tpn  = SSUM(iim,tppn,1)/apoln
242
243        DO ij = 1, iip1
244          teta(  ij    ,l) = tpn
245        ENDDO
246      ENDDO
247    !$OMP END DO NOWAIT
248
249         if (1 == 0) then
250!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
251!!!                     2) should probably not be here anyway
252!!! but are kept for those who would want to revert to previous behaviour
253    !$OMP MASTER               
254      DO ij =  1,iim
255        tppn(ij)  = aire(  ij    ) * ps_dyn (  ij    )
256      ENDDO
257      tpn  = SSUM(iim,tppn,1)/apoln
258 
259      DO ij = 1, iip1
260        ps_dyn(  ij    ) = tpn
261      ENDDO
262    !$OMP END MASTER
263   
264    ENDIF ! of if (1 == 0)
265    endif ! of of (pole_nord)
266       
267    IF (pole_sud) THEN
268
269    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
270      DO l  =  1, llm
271        DO ij =  1,iim
272          tpps(ij)  = aire(ij+ip1jm) * teta(ij+ip1jm,l)
273        ENDDO
274       
275        tps  = SSUM(iim,tpps,1)/apols
276
277        DO ij = 1, iip1
278          teta(ij+ip1jm,l) = tps
279        ENDDO
280      ENDDO
281    !$OMP END DO NOWAIT
282
283    if (1 == 0) then
284!!! Ehouarn: lines here 1) kill 1+1=2 in the dynamics
285!!!                     2) should probably not be here anyway
286!!! but are kept for those who would want to revert to previous behaviour
287    !$OMP MASTER               
288      DO ij =  1,iim
289        tpps(ij)  = aire(ij+ip1jm) * ps_dyn (ij+ip1jm)
290      ENDDO
291      tps  = SSUM(iim,tpps,1)/apols
292 
293      DO ij = 1, iip1
294        ps_dyn(ij+ip1jm) = tps
295      ENDDO
296    !$OMP END MASTER
297    ENDIF ! of if (1 == 0)
298    endif ! of if (pole_sud)
299
300
301  !$OMP BARRIER
302  !$OMP MASTER
303    CALL VTe(VTdissipation)
304    CALL stop_timer(timer_dissip)
305    CALL VTb(VThallo)
306  !$OMP END MASTER
307 
308    CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_dissip)
309    CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_dissip)
310    CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_dissip)
311    CALL Register_SwapField_u(p,p_dyn,distrib_caldyn,Request_dissip)
312    CALL Register_SwapField_u(pk,pk_dyn,distrib_caldyn,Request_dissip)
313
314    CALL SendRequest(Request_dissip)       
315
316  !$OMP BARRIER
317    CALL WaitRequest(Request_dissip)       
318  !$OMP BARRIER
319  !$OMP MASTER
320    CALL set_distrib(distrib_caldyn)
321    CALL VTe(VThallo)
322    CALL resume_timer(timer_caldyn)
323!        print *,'fin dissipation'
324  !$OMP END MASTER
325  !$OMP BARRIER
326 
327 
328  END SUBROUTINE call_dissip
329
330END MODULE call_dissip_mod
Note: See TracBrowser for help on using the repository browser.