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

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

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