/[lmdze]/trunk/libf/dyn3d/advect.f
ViewVC logotype

Annotation of /trunk/libf/dyn3d/advect.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 12 - (hide annotations)
Mon Jul 21 16:05:07 2008 UTC (15 years, 10 months ago) by guez
File size: 4747 byte(s) 
-- Minor modification of input/output:

Created procedure "read_logic". Variables of module "logic" are read
by "read_logic" instead of "conf_gcm". Variable "offline" of module
"conf_gcm" is read from namelist instead of "*.def".

Deleted arguments "dtime", "co2_ppm_etat0", "solaire_etat0",
"tabcntr0" and local variables "radpas", "tab_cntrl" of
"phyetat0". "phyetat0" does not read "controle" in "startphy.nc" any
longer. "phyetat0" now reads global attribute "itau_phy" from
"startphy.nc". "phyredem" does not create variable "controle" in
"startphy.nc" any longer. "phyredem" now writes global attribute
"itau_phy" of "startphy.nc". Deleted argument "tabcntr0" of
"printflag". Removed diagnostic messages written by "printflag" for
comparison of the variable "controle" of "startphy.nc" and the
variables read from "*.def" or namelist input.

-- Removing unwanted functionality:

Removed variable "lunout" from module "iniprint", replaced everywhere
by standard output.

Removed case "ocean == 'couple'" in "clmain", "interfsurf_hq" and
"physiq". Removed procedure "interfoce_cpl".

-- Should not change anything at run time:

Automated creation of graphs in documentation. More documentation on
input files.

Converted Fortran files to free format: "phyredem.f90", "printflag.f90".

Split module "clesphy" into "clesphys" and "clesphys2".

Removed variables "conser", "leapf", "forward", "apphys", "apdiss" and
"statcl" from module "logic". Added arguments "conser" to "advect",
"leapf" to "integrd". Added local variables "forward", "leapf",
"apphys", "conser", "apdiss" in "leapfrog".

Added intent attributes.

Deleted arguments "dtime" of "phyredem", "pdtime" of "flxdtdq", "sh"
of "phytrac", "dt" of "yamada".

Deleted local variables "dtime", "co2_ppm_etat0", "solaire_etat0",
"length", "tabcntr0" in "physiq". Replaced all references to "dtime"
by references to "pdtphys".
1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/advect.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $
3     !
4 guez 12 SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta,
5     $ conser)
6 guez 3
7     use dimens_m
8     use paramet_m
9     use comconst
10     use comvert
11     use comgeom
12     use ener
13     IMPLICIT NONE
14     c=======================================================================
15     c
16     c Auteurs: P. Le Van , Fr. Hourdin .
17     c -------
18     c
19     c Objet:
20     c ------
21     c
22     c *************************************************************
23     c .... calcul des termes d'advection vertic.pour u,v,teta,q ...
24     c *************************************************************
25     c ces termes sont ajoutes a du,dv,dteta et dq .
26     c Modif F.Forget 03/94 : on retire q de advect
27     c
28     c=======================================================================
29     c-----------------------------------------------------------------------
30     c Declarations:
31     c -------------
32    
33    
34     c Arguments:
35     c ----------
36    
37     REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
38     REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
39     REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
40 guez 12 logical, intent(in):: conser
41 guez 3
42     c Local:
43     c ------
44    
45     REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
46     REAL unsaire2(ip1jmp1), ge(ip1jmp1)
47     REAL deuxjour, ww, gt, uu, vv
48    
49     INTEGER ij,l
50    
51     REAL SSUM
52    
53     c-----------------------------------------------------------------------
54     c 2. Calculs preliminaires:
55     c -------------------------
56    
57     IF (conser) THEN
58     deuxjour = 2. * daysec
59    
60     DO 1 ij = 1, ip1jmp1
61     unsaire2(ij) = unsaire(ij) * unsaire(ij)
62     1 CONTINUE
63     END IF
64    
65    
66     c------------------ -yy ----------------------------------------------
67     c . Calcul de u
68    
69     DO l=1,llm
70     DO ij = iip2, ip1jmp1
71     uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
72     ENDDO
73     DO ij = iip2, ip1jm
74     uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
75     ENDDO
76     DO ij = 1, iip1
77     uav(ij ,l) = 0.
78     uav(ip1jm+ij,l) = 0.
79     ENDDO
80     ENDDO
81    
82     c------------------ -xx ----------------------------------------------
83     c . Calcul de v
84    
85     DO l=1,llm
86     DO ij = 2, ip1jm
87     vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
88     ENDDO
89     DO ij = 1,ip1jm,iip1
90     vav(ij,l) = vav(ij+iim,l)
91     ENDDO
92     DO ij = 1, ip1jm-1
93     vav(ij,l) = vav(ij,l) + vav(ij+1,l)
94     ENDDO
95     DO ij = 1, ip1jm, iip1
96     vav(ij+iim,l) = vav(ij,l)
97     ENDDO
98     ENDDO
99    
100     c-----------------------------------------------------------------------
101    
102     c
103     DO 20 l = 1, llmm1
104    
105    
106     c ...... calcul de - w/2. au niveau l+1 .......
107    
108     DO 5 ij = 1, ip1jmp1
109     wsur2( ij ) = - 0.5 * w( ij,l+1 )
110     5 CONTINUE
111    
112    
113     c ..................... calcul pour du ..................
114    
115     DO 6 ij = iip2 ,ip1jm-1
116     ww = wsur2 ( ij ) + wsur2( ij+1 )
117     uu = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
118     du(ij,l) = du(ij,l) - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
119     du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
120     6 CONTINUE
121    
122     c ..... correction pour du(iip1,j,l) ........
123     c ..... du(iip1,j,l)= du(1,j,l) .....
124    
125     CDIR$ IVDEP
126     DO 7 ij = iip1 +iip1, ip1jm, iip1
127     du( ij, l ) = du( ij -iim, l )
128     du( ij,l+1 ) = du( ij -iim,l+1 )
129     7 CONTINUE
130    
131     c ................. calcul pour dv .....................
132    
133     DO 8 ij = 1, ip1jm
134     ww = wsur2( ij+iip1 ) + wsur2( ij )
135     vv = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
136     dv(ij,l) = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
137     dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
138     8 CONTINUE
139    
140     c
141    
142     c ............................................................
143     c ............... calcul pour dh ...................
144     c ............................................................
145    
146     c ---z
147     c calcul de - d( teta * w ) qu'on ajoute a dh
148     c ...............
149    
150     DO 15 ij = 1, ip1jmp1
151     ww = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
152     dteta(ij, l ) = dteta(ij, l ) - ww
153     dteta(ij,l+1) = dteta(ij,l+1) + ww
154     15 CONTINUE
155    
156     IF( conser) THEN
157     DO 17 ij = 1,ip1jmp1
158     ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij)
159     17 CONTINUE
160     gt = SSUM( ip1jmp1,ge,1 )
161     gtot(l) = deuxjour * SQRT( gt/ip1jmp1 )
162     END IF
163    
164     20 CONTINUE
165    
166     RETURN
167     END
  ViewVC Help
Powered by ViewVC 1.1.21