source: codes/icosagcm/devel/src/dynamics/caldyn_hevi.f90 @ 854

Last change on this file since 854 was 854, checked in by jisesh, 5 years ago

devel: separate module for compute_caldyn_fast and removed nu duplication in it
File size: 6.9 KB
Line 
1MODULE caldyn_hevi_mod
2  USE icosa
3  USE transfert_mod
4  USE caldyn_vars_mod
5  USE caldyn_kernels_hevi_mod
6  USE caldyn_kernels_base_mod
7  USE compute_theta_mod, ONLY : compute_theta
8  USE compute_caldyn_kv_mod, ONLY : compute_caldyn_kv
9  USE compute_caldyn_Coriolis_mod, ONLY : compute_caldyn_Coriolis
10  USE compute_caldyn_slow_hydro_mod, ONLY : compute_caldyn_slow_hydro
11  USE compute_caldyn_slow_NH_mod, ONLY : compute_caldyn_slow_NH
12  USE compute_caldyn_solver_mod, ONLY : compute_caldyn_solver
13  USE compute_caldyn_fast_mod, ONLY : compute_caldyn_fast
14  IMPLICIT NONE
15  PRIVATE
16  PUBLIC caldyn_hevi
17
18CONTAINS
19 
20  SUBROUTINE caldyn_hevi(write_out,tau, f_phis, f_ps, f_mass, f_theta_rhodz, f_u, f_q, &
21       f_W, f_geopot, f_hflux, f_wflux, f_dps, f_dmass, f_dtheta_rhodz, &
22       f_du_slow, f_du_fast, f_dPhi_slow, f_dPhi_fast, f_dW_slow, f_dW_fast) 
23    USE icosa
24    USE observable_mod
25    USE disvert_mod, ONLY : caldyn_eta, eta_mass
26    USE vorticity_mod
27    USE kinetic_mod
28    USE theta2theta_rhodz_mod
29    USE wind_mod
30    USE mpipara
31    USE trace
32    USE omp_para
33    USE output_field_mod
34    USE checksum_mod
35    USE compute_mod, ONLY : compute_pvort_only
36    IMPLICIT NONE
37    LOGICAL,INTENT(IN)    :: write_out
38    REAL(rstd), INTENT(IN) :: tau
39    TYPE(t_field),POINTER :: f_phis(:)
40    TYPE(t_field),POINTER :: f_ps(:)
41    TYPE(t_field),POINTER :: f_mass(:)
42    TYPE(t_field),POINTER :: f_theta_rhodz(:)
43    TYPE(t_field),POINTER :: f_u(:)
44    TYPE(t_field),POINTER :: f_q(:)
45    TYPE(t_field),POINTER :: f_W(:)
46    TYPE(t_field),POINTER :: f_geopot(:)
47    TYPE(t_field),POINTER :: f_hflux(:), f_wflux(:)
48    TYPE(t_field) :: f_dps(:)
49    TYPE(t_field) :: f_dmass(:)
50    TYPE(t_field) :: f_dtheta_rhodz(:)
51    TYPE(t_field) :: f_du_slow(:)
52    TYPE(t_field) :: f_du_fast(:)
53    TYPE(t_field) :: f_dW_slow(:)
54    TYPE(t_field) :: f_dW_fast(:)
55    TYPE(t_field) :: f_dPhi_slow(:)
56    TYPE(t_field) :: f_dPhi_fast(:)
57   
58    REAL(rstd),POINTER :: ps(:), dps(:), phis(:)
59    REAL(rstd),POINTER :: mass(:,:), theta_rhodz(:,:,:), dtheta_rhodz(:,:,:)
60    REAL(rstd),POINTER :: du(:,:), dW(:,:), dPhi(:,:), hflux(:,:), wflux(:,:)
61    REAL(rstd),POINTER :: u(:,:), w(:,:), qu(:,:), qv(:,:), Kv(:,:), hv(:,:)
62
63! temporary shared variable
64    REAL(rstd),POINTER  :: theta(:,:,:) 
65    REAL(rstd),POINTER  :: pk(:,:)
66    REAL(rstd),POINTER  :: geopot(:,:)
67    REAL(rstd),POINTER  :: convm(:,:) 
68    REAL(rstd),POINTER  :: wwuu(:,:)
69    REAL(rstd),POINTER  :: F_el(:,:), gradPhi2(:,:), w_il(:,:) , W_etadot(:,:), pres(:,:), m_il(:,:)
70    INTEGER :: ind
71    LOGICAL,SAVE :: first=.TRUE.
72!$OMP THREADPRIVATE(first)
73   
74    IF (first) THEN
75      first=.FALSE.
76      IF(caldyn_eta==eta_mass) THEN
77         CALL init_message(f_ps,req_i1,req_ps)
78      ELSE
79         CALL init_message(f_mass,req_i1,req_mass)
80      END IF
81      CALL init_message(f_theta_rhodz,req_i1,req_theta_rhodz)
82      CALL init_message(f_u,req_e1_vect,req_u)
83      CALL init_message(f_qu,req_e1_scal,req_qu)
84      IF(caldyn_kinetic==kinetic_consistent) CALL init_message(f_Kv,req_z1_scal,req_Kv)
85      IF(.NOT.hydrostatic) THEN
86         CALL init_message(f_geopot,req_i1,req_geopot)
87         CALL init_message(f_w,req_i1,req_w)
88      END IF
89    ENDIF
90   
91    CALL trace_start("caldyn")
92   
93    IF(caldyn_eta==eta_mass) THEN
94       CALL send_message(f_ps,req_ps) ! COM00
95       CALL wait_message(req_ps) ! COM00
96    ELSE
97       CALL send_message(f_mass,req_mass) ! COM00
98       CALL wait_message(req_mass) ! COM00
99    END IF
100    CALL send_message(f_theta_rhodz,req_theta_rhodz) ! COM01
101    CALL wait_message(req_theta_rhodz) ! COM01 Moved from caldyn_pvort
102
103    IF(.NOT.hydrostatic) THEN
104       CALL send_message(f_geopot,req_geopot) ! COM03
105       CALL wait_message(req_geopot) ! COM03
106       CALL send_message(f_w,req_w) ! COM04
107       CALL wait_message(req_w) ! COM04
108    END IF
109   
110    DO ind=1,ndomain
111       IF (.NOT. assigned_domain(ind)) CYCLE
112       CALL swap_dimensions(ind)
113       CALL swap_geometry(ind)
114       ps=f_ps(ind)
115       theta_rhodz=f_theta_rhodz(ind)
116       mass=f_mass(ind)
117       theta = f_theta(ind)
118       CALL compute_theta(ps,theta_rhodz, mass,theta)
119       pk = f_pk(ind)
120       geopot = f_geopot(ind)
121       du=f_du_fast(ind)
122       IF(hydrostatic) THEN
123          du(:,:)=0.
124          CALL compute_geopot(mass,theta, ps,pk,geopot)
125       ELSE
126          phis = f_phis(ind)
127          W = f_W(ind)
128          dW = f_dW_fast(ind)
129          dPhi = f_dPhi_fast(ind)
130          ! reuse buffers
131          m_il = f_wil(ind)
132          pres = f_gradPhi2(ind)
133          CALL compute_caldyn_solver(tau,phis, mass,theta,pk,geopot,W, m_il,pres, dPhi,dW,du) ! computes d(Phi,W,du)_fast and updates Phi,W
134       END IF
135       u=f_u(ind)
136       CALL compute_caldyn_fast(tau,u,mass,theta,pk,geopot,du) ! computes du_fast and updates u
137    ENDDO
138   
139    CALL send_message(f_u,req_u) ! COM02
140    CALL wait_message(req_u)   ! COM02
141   
142    DO ind=1,ndomain
143       IF (.NOT. assigned_domain(ind)) CYCLE
144       CALL swap_dimensions(ind)
145       CALL swap_geometry(ind)
146       u=f_u(ind)
147       mass=f_mass(ind)
148       qu=f_qu(ind)
149       qv=f_qv(ind)
150       hv=f_hv(ind)
151       CALL compute_pvort_only(u,mass,qu,qv,hv)
152       IF(caldyn_kinetic==kinetic_consistent) THEN
153          Kv=f_Kv(ind)
154          CALL compute_caldyn_Kv(u,Kv)
155       END IF
156    ENDDO
157   
158    CALL send_message(f_qu,req_qu) ! COM03
159    CALL wait_message(req_qu) ! COM03
160
161    IF(caldyn_kinetic==kinetic_consistent) THEN
162       CALL transfert_request(f_hv,req_z1_scal)
163       CALL send_message(f_Kv,req_Kv)
164       CALL wait_message(req_Kv)
165    END IF
166
167    DO ind=1,ndomain
168       IF (.NOT. assigned_domain(ind)) CYCLE
169       CALL swap_dimensions(ind)
170       CALL swap_geometry(ind)
171       u=f_u(ind)
172       mass=f_mass(ind)
173       theta = f_theta(ind)
174       qu=f_qu(ind)
175       hflux=f_hflux(ind)
176       convm = f_dmass(ind)
177       dtheta_rhodz=f_dtheta_rhodz(ind)
178       du=f_du_slow(ind)
179
180       IF(hydrostatic) THEN
181          hv=f_hv(ind)
182          Kv=f_Kv(ind)
183          CALL compute_caldyn_slow_hydro(u,mass,hv, hflux,Kv,du, .TRUE.)
184       ELSE
185          W = f_W(ind)
186          dW = f_dW_slow(ind)
187          geopot = f_geopot(ind)
188          dPhi = f_dPhi_slow(ind)
189          F_el = f_Fel(ind)
190          gradPhi2 = f_gradPhi2(ind)
191          w_il = f_wil(ind)
192          CALL compute_caldyn_slow_NH(u,mass,geopot,W, F_el,gradPhi2,w_il, hflux,du,dPhi,dW)
193       END IF
194       CALL compute_caldyn_Coriolis(hflux,theta,qu, convm,dtheta_rhodz,du)
195       IF(caldyn_eta==eta_mass) THEN
196          wflux=f_wflux(ind)
197          wwuu=f_wwuu(ind)
198          dps=f_dps(ind)
199          CALL compute_caldyn_vert(u,theta,mass,convm, wflux,wwuu, dps, dtheta_rhodz, du)
200          IF(.NOT.hydrostatic) THEN
201             W_etadot=f_Wetadot(ind)
202             CALL compute_caldyn_vert_NH(mass,geopot,W,wflux, W_etadot, du,dPhi,dW)
203          END IF
204       END IF
205    ENDDO
206   
207!$OMP BARRIER
208    !    CALL check_mass_conservation(f_ps,f_dps)
209    CALL trace_end("caldyn_hevi")
210!!$OMP BARRIER
211   
212  END SUBROUTINE caldyn_hevi
213
214END MODULE caldyn_hevi_mod
Note: See TracBrowser for help on using the repository browser.