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

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

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