1 | MODULE kinetic_mod |
---|
2 | |
---|
3 | |
---|
4 | CONTAINS |
---|
5 | |
---|
6 | SUBROUTINE kinetic(f_ue,f_Ki) |
---|
7 | USE transfert_mod |
---|
8 | USE field_mod |
---|
9 | USE dimensions |
---|
10 | USE geometry |
---|
11 | USE domain_mod |
---|
12 | IMPLICIT NONE |
---|
13 | TYPE(t_field), POINTER :: f_ue(:) |
---|
14 | TYPE(t_field), POINTER :: f_Ki(:) |
---|
15 | |
---|
16 | REAL(rstd), POINTER :: ue(:,:) |
---|
17 | REAL(rstd), POINTER :: Ki(:,:) |
---|
18 | INTEGER :: ind |
---|
19 | |
---|
20 | CALL transfert_request(f_ue,req_e1) |
---|
21 | CALL transfert_request(f_ue,req_e1) |
---|
22 | |
---|
23 | DO ind=1,ndomain |
---|
24 | CALL swap_dimensions(ind) |
---|
25 | CALL swap_geometry(ind) |
---|
26 | ue=f_ue(ind) |
---|
27 | Ki=f_Ki(ind) |
---|
28 | CALL compute_kinetic(ue, Ki) |
---|
29 | ENDDO |
---|
30 | |
---|
31 | END SUBROUTINE kinetic |
---|
32 | |
---|
33 | SUBROUTINE compute_kinetic(ue, Ki) |
---|
34 | USE dimensions |
---|
35 | USE geometry |
---|
36 | USE metric |
---|
37 | IMPLICIT NONE |
---|
38 | REAL(rstd),INTENT(IN) :: ue(3*iim*jjm,llm) |
---|
39 | REAL(rstd),INTENT(OUT) :: Ki(iim*jjm,llm) |
---|
40 | INTEGER :: i,j,ij,l |
---|
41 | |
---|
42 | DO l=1,llm |
---|
43 | DO j=jj_begin,jj_end |
---|
44 | DO i=ii_begin,ii_end |
---|
45 | ij=(j-1)*iim+i |
---|
46 | |
---|
47 | Ki(ij,l)=1/(4*Ai(ij))*(le(ij+u_right)*de(ij+u_right)*ue(ij+u_right,l)**2 + & |
---|
48 | le(ij+u_rup)*de(ij+u_rup)*ue(ij+u_rup,l)**2 + & |
---|
49 | le(ij+u_lup)*de(ij+u_lup)*ue(ij+u_lup,l)**2 + & |
---|
50 | le(ij+u_left)*de(ij+u_left)*ue(ij+u_left,l)**2 + & |
---|
51 | le(ij+u_ldown)*de(ij+u_ldown)*ue(ij+u_ldown,l)**2 + & |
---|
52 | le(ij+u_rdown)*de(ij+u_rdown)*ue(ij+u_rdown,l)**2 ) |
---|
53 | |
---|
54 | ENDDO |
---|
55 | ENDDO |
---|
56 | ENDDO |
---|
57 | |
---|
58 | |
---|
59 | END SUBROUTINE compute_kinetic |
---|
60 | |
---|
61 | END MODULE kinetic_mod |
---|