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

Last change on this file since 2021 was 2021, checked in by lguez, 10 years ago

Removed unused variables pks, pk, pkf from main program unit gcm.

Encapsulated procedures exner_hyb, exner_hyb_p, exner_hyb_loc,
exner_milieu, exner_milieu_p and exner_milieu_loc into
modules. (Compulsory to allow optional arguments.)

In the procedures exner_hyb, exner_hyb_p, exner_hyb_loc, donwgraded
arguments alpha and beta to local variables. In exner_milieu,
exner_milieu_p and exner_milieu_loc, removed beta altogether. In the
six procedures exner_*, made pkf an optional argument. Made some
cosmetic modifications in order to keep the six procedures exner_* as
close as possible.

In the six procedures exner_*, removed the averaging of pks at the
poles: this is not useful because ps is already the same at all
longitudes at the poles. This modification changes the results of the
program. Motivation: had to do this for exner_hyb because we call it
from test_disvert with a few surface pressure values.

In all the procedures calling exner_*, removed the variables alpha and
beta. Also removed variables alpha and beta from module leapfrog_mod
and from module call_calfis_mod.

Removed actual argument pkf in call to exner_hyb* and exner_milieu*
from guide_interp, guide_main, iniacademic and iniacademic_loc (pkf
was not used in those procedures).

Argument workvar of startget_dyn is used only if varname is tpot or

  1. When varname is tpot or q, the actual argument associated to

workvar in etat0_netcdf is not y. So y in etat0_netcdf is a
place-holder, never used. So we remove optional argument y in the
calls to exner_hyb and exner_milieu from etat0_netcdf.

Created procedure test_disvert, called only by etat0_netcdf. This
procedure tests the order of pressure values at half-levels and full
levels.
  • 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: 11.9 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 :: 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
36  USE allocate_field_mod
37  USE parallel_lmdz
38  USE dimensions_mod
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)
54    CALL allocate_u(pk,llm,d)
55    CALL allocate_u(pkf,llm,d)
56    CALL allocate_u(phi,llm,d)
57    CALL allocate_u(du,llm,d)
58    CALL allocate_v(dv,llm,d)
59    CALL allocate_u(dteta,llm,d)
60    CALL allocate_u(dq,llm,nqtot,d)
61    CALL allocate_u(dufi,llm,d)
62    CALL allocate_v(dvfi,llm,d)
63    CALL allocate_u(dtetafi,llm,d)
64    CALL allocate_u(dqfi,llm,nqtot,d)
65    CALL allocate_u(dpfi,d)
66 
67  END SUBROUTINE call_calfis_allocate
68 
69 
70  SUBROUTINE call_calfis(itau,lafin,clesphy0,ucov_dyn,vcov_dyn,teta_dyn,masse_dyn,ps_dyn, &
71                         phis_dyn,q_dyn,flxw_dyn)
72  USE dimensions_mod
73  use exner_hyb_loc_m, only: exner_hyb_loc
74  use exner_milieu_loc_m, only: exner_milieu_loc
75  USE parallel_lmdz
76  USE times
77  USE mod_hallo
78  USE Bands
79  USE vampir
80  USE infotrac
81  USE control_mod
82  USE write_field_loc
83  USE write_field
84  IMPLICIT NONE
85    INCLUDE "comconst.h"
86    INCLUDE "comvert.h"
87    INCLUDE "logic.h"
88    INCLUDE "temps.h"
89    INCLUDE "iniprint.h"
90
91    INTEGER,INTENT(IN) :: itau ! (time) iteration step number
92    LOGICAL,INTENT(IN) :: lafin ! .true. if final time step
93    REAL,INTENT(IN) :: clesphy0( : ) ! not used   
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) ! potential temperature
97    REAL,INTENT(INOUT) :: masse_dyn(ijb_u:ije_u,llm) ! air mass
98    REAL,INTENT(INOUT) :: ps_dyn(ijb_u:ije_u) ! surface pressure
99    REAL,INTENT(INOUT) :: phis_dyn(ijb_u:ije_u) ! surface geopotential
100    REAL,INTENT(INOUT) :: q_dyn(ijb_u:ije_u,llm,nqtot) ! advected tracers
101    REAL,INTENT(INOUT) :: flxw_dyn(ijb_u:ije_u,llm) ! vertical mass flux
102
103    REAL :: dufi_tmp(iip1,llm)   
104    REAL :: dvfi_tmp(iip1,llm) 
105    REAL :: dtetafi_tmp(iip1,llm)
106    REAL :: dpfi_tmp(iip1)
107    REAL :: dqfi_tmp(iip1,llm,nqtot)
108
109    REAL :: jD_cur, jH_cur
110    CHARACTER(LEN=15) :: ztit
111    TYPE(Request),SAVE :: Request_physic
112!$OMP THREADPRIVATE(Request_physic )
113    INTEGER :: ijb,ije,l,j
114   
115   
116#ifdef DEBUG_IO   
117    CALL WriteField_u('ucovfi',ucov)
118    CALL WriteField_v('vcovfi',vcov)
119    CALL WriteField_u('tetafi',teta)
120    CALL WriteField_u('pfi',p)
121    CALL WriteField_u('pkfi',pk)
122    DO j=1,nqtot
123      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
124    ENDDO
125#endif
126
127!
128!     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
129!
130
131
132  !$OMP MASTER
133    CALL suspend_timer(timer_caldyn)
134    IF (prt_level >= 10) THEN
135      WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
136    ENDIF
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, 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    ! since addfi updates ps(), also update p(), masse() and pk()
338    CALL pression_loc(ip1jmp1,ap,bp,ps,p)
339!$OMP BARRIER
340    CALL massdair_loc(p,masse)
341!$OMP BARRIER
342    if (pressure_exner) then
343      CALL exner_hyb_loc(ijnb_u,ps,p,pks,pk,pkf)
344    else
345      CALL exner_milieu_loc(ijnb_u,ps,p,pks,pk,pkf)
346    endif
347!$OMP BARRIER
348
349#ifdef DEBUG_IO   
350    CALL WriteField_u('ucovfi',ucov)
351    CALL WriteField_v('vcovfi',vcov)
352    CALL WriteField_u('tetafi',teta)
353    CALL WriteField_u('psfi',ps)
354    DO j=1,nqtot
355      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
356    ENDDO
357#endif
358
359    IF (ok_strato) THEN
360!      CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
361      CALL top_bound_loc(vcov,ucov,teta,masse,dtphys)
362    ENDIF
363
364  !$OMP BARRIER
365  !$OMP MASTER
366    CALL VTe(VTphysiq)
367    CALL VTb(VThallo)
368  !$OMP END MASTER
369
370    CALL SetTag(Request_physic,800)
371    CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_physic)
372    CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_physic)
373    CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_physic)
374    CALL Register_SwapField_u(masse,masse_dyn,distrib_caldyn,Request_physic)
375    CALL Register_SwapField_u(ps,ps_dyn,distrib_caldyn,Request_physic)
376    CALL Register_SwapField_u(q,q_dyn,distrib_caldyn,Request_physic)
377    CALL SendRequest(Request_Physic)
378  !$OMP BARRIER
379    CALL WaitRequest(Request_Physic)     
380
381  !$OMP BARRIER
382  !$OMP MASTER
383    CALL VTe(VThallo)
384    CALL set_distrib(distrib_caldyn)
385  !$OMP END MASTER
386  !$OMP BARRIER
387
388!
389!  Diagnostique de conservation de l'energie : difference
390    IF (ip_ebil_dyn.ge.1 ) THEN
391      ztit='bil phys'
392!      CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
393      write(lunout,*)"call_calfis: diagedyn disabled in dyn3dmem !!"
394    ENDIF
395
396#ifdef DEBUG_IO   
397    CALL WriteField_u('ucovfi',ucov_dyn)
398    CALL WriteField_v('vcovfi',vcov_dyn)
399    CALL WriteField_u('tetafi',teta_dyn)
400    CALL WriteField_u('psfi',ps_dyn)
401    DO j=1,nqtot
402      CALL WriteField_u('qfi'//trim(int2str(j)),q_dyn(:,:,j))
403    ENDDO
404#endif
405
406
407!-jld
408    !$OMP MASTER
409      CALL resume_timer(timer_caldyn)
410    !$OMP END MASTER
411
412  END SUBROUTINE call_calfis
413 
414END MODULE call_calfis_mod
Note: See TracBrowser for help on using the repository browser.