source: LMDZ4/branches/LMDZ4V5.0-LF/libf/dyn3d/iniacademic.F @ 5017

Last change on this file since 5017 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper


General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.1 KB
Line 
1!
2! $Id: iniacademic.F 1299 2010-01-20 14:27:21Z dcugnet $
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
50c   Arguments:
51c   ----------
52
53      real time_0
54
55c   variables dynamiques
56      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
57      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
58      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
59      REAL ps(ip1jmp1)                       ! pression  au sol
60      REAL masse(ip1jmp1,llm)                ! masse d'air
61      REAL phis(ip1jmp1)                     ! geopotentiel au sol
62
63c   Local:
64c   ------
65
66      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
67      REAL pks(ip1jmp1)                      ! exner au  sol
68      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
69      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
70      REAL phi(ip1jmp1,llm)                  ! geopotentiel
71      REAL ddsin,tetarappelj,tetarappell,zsig
72      real tetajl(jjp1,llm)
73      INTEGER i,j,l,lsup,ij
74
75      real zz,ran1
76      integer idum
77
78      REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm),zdtvr
79
80c-----------------------------------------------------------------------
81! 1. Initializations for Earth-like case
82! --------------------------------------
83      if (planet_type=="earth") then
84c
85        time_0=0.
86        day_ref=0
87        annee_ref=0
88
89        im         = iim
90        jm         = jjm
91        day_ini    = 0
92        omeg       = 4.*asin(1.)/86400.
93        rad    = 6371229.
94        g      = 9.8
95        daysec = 86400.
96        dtvr    = daysec/REAL(day_step)
97        zdtvr=dtvr
98        kappa  = 0.2857143
99        cpp    = 1004.70885
100        preff     = 101325.
101        pa        =  50000.
102        etot0      = 0.
103        ptot0      = 0.
104        ztot0      = 0.
105        stot0      = 0.
106        ang0       = 0.
107
108        CALL iniconst
109        CALL inigeom
110        CALL inifilr
111
112        ps=0.
113        phis=0.
114c---------------------------------------------------------------------
115
116        taurappel=10.*daysec
117
118c---------------------------------------------------------------------
119c   Calcul de la temperature potentielle :
120c   --------------------------------------
121
122        DO l=1,llm
123         zsig=ap(l)/preff+bp(l)
124         if (zsig.gt.0.3) then
125           lsup=l
126           tetarappell=1./8.*(-log(zsig)-.5)
127           DO j=1,jjp1
128             ddsin=sin(rlatu(j))-sin(pi/20.)
129             tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
130           ENDDO
131          else
132c   Choix isotherme au-dessus de 300 mbar
133           do j=1,jjp1
134             tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
135           enddo
136          endif ! of if (zsig.gt.0.3)
137        ENDDO ! of DO l=1,llm
138
139        do l=1,llm
140           do j=1,jjp1
141              do i=1,iip1
142                 ij=(j-1)*iip1+i
143                 tetarappel(ij,l)=tetajl(j,l)
144              enddo
145           enddo
146        enddo
147
148c       call dump2d(jjp1,llm,tetajl,'TEQ   ')
149
150        ps=1.e5
151        phis=0.
152        CALL pression ( ip1jmp1, ap, bp, ps, p       )
153        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
154        CALL massdair(p,masse)
155
156c  intialisation du vent et de la temperature
157        teta(:,:)=tetarappel(:,:)
158        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
159        call ugeostr(phi,ucov)
160        vcov=0.
161        q(:,:,1   )=1.e-10
162        q(:,:,2   )=1.e-15
163        q(:,:,3:nqtot)=0.
164
165
166c   perturbation aleatoire sur la temperature
167        idum  = -1
168        zz = ran1(idum)
169        idum  = 0
170        do l=1,llm
171           do ij=iip2,ip1jm
172              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
173           enddo
174        enddo
175
176        do l=1,llm
177           do ij=1,ip1jmp1,iip1
178              teta(ij+iim,l)=teta(ij,l)
179           enddo
180        enddo
181
182
183
184c     PRINT *,' Appel test_period avec tetarappel '
185c     CALL  test_period ( ucov,vcov,tetarappel,q,p,phis )
186c     PRINT *,' Appel test_period avec teta '
187c     CALL  test_period ( ucov,vcov,teta,q,p,phis )
188
189c   initialisation d'un traceur sur une colonne
190        j=jjp1*3/4
191        i=iip1/2
192        ij=(j-1)*iip1+i
193        q(ij,:,3)=1.
194     
195      else
196        write(lunout,*)"iniacademic: planet types other than earth",
197     &                 " not implemented (yet)."
198        stop
199      endif ! of if (planet_type=="earth")
200      return
201      END
202c-----------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.