source: LMDZ5/trunk/libf/dyn3dmem/call_calfis_mod.F90 @ 1857

Last change on this file since 1857 was 1857, checked in by Ehouarn Millour, 11 years ago

Remove call to diagedyn. Current diagedyn is supposed to work on global arrays, which is not compatible with dyn3dmem settings. Extra work is required if we want to adapt diagedyn to dyn3dmem (but diagedyn currently doesn't work even in seq mode...).
EM
File size: 11.3 KB
Line 
1!#define DEBUG_IO
2MODULE call_calfis_mod
3
4    REAL,POINTER,SAVE :: ucov(:,:)
5    REAL,POINTER,SAVE :: vcov(:,:)
6    REAL,POINTER,SAVE :: teta(:,:)
7    REAL,POINTER,SAVE :: masse(:,:)
8    REAL,POINTER,SAVE :: ps(:)
9    REAL,POINTER,SAVE :: phis(:)
10    REAL,POINTER,SAVE :: q(:,:,:)
11    REAL,POINTER,SAVE :: flxw(:,:)
12
13    REAL,POINTER,SAVE :: p(:,:)
14    REAL,POINTER,SAVE :: alpha(:,:)
15    REAL,POINTER,SAVE :: beta(:,:)
16    REAL,POINTER,SAVE :: pks(:)
17    REAL,POINTER,SAVE :: pk(:,:)
18    REAL,POINTER,SAVE :: pkf(:,:)
19    REAL,POINTER,SAVE :: phi(:,:)
20    REAL,POINTER,SAVE :: du(:,:)
21    REAL,POINTER,SAVE :: dv(:,:)
22    REAL,POINTER,SAVE :: dteta(:,:)
23    REAL,POINTER,SAVE :: dq(:,:,:)
24    REAL,POINTER,SAVE :: dufi(:,:)
25    REAL,POINTER,SAVE :: dvfi(:,:)
26    REAL,POINTER,SAVE :: dtetafi(:,:)
27    REAL,POINTER,SAVE :: dqfi(:,:,:)
28    REAL,POINTER,SAVE :: dpfi(:)
29   
30   
31   
32   
33   
34CONTAINS
35
36  SUBROUTINE call_calfis_allocate
37  USE bands
38  USE allocate_field_mod
39  USE parallel_lmdz
40  USE dimensions_mod
41  USE infotrac
42  IMPLICIT NONE
43    TYPE(distrib),POINTER :: d
44    d=>distrib_physic
45
46    CALL allocate_u(ucov,llm,d)
47    CALL allocate_v(vcov,llm,d)
48    CALL allocate_u(teta,llm,d)
49    CALL allocate_u(masse,llm,d)
50    CALL allocate_u(ps,d)
51    CALL allocate_u(phis,d)
52    CALL allocate_u(q,llm,nqtot,d)
53    CALL allocate_u(flxw,llm,d)
54    CALL allocate_u(p,llmp1,d)
55    CALL allocate_u(alpha,llm,d)
56    CALL allocate_u(beta,llm,d)
57    CALL allocate_u(pks,d)
58    CALL allocate_u(pk,llm,d)
59    CALL allocate_u(pkf,llm,d)
60    CALL allocate_u(phi,llm,d)
61    CALL allocate_u(du,llm,d)
62    CALL allocate_v(dv,llm,d)
63    CALL allocate_u(dteta,llm,d)
64    CALL allocate_u(dq,llm,nqtot,d)
65    CALL allocate_u(dufi,llm,d)
66    CALL allocate_v(dvfi,llm,d)
67    CALL allocate_u(dtetafi,llm,d)
68    CALL allocate_u(dqfi,llm,nqtot,d)
69    CALL allocate_u(dpfi,d)
70 
71  END SUBROUTINE call_calfis_allocate
72 
73 
74  SUBROUTINE call_calfis(itau,lafin,clesphy0,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
75                         phis_dyn,q_dyn,flxw_dyn)
76  USE dimensions_mod
77  USE parallel_lmdz
78  USE times
79  USE mod_hallo
80  USE Bands
81  USE vampir
82  USE infotrac
83  USE control_mod
84  USE write_field_loc
85  USE write_field
86  IMPLICIT NONE
87    INCLUDE "comconst.h"
88    INCLUDE "comvert.h"
89    INCLUDE "logic.h"
90    INCLUDE "temps.h"
91    INCLUDE "iniprint.h"
92
93    REAL    :: clesphy0( : )   
94    INTEGER :: itau
95    LOGICAL :: lafin
96    REAL :: ucov_dyn(ijb_u:ije_u,llm)
97    REAL :: vcov_dyn(ijb_v:ije_v,llm)
98    REAL :: teta_dyn(ijb_u:ije_u,llm)
99    REAL :: masse_dyn(ijb_u:ije_u,llm)
100    REAL :: ps_dyn(ijb_u:ije_u)
101    REAL :: phis_dyn(ijb_u:ije_u)
102    REAL :: q_dyn(ijb_u:ije_u,llm,nqtot)
103    REAL :: flxw_dyn(ijb_u:ije_u,llm)
104
105    REAL :: dufi_tmp(iip1,llm)   
106    REAL :: dvfi_tmp(iip1,llm) 
107    REAL :: dtetafi_tmp(iip1,llm)
108    REAL :: dpfi_tmp(iip1)
109    REAL :: dqfi_tmp(iip1,llm,nqtot)
110
111    REAL :: jD_cur, jH_cur
112    CHARACTER(LEN=15) :: ztit
113    TYPE(Request),SAVE :: Request_physic
114!$OMP THREADPRIVATE(Request_physic )
115    INTEGER :: ijb,ije,l,j
116   
117   
118#ifdef DEBUG_IO   
119    CALL WriteField_u('ucovfi',ucov)
120    CALL WriteField_v('vcovfi',vcov)
121    CALL WriteField_u('tetafi',teta)
122    CALL WriteField_u('pfi',p)
123    CALL WriteField_u('pkfi',pk)
124    DO j=1,nqtot
125      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
126    ENDDO
127#endif
128
129!
130!     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
131!
132
133
134  !$OMP MASTER
135    CALL suspend_timer(timer_caldyn)
136    WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
137  !$OMP END MASTER
138   
139           jD_cur = jD_ref + day_ini - day_ref                           &
140     &        + itau/day_step
141
142           IF (planet_type .eq."generic") THEN
143              ! AS: we make jD_cur to be pday
144              jD_cur = int(day_ini + itau/day_step)
145           ENDIF
146
147           jH_cur = jH_ref + start_time +                                &
148     &              mod(itau,day_step)/float(day_step)
149    if (jH_cur > 1.0 ) then
150      jD_cur = jD_cur +1.
151      jH_cur = jH_cur -1.
152    endif
153
154!   Inbterface avec les routines de phylmd (phymars ... )
155!   -----------------------------------------------------
156
157!+jld
158
159!  Diagnostique de conservation de l'energie : initialisation
160 
161!-jld
162  !$OMP BARRIER
163  !$OMP MASTER
164    CALL VTb(VThallo)
165  !$OMP END MASTER
166
167#ifdef DEBUG_IO   
168    CALL WriteField_u('ucovfi',ucov)
169    CALL WriteField_v('vcovfi',vcov)
170    CALL WriteField_u('tetafi',teta)
171    CALL WriteField_u('pfi',p)
172    CALL WriteField_u('pkfi',pk)
173#endif
174   
175    CALL SetTag(Request_physic,800)
176    CALL Register_SwapField_u(ucov_dyn,ucov,distrib_physic,Request_physic,up=2,down=2)
177    CALL Register_SwapField_v(vcov_dyn,vcov,distrib_physic,Request_physic,up=2,down=2)
178    CALL Register_SwapField_u(teta_dyn,teta,distrib_physic,Request_physic,up=2,down=2)
179    CALL Register_SwapField_u(masse_dyn,masse,distrib_physic,Request_physic,up=1,down=2)
180    CALL Register_SwapField_u(ps_dyn,ps,distrib_physic,Request_physic,up=2,down=2)
181    CALL Register_SwapField_u(phis_dyn,phis,distrib_physic,Request_physic,up=2,down=2)
182    CALL Register_SwapField_u(q_dyn,q,distrib_physic,Request_physic,up=2,down=2)
183    CALL Register_SwapField_u(flxw_dyn,flxw,distrib_physic,Request_physic,up=2,down=2)
184 
185    CALL SendRequest(Request_Physic)
186  !$OMP BARRIER
187    CALL WaitRequest(Request_Physic)       
188
189  !$OMP BARRIER
190  !$OMP MASTER
191    CALL Set_Distrib(distrib_Physic)
192    CALL VTe(VThallo)
193       
194    CALL VTb(VTphysiq)
195  !$OMP END MASTER
196  !$OMP BARRIER
197
198    CALL pression_loc (  ip1jmp1, ap, bp, ps,  p      )
199
200  !$OMP BARRIER
201    CALL exner_hyb_loc(  ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
202  !$OMP BARRIER
203    CALL geopot_loc  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
204
205
206    CALL Register_Hallo_u(p,llmp1,2,2,2,2,Request_physic)
207    CALL Register_Hallo_u(pk,llm,2,2,2,2,Request_physic)
208    CALL Register_Hallo_u(phi,llm,2,2,2,2,Request_physic)
209       
210    CALL SendRequest(Request_Physic)
211  !$OMP BARRIER
212    CALL WaitRequest(Request_Physic)
213             
214  !$OMP BARRIER
215 
216 
217#ifdef DEBUG_IO   
218    CALL WriteField_u('ucovfi',ucov)
219    CALL WriteField_v('vcovfi',vcov)
220    CALL WriteField_u('tetafi',teta)
221    CALL WriteField_u('pfi',p)
222    CALL WriteField_u('pkfi',pk)
223    DO j=1,nqtot
224      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
225    ENDDO
226#endif
227
228  !$OMP BARRIER
229
230    CALL calfis_loc(lafin ,jD_cur, jH_cur,                       &
231                     ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,   &
232                     du,dv,dteta,dq,                             &
233                     flxw,                                       &
234                     clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
235
236    ijb=ij_begin
237    ije=ij_end 
238    IF ( .not. pole_nord) THEN
239 
240    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
241      DO l=1,llm
242        dufi_tmp(1:iip1,l)   = dufi(ijb:ijb+iim,l)
243        dvfi_tmp(1:iip1,l)   = dvfi(ijb:ijb+iim,l) 
244        dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 
245        dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 
246      ENDDO
247    !$OMP END DO NOWAIT
248
249    !$OMP MASTER
250      dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
251    !$OMP END MASTER
252   
253    ENDIF ! of if ( .not. pole_nord)
254
255  !$OMP BARRIER
256  !$OMP MASTER
257    CALL Set_Distrib(distrib_Physic_bis)
258    CALL VTb(VThallo)
259  !$OMP END MASTER
260  !$OMP BARRIER
261 
262    CALL Register_Hallo_u(dufi,llm,1,0,0,1,Request_physic)
263    CALL Register_Hallo_v(dvfi,llm,1,0,0,1,Request_physic)
264    CALL Register_Hallo_u(dtetafi,llm,1,0,0,1,Request_physic)
265    CALL Register_Hallo_u(dpfi,1,1,0,0,1,Request_physic)
266
267    DO j=1,nqtot
268      CALL Register_Hallo_u(dqfi(:,:,j),llm,1,0,0,1,Request_physic)
269    ENDDO
270       
271    CALL SendRequest(Request_Physic)
272  !$OMP BARRIER
273    CALL WaitRequest(Request_Physic)
274             
275  !$OMP BARRIER
276  !$OMP MASTER
277    CALL VTe(VThallo)
278    CALL Set_Distrib(distrib_Physic)
279  !$OMP END MASTER
280  !$OMP BARRIER       
281    ijb=ij_begin
282    IF (.not. pole_nord) THEN
283       
284    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
285      DO l=1,llm
286        dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
287        dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
288        dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)+dtetafi_tmp(1:iip1,l)
289        dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) + dqfi_tmp(1:iip1,l,:)
290      ENDDO
291    !$OMP END DO NOWAIT
292
293    !$OMP MASTER
294      dpfi(ijb:ijb+iim)   = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
295    !$OMP END MASTER
296         
297    endif ! of if (.not. pole_nord)
298       
299       
300#ifdef DEBUG_IO           
301    CALL WriteField_u('dufi',dufi)
302    CALL WriteField_v('dvfi',dvfi)
303    CALL WriteField_u('dtetafi',dtetafi)
304    CALL WriteField_u('dpfi',dpfi)
305    DO j=1,nqtot
306      CALL WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
307    ENDDO
308#endif
309
310  !$OMP BARRIER
311
312!      ajout des tendances physiques:
313!      ------------------------------
314#ifdef DEBUG_IO   
315    CALL WriteField_u('ucovfi',ucov)
316    CALL WriteField_v('vcovfi',vcov)
317    CALL WriteField_u('tetafi',teta)
318    CALL WriteField_u('psfi',ps)
319    DO j=1,nqtot
320      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
321    ENDDO
322#endif
323
324#ifdef DEBUG_IO           
325    CALL WriteField_u('ucovfi',ucov)
326    CALL WriteField_v('vcovfi',vcov)
327    CALL WriteField_u('tetafi',teta)
328    CALL WriteField_u('psfi',ps)
329    DO j=1,nqtot
330      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
331    ENDDO
332#endif
333
334    CALL addfi_loc( dtphys, leapf, forward   ,              &
335                    ucov, vcov, teta , q   ,ps ,            &
336                    dufi, dvfi, dtetafi , dqfi ,dpfi  )
337
338#ifdef DEBUG_IO   
339    CALL WriteField_u('ucovfi',ucov)
340    CALL WriteField_v('vcovfi',vcov)
341    CALL WriteField_u('tetafi',teta)
342    CALL WriteField_u('psfi',ps)
343    DO j=1,nqtot
344      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
345    ENDDO
346#endif
347
348    IF (ok_strato) THEN
349!      CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
350      CALL top_bound_loc(vcov,ucov,teta,masse,dtphys)
351    ENDIF
352
353  !$OMP BARRIER
354  !$OMP MASTER
355    CALL VTe(VTphysiq)
356    CALL VTb(VThallo)
357  !$OMP END MASTER
358
359    CALL SetTag(Request_physic,800)
360    CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_physic)
361    CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_physic)
362    CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_physic)
363    CALL Register_SwapField_u(masse,masse_dyn,distrib_caldyn,Request_physic)
364    CALL Register_SwapField_u(ps,ps_dyn,distrib_caldyn,Request_physic)
365    CALL Register_SwapField_u(q,q_dyn,distrib_caldyn,Request_physic)
366    CALL SendRequest(Request_Physic)
367  !$OMP BARRIER
368    CALL WaitRequest(Request_Physic)     
369
370  !$OMP BARRIER
371  !$OMP MASTER
372    CALL VTe(VThallo)
373    CALL set_distrib(distrib_caldyn)
374  !$OMP END MASTER
375  !$OMP BARRIER
376
377!
378!  Diagnostique de conservation de l'energie : difference
379    IF (ip_ebil_dyn.ge.1 ) THEN
380      ztit='bil phys'
381!      CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
382      write(lunout,*)"call_calfis: diagedyn disabled in dyn3dmem !!"
383    ENDIF
384
385#ifdef DEBUG_IO   
386    CALL WriteField_u('ucovfi',ucov_dyn)
387    CALL WriteField_v('vcovfi',vcov_dyn)
388    CALL WriteField_u('tetafi',teta_dyn)
389    CALL WriteField_u('psfi',ps_dyn)
390    DO j=1,nqtot
391      CALL WriteField_u('qfi'//trim(int2str(j)),q_dyn(:,:,j))
392    ENDDO
393#endif
394
395
396!-jld
397    !$OMP MASTER
398      CALL resume_timer(timer_caldyn)
399    !$OMP END MASTER
400
401  END SUBROUTINE call_calfis
402 
403END MODULE call_calfis_mod
Note: See TracBrowser for help on using the repository browser.