/[lmdze]/trunk/dyn3d/integrd.f
ViewVC logotype

Contents of /trunk/dyn3d/integrd.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 12 - (show annotations)
Mon Jul 21 16:05:07 2008 UTC (15 years, 10 months ago) by guez
Original Path: trunk/libf/dyn3d/integrd.f
File size: 5267 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 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/integrd.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
3 !
4 SUBROUTINE integrd
5 $ ( nq,vcovm1,ucovm1,tetam1,psm1,massem1,
6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold,
7 $ leapf )
8
9 use dimens_m
10 use paramet_m
11 use comconst
12 use comvert
13 use logic
14 use comgeom
15 use serre
16 use temps
17 use advtrac_m
18 use pression_m, only: pression
19
20 IMPLICIT NONE
21
22
23 c=======================================================================
24 c
25 c Auteur: P. Le Van
26 c -------
27 c
28 c objet:
29 c ------
30 c
31 c Incrementation des tendances dynamiques
32 c
33 c=======================================================================
34 c-----------------------------------------------------------------------
35 c Declarations:
36 c -------------
37
38
39 c Arguments:
40 c ----------
41
42 INTEGER nq
43
44 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
45 REAL q(ip1jmp1,llm,nq)
46 REAL ps(ip1jmp1),masse(ip1jmp1,llm),phis(ip1jmp1)
47
48 REAL vcovm1(ip1jm,llm),ucovm1(ip1jmp1,llm)
49 REAL tetam1(ip1jmp1,llm),psm1(ip1jmp1),massem1(ip1jmp1,llm)
50
51 REAL dv(ip1jm,llm),du(ip1jmp1,llm)
52 REAL dteta(ip1jmp1,llm),dp(ip1jmp1)
53 REAL dq(ip1jmp1,llm,nq), finvmaold(ip1jmp1,llm)
54 logical, intent(in):: leapf
55
56 c Local:
57 c ------
58
59 REAL vscr( ip1jm ),uscr( ip1jmp1 ),hscr( ip1jmp1 ),pscr(ip1jmp1)
60 REAL massescr( ip1jmp1,llm ), finvmasse(ip1jmp1,llm)
61 REAL p(ip1jmp1,llmp1)
62 REAL tpn,tps,tppn(iim),tpps(iim)
63 REAL qpn,qps,qppn(iim),qpps(iim)
64 REAL deltap( ip1jmp1,llm )
65
66 INTEGER l,ij,iq
67
68 REAL SSUM
69
70 c-----------------------------------------------------------------------
71
72 DO l = 1,llm
73 DO ij = 1,iip1
74 ucov( ij , l) = 0.
75 ucov( ij +ip1jm, l) = 0.
76 uscr( ij ) = 0.
77 uscr( ij +ip1jm ) = 0.
78 ENDDO
79 ENDDO
80
81
82 c ............ integration de ps ..............
83
84 CALL SCOPY(ip1jmp1*llm, masse, 1, massescr, 1)
85
86 DO 2 ij = 1,ip1jmp1
87 pscr (ij) = ps(ij)
88 ps (ij) = psm1(ij) + dt * dp(ij)
89 2 CONTINUE
90 c
91 DO ij = 1,ip1jmp1
92 IF( ps(ij).LT.0. ) THEN
93 PRINT *,' Au point ij = ',ij, ' , pression sol neg. ', ps(ij)
94 STOP 'integrd'
95 ENDIF
96 ENDDO
97 c
98 DO ij = 1, iim
99 tppn(ij) = aire( ij ) * ps( ij )
100 tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
101 ENDDO
102 tpn = SSUM(iim,tppn,1)/apoln
103 tps = SSUM(iim,tpps,1)/apols
104 DO ij = 1, iip1
105 ps( ij ) = tpn
106 ps(ij+ip1jm) = tps
107 ENDDO
108 c
109 c ... Calcul de la nouvelle masse d'air au dernier temps integre t+1 ...
110 c
111 CALL pression ( ip1jmp1, ap, bp, ps, p )
112 CALL massdair ( p , masse )
113
114 CALL SCOPY( ijp1llm , masse, 1, finvmasse, 1 )
115 CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1 )
116 c
117
118 c ............ integration de ucov, vcov, h ..............
119
120 DO 10 l = 1,llm
121
122 DO 4 ij = iip2,ip1jm
123 uscr( ij ) = ucov( ij,l )
124 ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
125 4 CONTINUE
126
127 DO 5 ij = 1,ip1jm
128 vscr( ij ) = vcov( ij,l )
129 vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
130 5 CONTINUE
131
132 DO 6 ij = 1,ip1jmp1
133 hscr( ij ) = teta(ij,l)
134 teta ( ij,l ) = tetam1(ij,l) * massem1(ij,l) / masse(ij,l)
135 $ + dt * dteta(ij,l) / masse(ij,l)
136 6 CONTINUE
137
138 c .... Calcul de la valeur moyenne, unique aux poles pour teta ......
139 c
140 c
141 DO ij = 1, iim
142 tppn(ij) = aire( ij ) * teta( ij ,l)
143 tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
144 ENDDO
145 tpn = SSUM(iim,tppn,1)/apoln
146 tps = SSUM(iim,tpps,1)/apols
147
148 DO ij = 1, iip1
149 teta( ij ,l) = tpn
150 teta(ij+ip1jm,l) = tps
151 ENDDO
152 c
153
154 IF(leapf) THEN
155 CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
156 CALL SCOPY ( ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
157 CALL SCOPY ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
158 END IF
159
160 10 CONTINUE
161
162 DO l = 1, llm
163 DO ij = 1, ip1jmp1
164 deltap(ij,l) = p(ij,l) - p(ij,l+1)
165 ENDDO
166 ENDDO
167
168 CALL qminimum( q, nq, deltap )
169 c
170 c ..... Calcul de la valeur moyenne, unique aux poles pour q .....
171 c
172
173 DO iq = 1, nq
174 DO l = 1, llm
175
176 DO ij = 1, iim
177 qppn(ij) = aire( ij ) * q( ij ,l,iq)
178 qpps(ij) = aire(ij+ip1jm) * q(ij+ip1jm,l,iq)
179 ENDDO
180 qpn = SSUM(iim,qppn,1)/apoln
181 qps = SSUM(iim,qpps,1)/apols
182
183 DO ij = 1, iip1
184 q( ij ,l,iq) = qpn
185 q(ij+ip1jm,l,iq) = qps
186 ENDDO
187
188 ENDDO
189 ENDDO
190
191
192 CALL SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
193 c
194 c
195 c ..... FIN de l'integration de q .......
196
197 15 continue
198
199 c .................................................................
200
201
202 IF( leapf ) THEN
203 CALL SCOPY ( ip1jmp1 , pscr , 1, psm1 , 1 )
204 CALL SCOPY ( ip1jmp1*llm, massescr, 1, massem1, 1 )
205 END IF
206
207 RETURN
208 END
  ViewVC Help
Powered by ViewVC 1.1.21