source: codes/icosagcm/trunk/src/caldyn_wave.f90 @ 15

Last change on this file since 15 was 12, checked in by ymipsl, 12 years ago

dynamico tree creation

YM
File size: 3.2 KB
Line 
1MODULE caldyn_wave_mod
2  USE genmod
3  USE field_mod
4 
5 
6CONTAINS
7
8  SUBROUTINE allocate_caldyn
9  IMPLICIT NONE
10   
11  END SUBROUTINE allocate_caldyn
12
13  SUBROUTINE swap_caldyn(ind)
14  IMPLICIT NONE
15    INTEGER,INTENT(IN) :: ind
16   
17     
18  END SUBROUTINE swap_caldyn
19
20  SUBROUTINE init_wave(hi,ue)
21  USE domain_mod
22  USE dimensions
23  USE geometry
24  USE metric
25  USE spherical_geom_mod
26  IMPLICIT NONE
27    REAL(rstd),INTENT(OUT) :: hi(iim*jjm)
28    REAL(rstd),INTENT(OUT) :: ue(iim*3*jjm)
29    REAL(rstd) :: lon, lat,X0(3)
30    INTEGER :: i,j,n
31
32    lon=Pi/4
33    lat=Pi/2-Pi/8
34    CALL lonlat2xyz(lon,lat,X0)
35
36    DO j=jj_begin,jj_end
37      DO i=ii_begin,ii_end
38        n=(j-1)*iim+i
39        hi(n)=exp(-128.*sum((xyz_i(n,:)-X0(:))**2))
40
41        ue(n+u_right)=0
42        ue(n+u_lup)=0
43        ue(n+u_ldown)=0
44      ENDDO
45    ENDDO
46   
47  END SUBROUTINE init_wave
48
49
50  SUBROUTINE caldyn(f_h, f_u, f_dh, f_du)
51  USE domain_mod
52  USE dimensions
53  USE grid_param
54  USE geometry
55  USE metric
56  USE write_field
57  IMPLICIT NONE
58  TYPE(t_field),POINTER :: f_h(:)
59  TYPE(t_field),POINTER :: f_u(:)
60  TYPE(t_field),POINTER :: f_dh(:)
61  TYPE(t_field),POINTER :: f_du(:)
62
63  REAL(rstd),POINTER :: h(:)
64  REAL(rstd),POINTER :: u(:)
65  REAL(rstd),POINTER :: dh(:)
66  REAL(rstd),POINTER :: du(:)
67  INTEGER :: ind
68  INTEGER,SAVE :: it=0
69 
70    CALL transfert_request(f_h,req_i1) 
71    CALL transfert_request(f_u,req_e1)
72    CALL transfert_request(f_u,req_e1) 
73   
74
75    DO ind=1,ndomain
76      CALL swap_dimensions(ind)
77      CALL swap_geometry(ind)
78      CALL swap_caldyn(ind)
79     
80      h=f_h(ind)
81      u=f_u(ind)
82      dh=f_dh(ind)
83      du=f_du(ind)
84     
85      CALL compute_caldyn(h, u, dh, du)
86
87    ENDDO
88
89    IF (mod(it,240)==0) THEN
90      CALL writefield("h",f_h)
91      CALL writefield("dh",f_dh)
92      CALL Compute_enstrophy
93    ENDIF
94    it=it+1     
95  END SUBROUTINE caldyn
96
97
98  SUBROUTINE compute_caldyn(hi,ue,dhi,due)
99  USE domain_mod
100  USE dimensions
101  USE geometry
102  USE metric
103 
104  IMPLICIT NONE
105    REAL(rstd),INTENT(IN) :: hi(iim*jjm)
106    REAL(rstd),INTENT(IN) :: ue(iim*3*jjm)
107    REAL(rstd),INTENT(OUT) :: dhi(iim*jjm)
108    REAL(rstd),INTENT(OUT) :: due(iim*3*jjm)
109   
110    INTEGER :: i,j,n
111   
112   
113    DO j=jj_begin,jj_end
114      DO i=ii_begin,ii_end
115
116        n=(j-1)*iim+i
117
118        dhi(n)=-1./Ai(n)*(ne(n,right)*ue(n+u_right)*le(n+u_right)  +  &
119                          ne(n,rup)*ue(n+u_rup)*le(n+u_rup)        +  & 
120                          ne(n,lup)*ue(n+u_lup)*le(n+u_lup)        +  & 
121                          ne(n,left)*ue(n+u_left)*le(n+u_left)     +  & 
122                          ne(n,ldown)*ue(n+u_ldown)*le(n+u_ldown)  +  & 
123                          ne(n,rdown)*ue(n+u_rdown)*le(n+u_rdown))   
124     
125      ENDDO
126    ENDDO
127   
128    DO j=jj_begin,jj_end
129      DO i=ii_begin,ii_end
130        n=(j-1)*iim+i
131       
132        due(n+u_right)=1/de(n+u_right)*(ne(n,right)*hi(n)+ ne(n+t_right,left)*hi(n+t_right) )       
133   
134        due(n+u_lup)=1/de(n+u_lup)*(ne(n,lup)*hi(n)+ ne(n+t_lup,rdown)*hi(n+t_lup ))       
135   
136        due(n+u_ldown)=1/de(n+u_ldown)*(ne(n,ldown)*hi(n)+ne(n+t_ldown,rup)*hi(n+t_ldown) )
137
138
139               
140      ENDDO
141    ENDDO
142   
143                                                                     
144   END SUBROUTINE compute_caldyn
145   
146   
147END MODULE caldyn_wave_mod
Note: See TracBrowser for help on using the repository browser.