source: LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/iniacademic.F @ 1110

Last change on this file since 1110 was 1108, checked in by yann meurdesoif, 16 years ago

module filtre -> module filtreg_mod ; use filtre -> use filtreg_mod

YM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.5 KB
Line 
1!
2! $Header$
3!
4c
5c
6      SUBROUTINE iniacademic(nq,vcov,ucov,teta,q,masse,ps,phis,time_0)
7
8      USE filtreg_mod
9
10c%W%    %G%
11c=======================================================================
12c
13c   Author:    Frederic Hourdin      original: 15/01/93
14c   -------
15c
16c   Subject:
17c   ------
18c
19c   Method:
20c   --------
21c
22c   Interface:
23c   ----------
24c
25c      Input:
26c      ------
27c
28c      Output:
29c      -------
30c
31c=======================================================================
32      IMPLICIT NONE
33c-----------------------------------------------------------------------
34c   Declararations:
35c   ---------------
36
37#include "dimensions.h"
38#include "paramet.h"
39#include "comvert.h"
40#include "comconst.h"
41#include "comgeom.h"
42#include "academic.h"
43#include "ener.h"
44#include "temps.h"
45#include "control.h"
46
47c   Arguments:
48c   ----------
49
50      integer nq
51      real time_0
52
53c   variables dynamiques
54      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
55      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
56      REAL q(ip1jmp1,llm,nq)               ! champs advectes
57      REAL ps(ip1jmp1)                       ! pression  au sol
58      REAL masse(ip1jmp1,llm)                ! masse d'air
59      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
60      REAL pks(ip1jmp1)                      ! exner au  sol
61      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
62      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
63      REAL phis(ip1jmp1)                     ! geopotentiel au sol
64      REAL phi(ip1jmp1,llm)                  ! geopotentiel
65
66
67
68
69
70c   Local:
71c   ------
72
73      REAL ddsin,tetarappelj,tetarappell,zsig
74      real tetajl(jjp1,llm)
75      INTEGER i,j,l,lsup,ij
76
77      real zz,ran1
78      integer idum
79
80      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
81
82c-----------------------------------------------------------------------
83
84c
85      time_0=0.
86
87      im         = iim
88      jm         = jjm
89      day_ini    = 0
90      omeg       = 4.*asin(1.)/86400.
91      rad    = 6371229.
92      g      = 9.8
93      daysec = 86400.
94      dtvr    = daysec/FLOAT(day_step)
95      zdtvr=dtvr
96      kappa  = 0.2857143
97      cpp    = 1004.70885
98      preff     = 101325.
99      pa        =  50 000.
100      etot0      = 0.
101      ptot0      = 0.
102      ztot0      = 0.
103      stot0      = 0.
104      ang0       = 0.
105      pa         = 0.
106
107      CALL inicons0
108      CALL inigeom
109      CALL inifilr
110
111      ps=0.
112      phis=0.
113c---------------------------------------------------------------------
114
115      taurappel=10.*daysec
116
117c---------------------------------------------------------------------
118c   Calcul de la temperature potentielle :
119c   --------------------------------------
120
121      DO l=1,llm
122       zsig=ap(l)/preff+bp(l)
123       if (zsig.gt.0.3) then
124         lsup=l
125         tetarappell=1./8.*(-log(zsig)-.5)
126         DO j=1,jjp1
127            ddsin=sin(rlatu(j))-sin(pi/20.)
128            tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
129         ENDDO
130        else
131c   Choix isotherme au-dessus de 300 mbar
132         do j=1,jjp1
133            tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
134         enddo
135        endif
136      ENDDO
137
138      do l=1,llm
139         do j=1,jjp1
140            do i=1,iip1
141               ij=(j-1)*iip1+i
142               tetarappel(ij,l)=tetajl(j,l)
143            enddo
144         enddo
145      enddo
146
147c     call dump2d(jjp1,llm,tetajl,'TEQ   ')
148
149      ps=1.e5
150      phis=0.
151      CALL pression ( ip1jmp1, ap, bp, ps, p       )
152      CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
153      CALL massdair(p,masse)
154
155c  intialisation du vent et de la temperature
156      teta(:,:)=tetarappel(:,:)
157      CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
158      call ugeostr(phi,ucov)
159      vcov=0.
160      q(:,:,1   )=1.e-10
161      q(:,:,2   )=1.e-15
162      q(:,:,3:nq)=0.
163
164
165c   perturbation al\351atoire sur la temp\351rature
166      idum  = -1
167      zz = ran1(idum)
168      idum  = 0
169      do l=1,llm
170         do ij=iip2,ip1jm
171            teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
172         enddo
173      enddo
174
175      do l=1,llm
176         do ij=1,ip1jmp1,iip1
177            teta(ij+iim,l)=teta(ij,l)
178         enddo
179      enddo
180
181
182
183c     PRINT *,' Appel test_period avec tetarappel '
184c     CALL  test_period ( ucov,vcov,tetarappel,q,p,phis )
185c     PRINT *,' Appel test_period avec teta '
186c     CALL  test_period ( ucov,vcov,teta,q,p,phis )
187
188c   initialisation d'un traceur sur une colonne
189      j=jjp1*3/4
190      i=iip1/2
191      ij=(j-1)*iip1+i
192      q(ij,:,3)=1.
193
194      return
195      END
196c-----------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.