source: LMDZ4/trunk/libf/dyn3dpar/friction_p.F @ 1352

Last change on this file since 1352 was 774, checked in by Laurent Fairhead, 17 years ago

Suite du merge entre la version et la HEAD: quelques modifications de
Yann sur le

LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
Line 
1!
2! $Header$
3!
4c=======================================================================
5      SUBROUTINE friction_p(ucov,vcov,pdt)
6      USE parallel
7      IMPLICIT NONE
8
9c=======================================================================
10c
11c
12c   Objet:
13c   ------
14c
15c  ***********
16c    Friction
17c  ***********
18c
19c=======================================================================
20
21#include "dimensions.h"
22#include "paramet.h"
23#include "comgeom2.h"
24#include "control.h"
25#include "comconst.h"
26
27      REAL pdt
28      REAL modv(iip1,jjp1),zco,zsi
29      REAL vpn,vps,upoln,upols,vpols,vpoln
30      REAL u2(iip1,jjp1),v2(iip1,jjm)
31      REAL ucov( iip1,jjp1,llm ),vcov( iip1,jjm,llm )
32      INTEGER  i,j
33      REAL cfric
34      parameter (cfric=1.e-5)
35      integer :: jjb,jje
36
37
38c   calcul des composantes au carre du vent naturel
39      jjb=jj_begin
40      jje=jj_end+1
41      if (pole_sud) jje=jj_end
42     
43      do j=jjb,jje
44         do i=1,iip1
45            u2(i,j)=ucov(i,j,1)*ucov(i,j,1)*unscu2(i,j)
46         enddo
47      enddo
48     
49      jjb=jj_begin-1
50      jje=jj_end+1
51      if (pole_nord) jjb=jj_begin
52      if (pole_sud) jje=jj_end-1
53     
54      do j=jjb,jje
55         do i=1,iip1
56            v2(i,j)=vcov(i,j,1)*vcov(i,j,1)*unscv2(i,j)
57         enddo
58      enddo
59
60c   calcul du module de V en dehors des poles
61      jjb=jj_begin
62      jje=jj_end+1
63      if (pole_nord) jjb=jj_begin+1
64      if (pole_sud) jje=jj_end-1
65     
66      do j=jjb,jje
67         do i=2,iip1
68            modv(i,j)=sqrt(0.5*(u2(i-1,j)+u2(i,j)+v2(i,j-1)+v2(i,j)))
69         enddo
70         modv(1,j)=modv(iip1,j)
71      enddo
72
73c   les deux composantes du vent au pole sont obtenues comme
74c   premiers modes de fourier de v pres du pole
75      if (pole_nord) then
76     
77        upoln=0.
78        vpoln=0.
79     
80        do i=2,iip1
81           zco=cos(rlonv(i))*(rlonu(i)-rlonu(i-1))
82           zsi=sin(rlonv(i))*(rlonu(i)-rlonu(i-1))
83           vpn=vcov(i,1,1)/cv(i,1)
84           upoln=upoln+zco*vpn
85           vpoln=vpoln+zsi*vpn
86        enddo
87        vpn=sqrt(upoln*upoln+vpoln*vpoln)/pi
88        do i=1,iip1
89c          modv(i,1)=vpn
90           modv(i,1)=modv(i,2)
91        enddo
92
93      endif
94     
95      if (pole_sud) then
96     
97        upols=0.
98        vpols=0.
99        do i=2,iip1
100           zco=cos(rlonv(i))*(rlonu(i)-rlonu(i-1))
101           zsi=sin(rlonv(i))*(rlonu(i)-rlonu(i-1))
102           vps=vcov(i,jjm,1)/cv(i,jjm)
103           upols=upols+zco*vps
104           vpols=vpols+zsi*vps
105        enddo
106        vps=sqrt(upols*upols+vpols*vpols)/pi
107        do i=1,iip1
108c        modv(i,jjp1)=vps
109         modv(i,jjp1)=modv(i,jjm)
110        enddo
111     
112      endif
113     
114c   calcul du frottement au sol.
115
116      jjb=jj_begin
117      jje=jj_end
118      if (pole_nord) jjb=jj_begin+1
119      if (pole_sud) jje=jj_end-1
120
121      do j=jjb,jje
122         do i=1,iim
123            ucov(i,j,1)=ucov(i,j,1)
124     s      -cfric*pdt*0.5*(modv(i+1,j)+modv(i,j))*ucov(i,j,1)
125         enddo
126         ucov(iip1,j,1)=ucov(1,j,1)
127      enddo
128     
129      jjb=jj_begin
130      jje=jj_end
131      if (pole_sud) jje=jj_end-1
132     
133      do j=jjb,jje
134         do i=1,iip1
135            vcov(i,j,1)=vcov(i,j,1)
136     s      -cfric*pdt*0.5*(modv(i,j+1)+modv(i,j))*vcov(i,j,1)
137         enddo
138         vcov(iip1,j,1)=vcov(1,j,1)
139      enddo
140
141      RETURN
142      END
143
Note: See TracBrowser for help on using the repository browser.