source: codes/icosagcm/trunk/src/exner.f90 @ 31

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

Simplify the management of the module.

YM
File size: 2.4 KB
Line 
1MODULE exner_mod
2
3CONTAINS
4
5  SUBROUTINE exner(f_ps,f_p,f_pks,f_pk)
6  USE icosa
7  IMPLICIT NONE
8    TYPE(t_field), POINTER :: f_ps(:)
9    TYPE(t_field), POINTER :: f_p(:)
10    TYPE(t_field), POINTER :: f_pks(:)
11    TYPE(t_field), POINTER :: f_pk(:)
12 
13    REAL(rstd), POINTER :: ps(:)
14    REAL(rstd), POINTER :: p(:,:)
15    REAL(rstd), POINTER :: pks(:)
16    REAL(rstd), POINTER :: pk(:,:)
17    INTEGER :: ind
18
19    DO ind=1,ndomain
20      CALL swap_dimensions(ind)
21      CALL swap_geometry(ind)
22      ps=f_ps(ind)
23      p=f_p(ind)
24      pks=f_pks(ind)
25      pk=f_pk(ind)
26      CALL compute_exner(ps, p, pks, pk, 0)
27    ENDDO
28 
29  END SUBROUTINE exner
30 
31  SUBROUTINE compute_exner(ps,p,pks,pk,offset)
32  USE icosa
33  USE disvert_mod
34  USE pression_mod
35  IMPLICIT NONE
36    REAL(rstd),INTENT(IN) :: ps(iim*jjm)
37    REAL(rstd),INTENT(IN) :: p(iim*jjm,llm+1)
38    REAL(rstd),INTENT(OUT) :: pks(iim*jjm)
39    REAL(rstd),INTENT(OUT) :: pk(iim*jjm,llm)
40    INTEGER,INTENT(IN) :: offset
41    INTEGER :: i,j,ij,l
42    REAL(rstd) :: alpha(iim*jjm,llm),beta(iim*jjm,llm)
43    REAL(rstd) :: delta 
44   
45
46   !! Compute Alpha and Beta
47 
48   ! for llm layer
49     DO j=jj_begin-offset,jj_end+offset
50       DO i=ii_begin-offset,ii_end+offset
51         ij=(j-1)*iim+i
52         alpha(ij,llm) = 0.
53         beta (ij,llm) = 1./ (1+ 2*kappa)
54       ENDDO
55     ENDDO
56   
57   ! for other layer   
58     DO l = llm-1 , 2 , -1
59       DO j=jj_begin-offset,jj_end+offset
60         DO i=ii_begin-offset,ii_end+offset
61            ij=(j-1)*iim+i
62            delta = p(ij,l)* (1+2*kappa) + p(ij,l+1)* ( beta(ij,l+1)- (1+2*kappa) )
63            alpha(ij,l)  = - p(ij,l+1) / delta * alpha(ij,l+1)
64            beta (ij,l)  =   p(ij,l  ) / delta   
65         ENDDO
66       ENDDO
67     ENDDO     
68     
69   !! Compute pk
70 
71   ! for first layer
72     DO j=jj_begin-offset,jj_end+offset
73       DO i=ii_begin-offset,ii_end+offset
74          ij=(j-1)*iim+i
75          pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
76          pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )     /               &
77                     (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-(1.+2*kappa) )* p(ij,2) )
78       ENDDO
79     ENDDO
80   
81   ! for other layers
82     
83     DO l = 2, llm
84       DO j=jj_begin-offset,jj_end+offset
85         DO i=ii_begin-offset,ii_end+offset
86           ij=(j-1)*iim+i
87           pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
88         ENDDO
89       ENDDO
90     ENDDO
91   
92  END SUBROUTINE compute_exner
93
94END MODULE exner_mod
Note: See TracBrowser for help on using the repository browser.