/[lmdze]/trunk/Sources/dyn3d/limx.f
ViewVC logotype

Contents of /trunk/Sources/dyn3d/limx.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 157 - (show annotations)
Mon Jul 20 16:01:49 2015 UTC (8 years, 10 months ago) by guez
File size: 2142 byte(s)
Just encapsulated SUBROUTINE vlsplt in a module and cleaned it.

In procedure vlx, local variables dxqu and adxqu only need indices
iip2:ip1jm. Otherwise, just cleaned vlx.

Procedures dynredem0 and dynredem1 no longer have argument fichnom,
they just operate on a file named "restart.nc". The programming
guideline here is that gcm should not be more complex than it needs by
itself, other programs (ce0l etc.) just have to adapt to gcm. So ce0l
now creates files "restart.nc" and "restartphy.nc".

In order to facilitate decentralizing the writing of "restartphy.nc",
created a procedure phyredem0 out of phyredem. phyredem0 creates the
NetCDF header of "restartphy.nc" while phyredem writes the NetCDF
variables. As the global attribute itau_phy needs to be filled in
phyredem0, at the beginnig of the run, we must compute its value
instead of just using itap. So we have a dummy argument lmt_pas of
phyredem0. Also, the ncid of "startphy.nc" is upgraded from local
variable of phyetat0 to dummy argument. phyetat0 no longer closes
"startphy.nc".

Following the same decentralizing objective, the ncid of "restart.nc"
is upgraded from local variable of dynredem0 to module variable of
dynredem0_m. "restart.nc" is not closed at the end of dynredem0 nor
opened at the beginning of dynredem1.

In procedure etat0, instead of creating many vectors of size klon
which will be filled with zeroes, just create one array null_array.

In procedure phytrac, instead of writing trs(: 1) to a text file,
write it to "restartphy.nc" (following LMDZ). This is better because
now trs(: 1) is next to its coordinates. We can write to
"restartphy.nc" from phytrac directly, and not add trs(: 1) to the
long list of variables in physiq, thanks to the decentralizing of
"restartphy.nc".

In procedure phyetat0, we no longer write to standard output the
minimum and maximum values of read arrays. It is ok to check input and
abort on invalid values but just printing statistics on input seems too
much useless computation and out of place clutter.

1
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limx.F,v 1.1.1.1 2004/05/19
3 ! 12:53:06 lmdzadmin Exp $
4
5 SUBROUTINE limx(s0, sx, sm, pente_max)
6
7 ! Auteurs: P.Le Van, F.Hourdin, F.Forget
8
9 ! ********************************************************************
10 ! Shema d'advection " pseudo amont " .
11 ! ********************************************************************
12 ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg ....
13
14
15 ! --------------------------------------------------------------------
16 USE dimens_m
17 USE paramet_m
18 USE comconst
19 USE disvert_m
20 USE conf_gcm_m
21 USE comgeom
22 IMPLICIT NONE
23
24
25
26 ! Arguments:
27 ! ----------
28 REAL pente_max
29 REAL s0(ip1jmp1, llm), sm(ip1jmp1, llm)
30 REAL sx(ip1jmp1, llm)
31
32 ! Local
33 ! ---------
34
35 INTEGER ij, l
36
37 REAL q(ip1jmp1, llm)
38 REAL dxq(ip1jmp1, llm)
39
40 REAL dxqu(ip1jmp1)
41 REAL adxqu(ip1jmp1), dxqmax(ip1jmp1)
42
43 REAL ssum
44 INTEGER ismax, ismin
45 EXTERNAL ssum, convflu, ismin, ismax
46
47 DO l = 1, llm
48 DO ij = 1, ip1jmp1
49 q(ij, l) = s0(ij, l)/sm(ij, l)
50 dxq(ij, l) = sx(ij, l)/sm(ij, l)
51 END DO
52 END DO
53
54 ! calcul de la pente a droite et a gauche de la maille
55
56 DO l = 1, llm
57 DO ij = iip2, ip1jm - 1
58 dxqu(ij) = q(ij+1, l) - q(ij, l)
59 END DO
60 DO ij = iip1 + iip1, ip1jm, iip1
61 dxqu(ij) = dxqu(ij-iim)
62 END DO
63
64 DO ij = iip2, ip1jm
65 adxqu(ij) = abs(dxqu(ij))
66 END DO
67
68 ! calcul de la pente maximum dans la maille en valeur absolue
69
70 DO ij = iip2 + 1, ip1jm
71 dxqmax(ij) = pente_max*min(adxqu(ij-1), adxqu(ij))
72 END DO
73
74 DO ij = iip1 + iip1, ip1jm, iip1
75 dxqmax(ij-iim) = dxqmax(ij)
76 END DO
77
78 ! calcul de la pente avec limitation
79
80 DO ij = iip2 + 1, ip1jm
81 IF (dxqu(ij-1)*dxqu(ij)>0. .AND. dxq(ij,l)*dxqu(ij)>0.) THEN
82 dxq(ij, l) = sign(min(abs(dxq(ij,l)),dxqmax(ij)), dxq(ij,l))
83 ELSE
84 ! extremum local
85 dxq(ij, l) = 0.
86 END IF
87 END DO
88 DO ij = iip1 + iip1, ip1jm, iip1
89 dxq(ij-iim, l) = dxq(ij, l)
90 END DO
91
92 DO ij = 1, ip1jmp1
93 sx(ij, l) = dxq(ij, l)*sm(ij, l)
94 END DO
95
96 END DO
97
98 RETURN
99 END SUBROUTINE limx

  ViewVC Help
Powered by ViewVC 1.1.21