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

Last change on this file since 1660 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 10.7 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
39  USE parallel
40  USE dimensions
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
77  USE parallel
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) :: Request_physic
114    INTEGER :: ijb,ije,l,j
115   
116   
117#ifdef DEBUG_IO   
118    CALL WriteField_u('ucovfi',ucov)
119    CALL WriteField_v('vcovfi',vcov)
120    CALL WriteField_u('tetafi',teta)
121    CALL WriteField_u('pfi',p)
122    CALL WriteField_u('pkfi',pk)
123    DO j=1,nqtot
124      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
125    ENDDO
126#endif
127
128!
129!     .......   Ajout   P.Le Van ( 17/04/96 )   ...........
130!
131
132
133  !$OMP MASTER
134    CALL suspend_timer(timer_caldyn)
135    WRITE(lunout,*) 'leapfrog_p: Entree dans la physique : Iteration No ',itau
136  !$OMP END MASTER
137   
138    jD_cur = jD_ref + day_ini - day_ref + int (itau * dtvr / daysec)
139    jH_cur = jH_ref + (itau * dtvr / daysec - int(itau * dtvr / daysec))
140
141!   Inbterface avec les routines de phylmd (phymars ... )
142!   -----------------------------------------------------
143
144!+jld
145
146!  Diagnostique de conservation de l'energie : initialisation
147 
148!-jld
149  !$OMP BARRIER
150  !$OMP MASTER
151    CALL VTb(VThallo)
152  !$OMP END MASTER
153
154#ifdef DEBUG_IO   
155    CALL WriteField_u('ucovfi',ucov)
156    CALL WriteField_v('vcovfi',vcov)
157    CALL WriteField_u('tetafi',teta)
158    CALL WriteField_u('pfi',p)
159    CALL WriteField_u('pkfi',pk)
160#endif
161   
162    CALL SetTag(Request_physic,800)
163    CALL Register_SwapField_u(ucov_dyn,ucov,distrib_physic,Request_physic,up=2,down=2)
164    CALL Register_SwapField_v(vcov_dyn,vcov,distrib_physic,Request_physic,up=2,down=2)
165    CALL Register_SwapField_u(teta_dyn,teta,distrib_physic,Request_physic,up=2,down=2)
166    CALL Register_SwapField_u(masse_dyn,masse,distrib_physic,Request_physic,up=1,down=2)
167    CALL Register_SwapField_u(ps_dyn,ps,distrib_physic,Request_physic,up=2,down=2)
168    CALL Register_SwapField_u(phis_dyn,phis,distrib_physic,Request_physic,up=2,down=2)
169    CALL Register_SwapField_u(q_dyn,q,distrib_physic,Request_physic,up=2,down=2)
170    CALL Register_SwapField_u(flxw_dyn,flxw,distrib_physic,Request_physic,up=2,down=2)
171 
172    CALL SendRequest(Request_Physic)
173  !$OMP BARRIER
174    CALL WaitRequest(Request_Physic)       
175
176  !$OMP BARRIER
177  !$OMP MASTER
178    CALL Set_Distrib(distrib_Physic)
179    CALL VTe(VThallo)
180       
181    CALL VTb(VTphysiq)
182  !$OMP END MASTER
183  !$OMP BARRIER
184
185    CALL pression_loc (  ip1jmp1, ap, bp, ps,  p      )
186
187  !$OMP BARRIER
188    CALL exner_hyb_loc(  ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
189  !$OMP BARRIER
190    CALL geopot_loc  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
191
192
193    CALL Register_Hallo_u(p,llmp1,2,2,2,2,Request_physic)
194    CALL Register_Hallo_u(pk,llm,2,2,2,2,Request_physic)
195    CALL Register_Hallo_u(phi,llm,2,2,2,2,Request_physic)
196       
197    CALL SendRequest(Request_Physic)
198  !$OMP BARRIER
199    CALL WaitRequest(Request_Physic)
200             
201  !$OMP BARRIER
202 
203 
204#ifdef DEBUG_IO   
205    CALL WriteField_u('ucovfi',ucov)
206    CALL WriteField_v('vcovfi',vcov)
207    CALL WriteField_u('tetafi',teta)
208    CALL WriteField_u('pfi',p)
209    CALL WriteField_u('pkfi',pk)
210    DO j=1,nqtot
211      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
212    ENDDO
213#endif
214
215  !$OMP BARRIER
216
217    CALL calfis_loc(lafin ,jD_cur, jH_cur,                       &
218                     ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,   &
219                     du,dv,dteta,dq,                             &
220                     flxw,                                       &
221                     clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
222
223    ijb=ij_begin
224    ije=ij_end 
225    IF ( .not. pole_nord) THEN
226 
227    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
228      DO l=1,llm
229        dufi_tmp(1:iip1,l)   = dufi(ijb:ijb+iim,l)
230        dvfi_tmp(1:iip1,l)   = dvfi(ijb:ijb+iim,l) 
231        dtetafi_tmp(1:iip1,l)= dtetafi(ijb:ijb+iim,l) 
232        dqfi_tmp(1:iip1,l,:) = dqfi(ijb:ijb+iim,l,:) 
233      ENDDO
234    !$OMP END DO NOWAIT
235
236    !$OMP MASTER
237      dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
238    !$OMP END MASTER
239   
240    ENDIF ! of if ( .not. pole_nord)
241
242  !$OMP BARRIER
243  !$OMP MASTER
244    CALL Set_Distrib(distrib_Physic_bis)
245    CALL VTb(VThallo)
246  !$OMP END MASTER
247  !$OMP BARRIER
248 
249    CALL Register_Hallo_u(dufi,llm,1,0,0,1,Request_physic)
250    CALL Register_Hallo_v(dvfi,llm,1,0,0,1,Request_physic)
251    CALL Register_Hallo_u(dtetafi,llm,1,0,0,1,Request_physic)
252    CALL Register_Hallo_u(dpfi,1,1,0,0,1,Request_physic)
253
254    DO j=1,nqtot
255      CALL Register_Hallo_u(dqfi(:,:,j),llm,1,0,0,1,Request_physic)
256    ENDDO
257       
258    CALL SendRequest(Request_Physic)
259  !$OMP BARRIER
260    CALL WaitRequest(Request_Physic)
261             
262  !$OMP BARRIER
263  !$OMP MASTER
264    CALL VTe(VThallo)
265    CALL Set_Distrib(distrib_Physic)
266  !$OMP END MASTER
267  !$OMP BARRIER       
268    ijb=ij_begin
269    IF (.not. pole_nord) THEN
270       
271    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
272      DO l=1,llm
273        dufi(ijb:ijb+iim,l) = dufi(ijb:ijb+iim,l)+dufi_tmp(1:iip1,l)
274        dvfi(ijb:ijb+iim,l) = dvfi(ijb:ijb+iim,l)+dvfi_tmp(1:iip1,l)
275        dtetafi(ijb:ijb+iim,l) = dtetafi(ijb:ijb+iim,l)+dtetafi_tmp(1:iip1,l)
276        dqfi(ijb:ijb+iim,l,:) = dqfi(ijb:ijb+iim,l,:) + dqfi_tmp(1:iip1,l,:)
277      ENDDO
278    !$OMP END DO NOWAIT
279
280    !$OMP MASTER
281      dpfi(ijb:ijb+iim)   = dpfi(ijb:ijb+iim)+ dpfi_tmp(1:iip1)
282    !$OMP END MASTER
283         
284    endif ! of if (.not. pole_nord)
285       
286       
287#ifdef DEBUG_IO           
288    CALL WriteField_u('dufi',dufi)
289    CALL WriteField_v('dvfi',dvfi)
290    CALL WriteField_u('dtetafi',dtetafi)
291    CALL WriteField_u('dpfi',dpfi)
292    DO j=1,nqtot
293      CALL WriteField_u('dqfi'//trim(int2str(j)),dqfi(:,:,j))
294    ENDDO
295#endif
296
297  !$OMP BARRIER
298
299!      ajout des tendances physiques:
300!      ------------------------------
301#ifdef DEBUG_IO   
302    CALL WriteField_u('ucovfi',ucov)
303    CALL WriteField_v('vcovfi',vcov)
304    CALL WriteField_u('tetafi',teta)
305    CALL WriteField_u('psfi',ps)
306    DO j=1,nqtot
307      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
308    ENDDO
309#endif
310
311    IF (ok_strato) THEN
312      CALL top_bound_loc( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
313    ENDIF
314
315#ifdef DEBUG_IO           
316    CALL WriteField_u('ucovfi',ucov)
317    CALL WriteField_v('vcovfi',vcov)
318    CALL WriteField_u('tetafi',teta)
319    CALL WriteField_u('psfi',ps)
320    DO j=1,nqtot
321      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
322    ENDDO
323#endif
324
325    CALL addfi_loc( dtphys, leapf, forward   ,              &
326                    ucov, vcov, teta , q   ,ps ,            &
327                    dufi, dvfi, dtetafi , dqfi ,dpfi  )
328
329#ifdef DEBUG_IO   
330    CALL WriteField_u('ucovfi',ucov)
331    CALL WriteField_v('vcovfi',vcov)
332    CALL WriteField_u('tetafi',teta)
333    CALL WriteField_u('psfi',ps)
334    DO j=1,nqtot
335      CALL WriteField_u('qfi'//trim(int2str(j)),q(:,:,j))
336    ENDDO
337#endif
338
339  !$OMP BARRIER
340  !$OMP MASTER
341    CALL VTe(VTphysiq)
342    CALL VTb(VThallo)
343  !$OMP END MASTER
344
345    CALL SetTag(Request_physic,800)
346    CALL Register_SwapField_u(ucov,ucov_dyn,distrib_caldyn,Request_physic)
347    CALL Register_SwapField_v(vcov,vcov_dyn,distrib_caldyn,Request_physic)
348    CALL Register_SwapField_u(teta,teta_dyn,distrib_caldyn,Request_physic)
349    CALL Register_SwapField_u(masse,masse_dyn,distrib_caldyn,Request_physic)
350    CALL Register_SwapField_u(ps,ps_dyn,distrib_caldyn,Request_physic)
351    CALL Register_SwapField_u(q,q_dyn,distrib_caldyn,Request_physic)
352    CALL SendRequest(Request_Physic)
353  !$OMP BARRIER
354    CALL WaitRequest(Request_Physic)     
355
356  !$OMP BARRIER
357  !$OMP MASTER
358    CALL VTe(VThallo)
359    CALL set_distrib(distrib_caldyn)
360  !$OMP END MASTER
361  !$OMP BARRIER
362
363!
364!  Diagnostique de conservation de l'energie : difference
365    IF (ip_ebil_dyn.ge.1 ) THEN
366      ztit='bil phys'
367      CALL diagedyn(ztit,2,1,1,dtphys,ucov, vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
368    ENDIF
369
370#ifdef DEBUG_IO   
371    CALL WriteField_u('ucovfi',ucov_dyn)
372    CALL WriteField_v('vcovfi',vcov_dyn)
373    CALL WriteField_u('tetafi',teta_dyn)
374    CALL WriteField_u('psfi',ps_dyn)
375    DO j=1,nqtot
376      CALL WriteField_u('qfi'//trim(int2str(j)),q_dyn(:,:,j))
377    ENDDO
378#endif
379
380
381!-jld
382    !$OMP MASTER
383      CALL resume_timer(timer_caldyn)
384    !$OMP END MASTER
385
386  END SUBROUTINE call_calfis
387 
388END MODULE call_calfis_mod
Note: See TracBrowser for help on using the repository browser.