source: LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/friction_p.F @ 2057

Last change on this file since 2057 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
RevLine 
[630]1!
[1299]2! $Id: friction_p.F 1299 2010-01-20 14:27:21Z emillour $
[630]3!
4c=======================================================================
5      SUBROUTINE friction_p(ucov,vcov,pdt)
6      USE parallel
[1299]7      USE control_mod
[630]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.