source: LMDZ6/branches/Test_modipsl/libf/dyn3dmem/call_dissip_mod.F90 @ 5064

Last change on this file since 5064 was 3435, checked in by Laurent Fairhead, 6 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

  • as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

  • due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

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