source: LMDZ6/trunk/libf/dyn3d/iniacademic.F90 @ 4052

Last change on this file since 4052 was 4052, checked in by dcugnet, 2 years ago

Fixes for previous commit:

  • few tracers(:)%nqChilds were errouneously replaced with tarcers(:)%nqDesc
  • minor changes
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.0 KB
Line 
1!
2! $Id: iniacademic.F90 4052 2021-12-26 21:27:36Z dcugnet $
3!
4SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
5
6  USE filtreg_mod, ONLY: inifilr
7  USE infotrac,    ONLY: nqtot,niso_possibles,ok_isotopes,ok_iso_verif,tnat,alpha_ideal, &
8        & iqiso,iso_indnum, tracers
9  USE control_mod, ONLY: day_step,planet_type
10#ifdef CPP_IOIPSL
11  USE IOIPSL, ONLY: getin
12#else
13  ! if not using IOIPSL, we still need to use (a local version of) getin
14  USE ioipsl_getincom, ONLY: getin
15#endif
16  USE Write_Field
17  use exner_hyb_m, only: exner_hyb
18  use exner_milieu_m, only: exner_milieu
19  USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm
20  USE logic_mod, ONLY: iflag_phys, read_start
21  USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner
22  USE temps_mod, ONLY: annee_ref, day_ini, day_ref
23  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
24
25  !   Author:    Frederic Hourdin      original: 15/01/93
26  ! The forcing defined here is from Held and Suarez, 1994, Bulletin
27  ! of the American Meteorological Society, 75, 1825.
28
29  IMPLICIT NONE
30
31  !   Declararations:
32  !   ---------------
33
34  include "dimensions.h"
35  include "paramet.h"
36  include "comgeom.h"
37  include "academic.h"
38  include "iniprint.h"
39
40  !   Arguments:
41  !   ----------
42
43  REAL,INTENT(OUT) :: time_0
44
45  !   fields
46  REAL,INTENT(OUT) :: vcov(ip1jm,llm) ! meridional covariant wind
47  REAL,INTENT(OUT) :: ucov(ip1jmp1,llm) ! zonal covariant wind
48  REAL,INTENT(OUT) :: teta(ip1jmp1,llm) ! potential temperature (K)
49  REAL,INTENT(OUT) :: q(ip1jmp1,llm,nqtot) ! advected tracers (.../kg_of_air)
50  REAL,INTENT(OUT) :: ps(ip1jmp1) ! surface pressure (Pa)
51  REAL,INTENT(OUT) :: masse(ip1jmp1,llm) ! air mass in grid cell (kg)
52  REAL,INTENT(OUT) :: phis(ip1jmp1) ! surface geopotential
53
54  !   Local:
55  !   ------
56
57  REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
58  REAL pks(ip1jmp1)                      ! exner au  sol
59  REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
60  REAL phi(ip1jmp1,llm)                  ! geopotentiel
61  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
62  real tetastrat ! potential temperature in the stratosphere, in K
63  real tetajl(jjp1,llm)
64  INTEGER i,j,l,lsup,ij, iq
65
66  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
67  REAL k_f,k_c_a,k_c_s         ! Constantes de rappel
68  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
69  LOGICAL ok_pv                ! Polar Vortex
70  REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex
71
72  real zz,ran1
73  integer idum, iqParent, iName, iZone, iPhase
74
75  REAL zdtvr
76 
77  character(len=*),parameter :: modname="iniacademic"
78  character(len=80) :: abort_message
79
80
81  ! Sanity check: verify that options selected by user are not incompatible
82  if ((iflag_phys==1).and. .not. read_start) then
83    write(lunout,*) trim(modname)," error: if read_start is set to ", &
84    " false then iflag_phys should not be 1"
85    write(lunout,*) "You most likely want an aquaplanet initialisation", &
86    " (iflag_phys >= 100)"
87    call abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.false.",1)
88  endif
89 
90  !-----------------------------------------------------------------------
91  ! 1. Initializations for Earth-like case
92  ! --------------------------------------
93  !
94  ! initialize planet radius, rotation rate,...
95  call conf_planete
96
97  time_0=0.
98  day_ref=1
99  annee_ref=0
100
101  im         = iim
102  jm         = jjm
103  day_ini    = 1
104  dtvr    = daysec/REAL(day_step)
105  zdtvr=dtvr
106  etot0      = 0.
107  ptot0      = 0.
108  ztot0      = 0.
109  stot0      = 0.
110  ang0       = 0.
111
112  if (llm == 1) then
113     ! specific initializations for the shallow water case
114     kappa=1
115  endif
116
117  CALL iniconst
118  CALL inigeom
119  CALL inifilr
120
121  ! Initialize pressure and mass field if read_start=.false.
122  IF (.NOT. read_start) THEN
123     ! surface pressure
124     if (iflag_phys>2) then
125        ! specific value for CMIP5 aqua/terra planets
126        ! "Specify the initial dry mass to be equivalent to
127        !  a global mean surface pressure (101325 minus 245) Pa."
128        ps(:)=101080. 
129     else
130        ! use reference surface pressure
131        ps(:)=preff
132     endif
133     ! ground geopotential
134     phis(:)=0.
135     CALL pression ( ip1jmp1, ap, bp, ps, p       )
136     if (pressure_exner) then
137       CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
138     else
139       call exner_milieu(ip1jmp1,ps,p,pks,pk)
140     endif
141     CALL massdair(p,masse)
142  ENDIF
143
144  if (llm == 1) then
145     ! initialize fields for the shallow water case, if required
146     if (.not.read_start) then
147        phis(:)=0.
148        q(:,:,:)=0
149        CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
150     endif
151  endif
152
153  academic_case: if (iflag_phys >= 2) then
154     ! initializations
155
156     ! 1. local parameters
157     ! by convention, winter is in the southern hemisphere
158     ! Geostrophic wind or no wind?
159     ok_geost=.TRUE.
160     CALL getin('ok_geost',ok_geost)
161     ! Constants for Newtonian relaxation and friction
162     k_f=1.                !friction
163     CALL getin('k_j',k_f)
164     k_f=1./(daysec*k_f)
165     k_c_s=4.  !cooling surface
166     CALL getin('k_c_s',k_c_s)
167     k_c_s=1./(daysec*k_c_s)
168     k_c_a=40. !cooling free atm
169     CALL getin('k_c_a',k_c_a)
170     k_c_a=1./(daysec*k_c_a)
171     ! Constants for Teta equilibrium profile
172     teta0=315.     ! mean Teta (S.H. 315K)
173     CALL getin('teta0',teta0)
174     ttp=200.       ! Tropopause temperature (S.H. 200K)
175     CALL getin('ttp',ttp)
176     eps=0.         ! Deviation to N-S symmetry(~0-20K)
177     CALL getin('eps',eps)
178     delt_y=60.     ! Merid Temp. Gradient (S.H. 60K)
179     CALL getin('delt_y',delt_y)
180     delt_z=10.     ! Vertical Gradient (S.H. 10K)
181     CALL getin('delt_z',delt_z)
182     ! Polar vortex
183     ok_pv=.false.
184     CALL getin('ok_pv',ok_pv)
185     phi_pv=-50.            ! Latitude of edge of vortex
186     CALL getin('phi_pv',phi_pv)
187     phi_pv=phi_pv*pi/180.
188     dphi_pv=5.             ! Width of the edge
189     CALL getin('dphi_pv',dphi_pv)
190     dphi_pv=dphi_pv*pi/180.
191     gam_pv=4.              ! -dT/dz vortex (in K/km)
192     CALL getin('gam_pv',gam_pv)
193     tetanoise=0.005
194     CALL getin('tetanoise',tetanoise)
195
196
197     ! 2. Initialize fields towards which to relax
198     ! Friction
199     knewt_g=k_c_a
200     DO l=1,llm
201        zsig=presnivs(l)/preff
202        knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)
203        kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)
204     ENDDO
205     DO j=1,jjp1
206        clat4((j-1)*iip1+1:j*iip1)=cos(rlatu(j))**4
207     ENDDO
208
209     ! Potential temperature
210     DO l=1,llm
211        zsig=presnivs(l)/preff
212        tetastrat=ttp*zsig**(-kappa)
213        tetapv=tetastrat
214        IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
215           tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
216        ENDIF
217        DO j=1,jjp1
218           ! Troposphere
219           ddsin=sin(rlatu(j))
220           tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
221                -delt_z*(1.-ddsin*ddsin)*log(zsig)
222           if (planet_type=="giant") then
223             tetajl(j,l)=teta0+(delt_y*                   &
224                ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
225                / ((rlatu(j)*3.14159*eps+0.0001)**2))     &
226                -delt_z*log(zsig)
227           endif
228           ! Profil stratospherique isotherme (+vortex)
229           w_pv=(1.-tanh((rlatu(j)-phi_pv)/dphi_pv))/2.
230           tetastrat=tetastrat*(1.-w_pv)+tetapv*w_pv             
231           tetajl(j,l)=MAX(tetajl(j,l),tetastrat) 
232        ENDDO
233     ENDDO
234
235     !          CALL writefield('theta_eq',tetajl)
236
237     do l=1,llm
238        do j=1,jjp1
239           do i=1,iip1
240              ij=(j-1)*iip1+i
241              tetarappel(ij,l)=tetajl(j,l)
242           enddo
243        enddo
244     enddo
245
246     ! 3. Initialize fields (if necessary)
247     IF (.NOT. read_start) THEN
248        ! bulk initialization of temperature
249
250        IF (iflag_phys>10000) THEN
251        ! Particular case to impose a constant temperature T0=0.01*iflag_physx
252           teta(:,:)= 0.01*iflag_phys/(pk(:,:)/cpp)
253        ELSE
254           teta(:,:)=tetarappel(:,:)
255        ENDIF
256
257        ! geopotential
258        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
259
260        DO l=1,llm
261          print*,'presnivs,play,l',presnivs(l),(pk(1,l)/cpp)**(1./kappa)*preff
262         !pks(ij) = (cpp/preff) * ps(ij)
263         !pk(ij,1) = .5*pks(ij)
264         ! pk = cpp * (p/preff)^kappa
265        ENDDO
266
267        ! winds
268        if (ok_geost) then
269           call ugeostr(phi,ucov)
270        else
271           ucov(:,:)=0.
272        endif
273        vcov(:,:)=0.
274
275        ! bulk initialization of tracers
276        if (planet_type=="earth") then
277           ! Earth: first two tracers will be water
278           do iq=1,nqtot
279              q(:,:,iq)=0.
280!              IF(tracers(iq)%name == 'H2O'//phases_sep//'g') q(:,:,iq)=1.e-10
281!              IF(tracers(iq)%name == 'H2O'//phases_sep//'l') q(:,:,iq)=1.e-15
282              IF(tracers(iq)%name == 'H2Ov') q(:,:,iq)=1.e-10
283              IF(tracers(iq)%name == 'H2Ol') q(:,:,iq)=1.e-15
284
285              ! CRisi: init des isotopes
286              ! distill de Rayleigh très simplifiée
287              iName = tracers(iq)%iso_iName
288              if (.NOT.ok_isotopes .OR. iName <= 0) CYCLE
289              iZone = tracers(iq)%iso_iZone
290              iPhase= tracers(iq)%iso_iPhase
291              iqParent = tracers(iq)%iqParent
292              if (iZone == 0) q(:,:,iq) = q(:,:,iqParent)*tnat(iName) &
293                                        *(q(:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1)
294              if (iZone == 1) q(:,:,iq) = q(:,:,iqiso(iso_indnum(iq),iPhase))
295           enddo
296        else
297           q(:,:,:)=0
298        endif ! of if (planet_type=="earth")
299
300        if (ok_iso_verif) then
301           call check_isotopes_seq(q,1,ip1jmp1,'iniacademic_loc')
302        endif !if (ok_iso_verif) then
303
304        ! add random perturbation to temperature
305        idum  = -1
306        zz = ran1(idum)
307        idum  = 0
308        do l=1,llm
309           do ij=iip2,ip1jm
310              teta(ij,l)=teta(ij,l)*(1.+tetanoise*ran1(idum))
311           enddo
312        enddo
313
314        ! maintain periodicity in longitude
315        do l=1,llm
316           do ij=1,ip1jmp1,iip1
317              teta(ij+iim,l)=teta(ij,l)
318           enddo
319        enddo
320
321     ENDIF ! of IF (.NOT. read_start)
322  endif academic_case
323
324END SUBROUTINE iniacademic
Note: See TracBrowser for help on using the repository browser.