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

Contents of /trunk/libf/dyn3d/fluxstokenc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 15 - (show annotations)
Fri Aug 1 15:24:12 2008 UTC (15 years, 9 months ago) by guez
File size: 3656 byte(s) 
-- Minor modification of input/output:

Added variable "Sigma_O3_Royer" to "histday.nc". "ecrit_day" is not
modified in "physiq". Removed variables "pyu1", "pyv1", "ftsol1",
"ftsol2", "ftsol3", "ftsol4", "psrf1", "psrf2", "psrf3", "psrf4"
"mfu", "mfd", "en_u", "en_d", "de_d", "de_u", "coefh" from
"histrac.nc".

Variable "raz_date" of module "conf_gcm_m" has logical type instead of
integer type.

-- Should not change any result at run time:

Modified calls to "IOIPSL_Lionel" procedures because the interfaces of
these procedures have been simplified.

Changed name of variable in module "start_init_orog_m": "masque" to
"mask".

Created a module containing procedure "phyredem".

Removed arguments "punjours", "pdayref" and "ptimestep" of procedure
"iniphysiq".

Renamed procedure "gr_phy_write" to "gr_phy_write_2d". Created
procedure "gr_phy_write_3d".

Removed procedures "ini_undefstd", "moy_undefSTD", "calcul_STDlev",
"calcul_divers".
1 SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
2 . time_step,itau )
3
4 USE IOIPSL
5 c
6 c Auteur : F. Hourdin
7 c
8 c
9 ccc .. Modif. P. Le Van ( 20/12/97 ) ...
10 c
11 use dimens_m
12 use paramet_m
13 use comconst
14 use comvert
15 use comgeom
16 use temps
17 use tracstoke
18 IMPLICIT NONE
19 c
20
21 REAL time_step,t_wrt, t_ops
22 REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
23 REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
24 REAL phis(ip1jmp1)
25
26 REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
27 REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
28
29 REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
30
31 REAL pbarvst(iip1,jjp1,llm),zistdyn
32 real dtcum
33
34 INTEGER iadvtr,ndex(1)
35 integer nscal
36 real tst(1),ist(1),istp(1)
37 INTEGER ij,l,irec,i,j
38 integer, intent(in):: itau
39 INTEGER fluxid, fluxvid,fluxdid
40
41 SAVE iadvtr, massem,pbaruc,pbarvc,irec
42 SAVE phic,tetac
43 logical first
44 save first
45 data first/.true./
46 DATA iadvtr/0/
47
48 if(first) then
49
50 CALL initfluxsto( 'fluxstoke',
51 . time_step,istdyn* time_step,istdyn* time_step,
52 . nqmx, fluxid,fluxvid,fluxdid)
53
54 ndex(1) = 0
55 call histwrite(fluxid, 'phis', 1, phis)
56 call histwrite(fluxid, 'aire', 1, aire)
57
58 ndex(1) = 0
59 nscal = 1
60 tst(1) = time_step
61 call histwrite(fluxdid, 'dtvr', 1, tst)
62 ist(1)=istdyn
63 call histwrite(fluxdid, 'istdyn', 1, ist)
64 istp(1)= istphy
65 call histwrite(fluxdid, 'istphy', 1, istp)
66
67 first = .false.
68
69 endif
70
71
72 IF(iadvtr.EQ.0) THEN
73 CALL initial0(ijp1llm,phic)
74 CALL initial0(ijp1llm,tetac)
75 CALL initial0(ijp1llm,pbaruc)
76 CALL initial0(ijmllm,pbarvc)
77 ENDIF
78
79 c accumulation des flux de masse horizontaux
80 DO l=1,llm
81 DO ij = 1,ip1jmp1
82 pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
83 tetac(ij,l) = tetac(ij,l) + teta(ij,l)
84 phic(ij,l) = phic(ij,l) + phi(ij,l)
85 ENDDO
86 DO ij = 1,ip1jm
87 pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
88 ENDDO
89 ENDDO
90
91 c selection de la masse instantannee des mailles avant le transport.
92 IF(iadvtr.EQ.0) THEN
93 CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
94 ENDIF
95
96 iadvtr = iadvtr+1
97
98
99 c Test pour savoir si on advecte a ce pas de temps
100 IF ( iadvtr.EQ.istdyn ) THEN
101 c normalisation
102 DO l=1,llm
103 DO ij = 1,ip1jmp1
104 pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
105 tetac(ij,l) = tetac(ij,l)/float(istdyn)
106 phic(ij,l) = phic(ij,l)/float(istdyn)
107 ENDDO
108 DO ij = 1,ip1jm
109 pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
110 ENDDO
111 ENDDO
112
113 c traitement des flux de masse avant advection.
114 c 1. calcul de w
115 c 2. groupement des mailles pres du pole.
116
117 CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
118
119 do l=1,llm
120 do j=1,jjm
121 do i=1,iip1
122 pbarvst(i,j,l)=pbarvg(i,j,l)
123 enddo
124 enddo
125 do i=1,iip1
126 pbarvst(i,jjp1,l)=0.
127 enddo
128 enddo
129
130 iadvtr=0
131 Print*,'ITAU auqel on stoke les fluxmasses',itau
132
133 call histwrite(fluxid, 'masse', itau, massem)
134
135 call histwrite(fluxid, 'pbaru', itau, pbarug)
136
137 call histwrite(fluxvid, 'pbarv', itau, pbarvg)
138
139 call histwrite(fluxid, 'w' ,itau, wg)
140
141 call histwrite(fluxid, 'teta' ,itau, tetac)
142
143 call histwrite(fluxid, 'phi' ,itau, phic)
144
145 C
146
147 ENDIF ! if iadvtr.EQ.istdyn
148
149 RETURN
150 END
  ViewVC Help
Powered by ViewVC 1.1.21