source: LMDZ6/branches/DYNAMICO-conv-GC/libf/dyn3dmem/call_calfis_mod.F90 @ 3602

Last change on this file since 3602 was 3406, checked in by jghattas, 6 years ago

Added all modifications in the model code that were used for the simulations with DYANMICO during the Grand Challeng 2018. Modifications done by Y. Meurdesoif, L. Fairhead and A.K. Traore
  • 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: 12.0 KB
RevLine 
[1632]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 :: pks(:)
15    REAL,POINTER,SAVE :: pk(:,:)
16    REAL,POINTER,SAVE :: pkf(:,:)
17    REAL,POINTER,SAVE :: phi(:,:)
18    REAL,POINTER,SAVE :: du(:,:)
19    REAL,POINTER,SAVE :: dv(:,:)
20    REAL,POINTER,SAVE :: dteta(:,:)
21    REAL,POINTER,SAVE :: dq(:,:,:)
22    REAL,POINTER,SAVE :: dufi(:,:)
23    REAL,POINTER,SAVE :: dvfi(:,:)
24    REAL,POINTER,SAVE :: dtetafi(:,:)
25    REAL,POINTER,SAVE :: dqfi(:,:,:)
26    REAL,POINTER,SAVE :: dpfi(:)
27   
28   
29   
30   
31   
32CONTAINS
33
34  SUBROUTINE call_calfis_allocate
35  USE bands
[1810]36  USE allocate_field_mod
[1823]37  USE parallel_lmdz
[1810]38  USE dimensions_mod
[1632]39  USE infotrac
40  IMPLICIT NONE
41    TYPE(distrib),POINTER :: d
42    d=>distrib_physic
43
44    CALL allocate_u(ucov,llm,d)
45    CALL allocate_v(vcov,llm,d)
46    CALL allocate_u(teta,llm,d)
47    CALL allocate_u(masse,llm,d)
48    CALL allocate_u(ps,d)
49    CALL allocate_u(phis,d)
50    CALL allocate_u(q,llm,nqtot,d)
51    CALL allocate_u(flxw,llm,d)
52    CALL allocate_u(p,llmp1,d)
53    CALL allocate_u(pks,d)
[3406]54    pks(:)=0
[1632]55    CALL allocate_u(pk,llm,d)
[3406]56    pk(:,:)=0
[1632]57    CALL allocate_u(pkf,llm,d)
58    CALL allocate_u(phi,llm,d)
59    CALL allocate_u(du,llm,d)
60    CALL allocate_v(dv,llm,d)
61    CALL allocate_u(dteta,llm,d)
62    CALL allocate_u(dq,llm,nqtot,d)
63    CALL allocate_u(dufi,llm,d)
64    CALL allocate_v(dvfi,llm,d)
65    CALL allocate_u(dtetafi,llm,d)
66    CALL allocate_u(dqfi,llm,nqtot,d)
67    CALL allocate_u(dpfi,d)
68 
69  END SUBROUTINE call_calfis_allocate
70 
71 
[2221]72  SUBROUTINE call_calfis(itau,lafin,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
[1632]73                         phis_dyn,q_dyn,flxw_dyn)
[1810]74  USE dimensions_mod
[2021]75  use exner_hyb_loc_m, only: exner_hyb_loc
76  use exner_milieu_loc_m, only: exner_milieu_loc
[1823]77  USE parallel_lmdz
[1632]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
[2597]86  USE comconst_mod, ONLY: dtphys
[2603]87  USE logic_mod, ONLY: leapf, forward, ok_strato
[2600]88  USE comvert_mod, ONLY: ap, bp, pressure_exner
[2601]89  USE temps_mod, ONLY: day_ini, day_ref, jd_ref, jh_ref, start_time
[2600]90 
[1632]91  IMPLICIT NONE
92    INCLUDE "iniprint.h"
93
[1987]94    INTEGER,INTENT(IN) :: itau ! (time) iteration step number
95    LOGICAL,INTENT(IN) :: lafin ! .true. if final time step
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) ! potential temperature
99    REAL,INTENT(INOUT) :: masse_dyn(ijb_u:ije_u,llm) ! air mass
100    REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
101    REAL,INTENT(INOUT) :: phis_dyn(ijb_u:ije_u) ! surface geopotential
102    REAL,INTENT(INOUT) :: q_dyn(ijb_u:ije_u,llm,nqtot) ! advected tracers
103    REAL,INTENT(INOUT) :: flxw_dyn(ijb_u:ije_u,llm) ! vertical mass flux
[1632]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
[1848]113    TYPE(Request),SAVE :: Request_physic
114!$OMP THREADPRIVATE(Request_physic )
[1632]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)
[1987]136    IF (prt_level >= 10) THEN
137      WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
138    ENDIF
[1632]139  !$OMP END MASTER
140   
[1673]141           jD_cur = jD_ref + day_ini - day_ref                           &
[2375]142     &        + (itau+1)/day_step
[1676]143
144           IF (planet_type .eq."generic") THEN
145              ! AS: we make jD_cur to be pday
146              jD_cur = int(day_ini + itau/day_step)
147           ENDIF
148
[1673]149           jH_cur = jH_ref + start_time +                                &
[2375]150     &              mod(itau+1,day_step)/float(day_step)
[1673]151    if (jH_cur > 1.0 ) then
152      jD_cur = jD_cur +1.
153      jH_cur = jH_cur -1.
154    endif
[1632]155
156!   Inbterface avec les routines de phylmd (phymars ... )
157!   -----------------------------------------------------
158
159!+jld
160
161!  Diagnostique de conservation de l'energie : initialisation
162 
163!-jld
164  !$OMP BARRIER
165  !$OMP MASTER
166    CALL VTb(VThallo)
167  !$OMP END MASTER
168
169#ifdef DEBUG_IO   
170    CALL WriteField_u('ucovfi',ucov)
171    CALL WriteField_v('vcovfi',vcov)
172    CALL WriteField_u('tetafi',teta)
173    CALL WriteField_u('pfi',p)
174    CALL WriteField_u('pkfi',pk)
175#endif
176   
177    CALL SetTag(Request_physic,800)
178    CALL Register_SwapField_u(ucov_dyn,ucov,distrib_physic,Request_physic,up=2,down=2)
179    CALL Register_SwapField_v(vcov_dyn,vcov,distrib_physic,Request_physic,up=2,down=2)
180    CALL Register_SwapField_u(teta_dyn,teta,distrib_physic,Request_physic,up=2,down=2)
181    CALL Register_SwapField_u(masse_dyn,masse,distrib_physic,Request_physic,up=1,down=2)
182    CALL Register_SwapField_u(ps_dyn,ps,distrib_physic,Request_physic,up=2,down=2)
183    CALL Register_SwapField_u(phis_dyn,phis,distrib_physic,Request_physic,up=2,down=2)
184    CALL Register_SwapField_u(q_dyn,q,distrib_physic,Request_physic,up=2,down=2)
185    CALL Register_SwapField_u(flxw_dyn,flxw,distrib_physic,Request_physic,up=2,down=2)
186 
187    CALL SendRequest(Request_Physic)
188  !$OMP BARRIER
189    CALL WaitRequest(Request_Physic)       
190
191  !$OMP BARRIER
192  !$OMP MASTER
193    CALL Set_Distrib(distrib_Physic)
194    CALL VTe(VThallo)
195       
196    CALL VTb(VTphysiq)
197  !$OMP END MASTER
198  !$OMP BARRIER
199
200    CALL pression_loc (  ip1jmp1, ap, bp, ps,  p      )
201
202  !$OMP BARRIER
[2021]203    CALL exner_hyb_loc(  ip1jmp1, ps, p, pks, pk, pkf )
[1632]204  !$OMP BARRIER
205    CALL geopot_loc  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
206
207
208    CALL Register_Hallo_u(p,llmp1,2,2,2,2,Request_physic)
209    CALL Register_Hallo_u(pk,llm,2,2,2,2,Request_physic)
210    CALL Register_Hallo_u(phi,llm,2,2,2,2,Request_physic)
211       
212    CALL SendRequest(Request_Physic)
213  !$OMP BARRIER
214    CALL WaitRequest(Request_Physic)
215             
216  !$OMP BARRIER
217 
218 
219#ifdef DEBUG_IO   
220    CALL WriteField_u('ucovfi',ucov)
221    CALL WriteField_v('vcovfi',vcov)
222    CALL WriteField_u('tetafi',teta)
223    CALL WriteField_u('pfi',p)
224    CALL WriteField_u('pkfi',pk)
225    DO j=1,nqtot
226      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
227    ENDDO
228#endif
229
230  !$OMP BARRIER
231
[2239]232#ifdef CPP_PHYS
[1632]233    CALL calfis_loc(lafin ,jD_cur, jH_cur,                       &
234                     ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,   &
235                     du,dv,dteta,dq,                             &
[2221]236                     flxw, dufi,dvfi,dtetafi,dqfi,dpfi  )
[2239]237#endif
[1632]238    ijb=ij_begin
239    ije=ij_end 
240    IF ( .not. pole_nord) THEN
241 
242    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
243      DO l=1,llm
244        dufi_tmp(1:iip1,l)   = dufi(ijb:ijb+iim,l)
245        dvfi_tmp(1:iip1,l)   = dvfi(ijb:ijb+iim,l) 
246        dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 
247        dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 
248      ENDDO
249    !$OMP END DO NOWAIT
250
251    !$OMP MASTER
252      dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
253    !$OMP END MASTER
254   
255    ENDIF ! of if ( .not. pole_nord)
256
257  !$OMP BARRIER
258  !$OMP MASTER
259    CALL Set_Distrib(distrib_Physic_bis)
260    CALL VTb(VThallo)
261  !$OMP END MASTER
262  !$OMP BARRIER
263 
264    CALL Register_Hallo_u(dufi,llm,1,0,0,1,Request_physic)
265    CALL Register_Hallo_v(dvfi,llm,1,0,0,1,Request_physic)
266    CALL Register_Hallo_u(dtetafi,llm,1,0,0,1,Request_physic)
267    CALL Register_Hallo_u(dpfi,1,1,0,0,1,Request_physic)
268
269    DO j=1,nqtot
270      CALL Register_Hallo_u(dqfi(:,:,j),llm,1,0,0,1,Request_physic)
271    ENDDO
272       
273    CALL SendRequest(Request_Physic)
274  !$OMP BARRIER
275    CALL WaitRequest(Request_Physic)
276             
277  !$OMP BARRIER
278  !$OMP MASTER
279    CALL VTe(VThallo)
280    CALL Set_Distrib(distrib_Physic)
281  !$OMP END MASTER
282  !$OMP BARRIER       
283    ijb=ij_begin
284    IF (.not. pole_nord) THEN
285       
286    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
287      DO l=1,llm
288        dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
289        dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
290        dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)+dtetafi_tmp(1:iip1,l)
291        dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) + dqfi_tmp(1:iip1,l,:)
292      ENDDO
293    !$OMP END DO NOWAIT
294
295    !$OMP MASTER
296      dpfi(ijb:ijb+iim)   = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
297    !$OMP END MASTER
298         
299    endif ! of if (.not. pole_nord)
300       
301       
302#ifdef DEBUG_IO           
303    CALL WriteField_u('dufi',dufi)
304    CALL WriteField_v('dvfi',dvfi)
305    CALL WriteField_u('dtetafi',dtetafi)
306    CALL WriteField_u('dpfi',dpfi)
307    DO j=1,nqtot
308      CALL WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
309    ENDDO
310#endif
311
312  !$OMP BARRIER
313
314!      ajout des tendances physiques:
315!      ------------------------------
316#ifdef DEBUG_IO   
317    CALL WriteField_u('ucovfi',ucov)
318    CALL WriteField_v('vcovfi',vcov)
319    CALL WriteField_u('tetafi',teta)
320    CALL WriteField_u('psfi',ps)
321    DO j=1,nqtot
322      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
323    ENDDO
324#endif
325
326#ifdef DEBUG_IO           
327    CALL WriteField_u('ucovfi',ucov)
328    CALL WriteField_v('vcovfi',vcov)
329    CALL WriteField_u('tetafi',teta)
330    CALL WriteField_u('psfi',ps)
331    DO j=1,nqtot
332      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
333    ENDDO
334#endif
335
336    CALL addfi_loc( dtphys, leapf, forward   ,              &
337                    ucov, vcov, teta , q   ,ps ,            &
338                    dufi, dvfi, dtetafi , dqfi ,dpfi  )
[1987]339    ! since addfi updates ps(), also update p(), masse() and pk()
340    CALL pression_loc(ip1jmp1,ap,bp,ps,p)
341!$OMP BARRIER
342    CALL massdair_loc(p,masse)
343!$OMP BARRIER
344    if (pressure_exner) then
[2021]345      CALL exner_hyb_loc(ijnb_u,ps,p,pks,pk,pkf)
[1987]346    else
[2021]347      CALL exner_milieu_loc(ijnb_u,ps,p,pks,pk,pkf)
[1987]348    endif
349!$OMP BARRIER
[1632]350
351#ifdef DEBUG_IO   
352    CALL WriteField_u('ucovfi',ucov)
353    CALL WriteField_v('vcovfi',vcov)
354    CALL WriteField_u('tetafi',teta)
355    CALL WriteField_u('psfi',ps)
356    DO j=1,nqtot
357      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
358    ENDDO
359#endif
360
[1793]361    IF (ok_strato) THEN
362!      CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
363      CALL top_bound_loc(vcov,ucov,teta,masse,dtphys)
364    ENDIF
365
[1632]366  !$OMP BARRIER
367  !$OMP MASTER
368    CALL VTe(VTphysiq)
369    CALL VTb(VThallo)
370  !$OMP END MASTER
371
372    CALL SetTag(Request_physic,800)
373    CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_physic)
374    CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_physic)
375    CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_physic)
376    CALL Register_SwapField_u(masse,masse_dyn,distrib_caldyn,Request_physic)
377    CALL Register_SwapField_u(ps,ps_dyn,distrib_caldyn,Request_physic)
378    CALL Register_SwapField_u(q,q_dyn,distrib_caldyn,Request_physic)
379    CALL SendRequest(Request_Physic)
380  !$OMP BARRIER
381    CALL WaitRequest(Request_Physic)     
382
383  !$OMP BARRIER
384  !$OMP MASTER
385    CALL VTe(VThallo)
386    CALL set_distrib(distrib_caldyn)
387  !$OMP END MASTER
388  !$OMP BARRIER
389
390!
391!  Diagnostique de conservation de l'energie : difference
392    IF (ip_ebil_dyn.ge.1 ) THEN
393      ztit='bil phys'
[1857]394!      CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
395      write(lunout,*)"call_calfis: diagedyn disabled in dyn3dmem !!"
[1632]396    ENDIF
397
398#ifdef DEBUG_IO   
399    CALL WriteField_u('ucovfi',ucov_dyn)
400    CALL WriteField_v('vcovfi',vcov_dyn)
401    CALL WriteField_u('tetafi',teta_dyn)
402    CALL WriteField_u('psfi',ps_dyn)
403    DO j=1,nqtot
404      CALL WriteField_u('qfi'//trim(int2str(j)),q_dyn(:,:,j))
405    ENDDO
406#endif
407
408
409!-jld
410    !$OMP MASTER
411      CALL resume_timer(timer_caldyn)
412    !$OMP END MASTER
413
414  END SUBROUTINE call_calfis
415 
416END MODULE call_calfis_mod
Note: See TracBrowser for help on using the repository browser.