source: LMDZ5/trunk/libf/dyn3dmem/friction_p.F @ 1632

Last change on this file since 1632 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 3.3 KB
Line 
1!
2! $Id: friction_p.F 1299 2010-01-20 14:27:21Z fairhead $
3!
4c=======================================================================
5      SUBROUTINE friction_p(ucov,vcov,pdt)
6      USE parallel
7      USE control_mod
8      IMPLICIT NONE
9
10c=======================================================================
11c
12c
13c   Objet:
14c   ------
15c
16c  ***********
17c    Friction
18c  ***********
19c
20c=======================================================================
21
22#include "dimensions.h"
23#include "paramet.h"
24#include "comgeom2.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.