source: LMDZ.3.3/trunk/libf/dyn3d/fluxstokenc.F @ 507

Last change on this file since 507 was 184, checked in by lmdzadmin, 24 years ago

Modifs A.Idelkadi pour le offline
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.9 KB
Line 
1      SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
2     . time_step,itau )
3
4       USE IOIPSL
5c
6c     Auteur :  F. Hourdin
7c
8c
9ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
10c
11      IMPLICIT NONE
12c
13#include "dimensions.h"
14#include "paramet.h"
15#include "comconst.h"
16#include "comvert.h"
17#include "comgeom.h"
18#include "tracstoke.h"
19#include "temps.h"
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,itau
38      INTEGER fluxid, fluxvid,fluxdid
39 
40      SAVE iadvtr, massem,pbaruc,pbarvc,irec
41      SAVE phic,tetac
42      logical first
43      save first
44      data first/.true./
45      DATA iadvtr/0/
46
47      if(first) then
48
49        CALL initfluxsto( 'fluxstoke',
50     .  time_step,istdyn* time_step,istdyn* time_step,
51     . nqmx, fluxid,fluxvid,fluxdid)
52       
53        ndex(1) = 0
54        call histwrite(fluxid, 'phis', 1, phis, iip1*jjp1, ndex)
55        call histwrite(fluxid, 'aire', 1, aire, iip1*jjp1, ndex)
56       
57        ndex(1) = 0
58        nscal = 1
59        tst(1) = time_step
60        call histwrite(fluxdid, 'dtvr', 1, tst, nscal, ndex)
61        ist(1)=istdyn
62        call histwrite(fluxdid, 'istdyn', 1, ist, nscal, ndex)
63        istp(1)= istphy
64        call histwrite(fluxdid, 'istphy', 1, istp, nscal, ndex)
65       
66        first = .false.
67
68      endif
69
70
71      IF(iadvtr.EQ.0) THEN
72         CALL initial0(ijp1llm,phic)
73         CALL initial0(ijp1llm,tetac)
74         CALL initial0(ijp1llm,pbaruc)
75         CALL initial0(ijmllm,pbarvc)
76      ENDIF
77
78c   accumulation des flux de masse horizontaux
79      DO l=1,llm
80         DO ij = 1,ip1jmp1
81            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
82            tetac(ij,l) = tetac(ij,l) + teta(ij,l)
83            phic(ij,l) = phic(ij,l) + phi(ij,l)
84         ENDDO
85         DO ij = 1,ip1jm
86            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
87         ENDDO
88      ENDDO
89
90c   selection de la masse instantannee des mailles avant le transport.
91      IF(iadvtr.EQ.0) THEN
92         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
93      ENDIF
94
95      iadvtr   = iadvtr+1
96
97
98c   Test pour savoir si on advecte a ce pas de temps
99      IF ( iadvtr.EQ.istdyn ) THEN
100c    normalisation
101      DO l=1,llm
102         DO ij = 1,ip1jmp1
103            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
104            tetac(ij,l) = tetac(ij,l)/float(istdyn)
105            phic(ij,l) = phic(ij,l)/float(istdyn)
106         ENDDO
107         DO ij = 1,ip1jm
108            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
109         ENDDO
110      ENDDO
111
112c   traitement des flux de masse avant advection.
113c     1. calcul de w
114c     2. groupement des mailles pres du pole.
115
116        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
117
118        do l=1,llm
119           do j=1,jjm
120              do i=1,iip1
121                 pbarvst(i,j,l)=pbarvg(i,j,l)
122              enddo
123           enddo
124           do i=1,iip1
125              pbarvst(i,jjp1,l)=0.
126           enddo
127        enddo
128
129         iadvtr=0
130        Print*,'ITAU auqel on stoke les fluxmasses',itau
131       
132        call histwrite(fluxid, 'masse', itau, massem,
133     .               iip1*jjp1*llm, ndex)
134       
135        call histwrite(fluxid, 'pbaru', itau, pbarug,
136     .               iip1*jjp1*llm, ndex)
137       
138        call histwrite(fluxvid, 'pbarv', itau, pbarvg,
139     .               iip1*jjm*llm, ndex)
140       
141        call histwrite(fluxid, 'w' ,itau, wg,
142     .             iip1*jjp1*llm, ndex)
143       
144        call histwrite(fluxid, 'teta' ,itau, tetac,
145     .             iip1*jjp1*llm, ndex)
146       
147        call histwrite(fluxid, 'phi' ,itau, phic,
148     .             iip1*jjp1*llm, ndex)
149       
150C
151
152      ENDIF ! if iadvtr.EQ.istdyn
153
154      RETURN
155      END
Note: See TracBrowser for help on using the repository browser.