source: LMDZ4/trunk/libf/dyn3dpar/iniacademic.F

Last change on this file was 1403, checked in by Laurent Fairhead, 14 years ago

Merged LMDZ4V5.0-dev branch changes r1292:r1399 to trunk.

Validation:
Validation consisted in compiling the HEAD revision of the trunk,
LMDZ4V5.0-dev branch and the merged sources and running different
configurations on local and SX8 machines comparing results.

Local machine: bench configuration, 32x24x11, gfortran

  • IPSLCM5A configuration (comparison between trunk and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent
  • MH07 configuration, new physics package (comparison between LMDZ4V5.0-dev branch and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent

SX8 machine (brodie), 96x95x39 on 4 processors:

  • IPSLCM5A configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent
  • MH07 configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent

Changes to the makegcm and create_make_gcm scripts to take into account
main programs in F90 files


Fusion de la branche LMDZ4V5.0-dev (r1292:r1399) au tronc principal

Validation:
La validation a consisté à compiler la HEAD de le trunk et de la banche
LMDZ4V5.0-dev et les sources fusionnées et de faire tourner le modéle selon
différentes configurations en local et sur SX8 et de comparer les résultats

En local: 32x24x11, config bench/gfortran

  • pour une config IPSLCM5A (comparaison tronc/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux (à part sur RN et Pb)
    • fichiers histoire égaux
  • pour une config nlle physique (MH07) (comparaison LMDZ4v5.0-dev/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux
    • fichiers histoire équivalents

Sur brodie, 96x95x39 sur 4 proc:

  • pour une config IPSLCM5A:
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc
  • pour une config MH07
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc

Changement sur makegcm et create_make-gcm pour pouvoir prendre en compte des
programmes principaux en *F90

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.7 KB
Line 
1!
2! $Id: iniacademic.F 1403 2010-07-01 09:02:53Z crisi $
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.