/[lmdze]/trunk/dyn3d/Vlsplt/vlz.f
ViewVC logotype

Contents of /trunk/dyn3d/Vlsplt/vlz.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
Original Path: trunk/Sources/dyn3d/Vlsplt/vlz.f
File size: 2614 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 SUBROUTINE vlz(q,pente_max,masse,w)
2 !
3 ! Auteurs: P.Le Van, F.Hourdin, F.Forget
4 !
5 ! *************************************************************
6 ! Shema d'advection " pseudo amont " .
7 ! ****************************************************************
8 ! q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg ....
9 ! dq sont des arguments de sortie pour le s-pg ....
10 !
11 !
12 ! ----------------------------------------------------------------
13 use dimens_m
14 use paramet_m
15 use comconst
16 use disvert_m
17 use conf_gcm_m
18 IMPLICIT NONE
19 !
20 !
21 !
22 ! Arguments:
23 ! ----------
24 REAL masse(ip1jmp1,llm)
25 real, intent(in):: pente_max
26 REAL q(ip1jmp1,llm)
27 REAL w(ip1jmp1,llm+1)
28 !
29 ! Local
30 ! ---------
31 !
32 INTEGER ij,l
33 !
34 REAL wq(ip1jmp1,llm+1),newmasse
35
36 REAL dzq(ip1jmp1,llm),dzqw(ip1jmp1,llm),adzqw(ip1jmp1,llm),dzqmax
37 REAL sigw
38
39 ! On oriente tout dans le sens de la pression c'est a dire dans le
40 ! sens de W
41
42 DO l=2,llm
43 DO ij=1,ip1jmp1
44 dzqw(ij,l)=q(ij,l-1)-q(ij,l)
45 adzqw(ij,l)=abs(dzqw(ij,l))
46 ENDDO
47 ENDDO
48
49 DO l=2,llm-1
50 DO ij=1,ip1jmp1
51 IF(dzqw(ij,l)*dzqw(ij,l+1).gt.0.) THEN
52 dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
53 ELSE
54 dzq(ij,l)=0.
55 ENDIF
56 dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
57 dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
58 ENDDO
59 ENDDO
60
61 DO ij=1,ip1jmp1
62 dzq(ij,1)=0.
63 dzq(ij,llm)=0.
64 ENDDO
65
66 ! ---------------------------------------------------------------
67 ! .... calcul des termes d'advection verticale .......
68 ! ---------------------------------------------------------------
69
70 ! calcul de - d( q * w )/ d(sigma) qu'on ajoute a dq pour
71 ! calculer dq
72
73 DO l = 1,llm-1
74 do ij = 1,ip1jmp1
75 IF(w(ij,l+1).gt.0.) THEN
76 sigw=w(ij,l+1)/masse(ij,l+1)
77 wq(ij,l+1)=w(ij,l+1)*(q(ij,l+1)+0.5*(1.-sigw)*dzq(ij,l+1))
78 ELSE
79 sigw=w(ij,l+1)/masse(ij,l)
80 wq(ij,l+1)=w(ij,l+1)*(q(ij,l)-0.5*(1.+sigw)*dzq(ij,l))
81 ENDIF
82 ENDDO
83 ENDDO
84
85 DO ij=1,ip1jmp1
86 wq(ij,llm+1)=0.
87 wq(ij,1)=0.
88 ENDDO
89
90 DO l=1,llm
91 DO ij=1,ip1jmp1
92 newmasse=masse(ij,l)+w(ij,l+1)-w(ij,l)
93 q(ij,l)=(q(ij,l)*masse(ij,l)+wq(ij,l+1)-wq(ij,l)) &
94 & /newmasse
95 masse(ij,l)=newmasse
96 ENDDO
97 ENDDO
98
99 END

  ViewVC Help
Powered by ViewVC 1.1.21