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

Last change on this file since 155 was 146, checked in by ymipsl, 11 years ago

Set constant sign for wind way :
ne(ij,right)==ne_right=1
ne(ij,rup)==ne_rup=-1
ne(ij,lup)==ne_lup=1
ne(ij,left)==ne_left=-1
ne(ij,ldown)==ne_ldown=1
ne(ij,rdown)==ne_rdown=-1

Modified transfert function to be compliant for this convention.

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