source: LMDZ5/trunk/libf/dyn3dmem/iniacademic.F @ 1660

Last change on this file since 1660 was 1658, checked in by Laurent Fairhead, 12 years ago

Phasage de la dynamique parallele localisee (petite memoire) avec le tronc LMDZ4 (HEAD)
Validation effectuee par comparaison des fichiers de sorties debug (u, v, t, q, masse, etc ...) d'une simulation sans physique
faite avec la version du modele donnee par Y. Meurdesoif et la version phasee avec la r1428 (fin du tronc LMDZ4)


Phasing of the localised (low memory) parallel dynamics package with the LMDZ4 trunk version of LMDZ
Validation consisted in comparing output debug files (u, v, t, q, masse, etc... ) of a no physics simulation
run with the version of the code given by Y. Meurdesoif and this version phased with r1428 (HEAD of the LMDZ4 trunk)

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