source: LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/friction.F @ 5425

Last change on this file since 5425 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: 2.4 KB
Line 
1!
2! $Id: friction.F 1299 2010-01-20 14:27:21Z jyg $
3!
4c=======================================================================
5      SUBROUTINE friction(ucov,vcov,pdt)
6
7      USE control_mod
8 
9      IMPLICIT NONE
10
11c=======================================================================
12c
13c
14c   Objet:
15c   ------
16c
17c  ***********
18c    Friction
19c  ***********
20c
21c=======================================================================
22
23#include "dimensions.h"
24#include "paramet.h"
25#include "comgeom2.h"
26#include "comconst.h"
27
28      REAL pdt
29      REAL modv(iip1,jjp1),zco,zsi
30      REAL vpn,vps,upoln,upols,vpols,vpoln
31      REAL u2(iip1,jjp1),v2(iip1,jjm)
32      REAL ucov( iip1,jjp1,llm ),vcov( iip1,jjm,llm )
33      INTEGER  i,j
34      REAL cfric
35      parameter (cfric=1.e-5)
36
37
38c   calcul des composantes au carre du vent naturel
39      do j=1,jjp1
40         do i=1,iip1
41            u2(i,j)=ucov(i,j,1)*ucov(i,j,1)*unscu2(i,j)
42         enddo
43      enddo
44      do j=1,jjm
45         do i=1,iip1
46            v2(i,j)=vcov(i,j,1)*vcov(i,j,1)*unscv2(i,j)
47         enddo
48      enddo
49
50c   calcul du module de V en dehors des poles
51      do j=2,jjm
52         do i=2,iip1
53            modv(i,j)=sqrt(0.5*(u2(i-1,j)+u2(i,j)+v2(i,j-1)+v2(i,j)))
54         enddo
55         modv(1,j)=modv(iip1,j)
56      enddo
57
58c   les deux composantes du vent au pole sont obtenues comme
59c   premiers modes de fourier de v pres du pole
60      upoln=0.
61      vpoln=0.
62      upols=0.
63      vpols=0.
64      do i=2,iip1
65         zco=cos(rlonv(i))*(rlonu(i)-rlonu(i-1))
66         zsi=sin(rlonv(i))*(rlonu(i)-rlonu(i-1))
67         vpn=vcov(i,1,1)/cv(i,1)
68         vps=vcov(i,jjm,1)/cv(i,jjm)
69         upoln=upoln+zco*vpn
70         vpoln=vpoln+zsi*vpn
71         upols=upols+zco*vps
72         vpols=vpols+zsi*vps
73      enddo
74      vpn=sqrt(upoln*upoln+vpoln*vpoln)/pi
75      vps=sqrt(upols*upols+vpols*vpols)/pi
76      do i=1,iip1
77c        modv(i,1)=vpn
78c        modv(i,jjp1)=vps
79         modv(i,1)=modv(i,2)
80         modv(i,jjp1)=modv(i,jjm)
81      enddo
82
83c   calcul du frottement au sol.
84      do j=2,jjm
85         do i=1,iim
86            ucov(i,j,1)=ucov(i,j,1)
87     s      -cfric*pdt*0.5*(modv(i+1,j)+modv(i,j))*ucov(i,j,1)
88         enddo
89         ucov(iip1,j,1)=ucov(1,j,1)
90      enddo
91      do j=1,jjm
92         do i=1,iip1
93            vcov(i,j,1)=vcov(i,j,1)
94     s      -cfric*pdt*0.5*(modv(i,j+1)+modv(i,j))*vcov(i,j,1)
95         enddo
96         vcov(iip1,j,1)=vcov(1,j,1)
97      enddo
98
99      RETURN
100      END
101
Note: See TracBrowser for help on using the repository browser.