source: LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90 @ 4516

Last change on this file since 4516 was 4419, checked in by fhourdin, 22 months ago

Lecture possible du relief dans iniacademic

  • 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
File size: 12.1 KB
RevLine 
[1749]1!
2! $Id: iniacademic.F90 1625 2012-05-09 13:14:48Z lguez $
3!
4SUBROUTINE iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
5
[2083]6  USE filtreg_mod, ONLY: inifilr
[4325]7  USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
[4056]8  USE control_mod, ONLY: day_step,planet_type
[2021]9  use exner_hyb_m, only: exner_hyb
10  use exner_milieu_m, only: exner_milieu
[2083]11  USE parallel_lmdz, ONLY: ijb_u, ije_u, ijb_v, ije_v
[1749]12#ifdef CPP_IOIPSL
[2083]13  USE IOIPSL, ONLY: getin
[1749]14#else
15  ! if not using IOIPSL, we still need to use (a local version of) getin
[2083]16  USE ioipsl_getincom, ONLY: getin
[1749]17#endif
18  USE Write_Field
[2597]19  USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm
[2603]20  USE logic_mod, ONLY: iflag_phys, read_start
[4376]21  USE comvert_mod, ONLY: ap, bp, preff, pa, presnivs, pressure_exner
[2601]22  USE temps_mod, ONLY: annee_ref, day_ini, day_ref
[2622]23  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
[4120]24  USE readTracFiles_mod, ONLY: addPhase
[4419]25  use netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID
26  use netcdf, only : NF90_CLOSE, NF90_GET_VAR
[1749]27
[4419]28
[1749]29  !   Author:    Frederic Hourdin      original: 15/01/93
30  ! The forcing defined here is from Held and Suarez, 1994, Bulletin
31  ! of the American Meteorological Society, 75, 1825.
32
33  IMPLICIT NONE
34
35  !   Declararations:
36  !   ---------------
37
38  include "dimensions.h"
39  include "paramet.h"
40  include "comgeom.h"
41  include "academic.h"
42  include "iniprint.h"
43
44  !   Arguments:
45  !   ----------
46
[2083]47  REAL,INTENT(OUT) :: time_0
[1749]48
[2083]49  !   fields
50  REAL,INTENT(OUT) :: vcov(ijb_v:ije_v,llm) ! meridional covariant wind
51  REAL,INTENT(OUT) :: ucov(ijb_u:ije_u,llm) ! zonal covariant wind
52  REAL,INTENT(OUT) :: teta(ijb_u:ije_u,llm) ! potential temperature (K)
53  REAL,INTENT(OUT) :: q(ijb_u:ije_u,llm,nqtot) ! advected tracers (.../kg_of_air)
54  REAL,INTENT(OUT) :: ps(ijb_u:ije_u) ! surface pressure (Pa)
55  REAL,INTENT(OUT) :: masse(ijb_u:ije_u,llm) ! air mass in grid cell (kg)
56  REAL,INTENT(OUT) :: phis(ijb_u:ije_u) ! surface geopotential
[1749]57
58  !   Local:
59  !   ------
60
61  REAL,ALLOCATABLE :: vcov_glo(:,:),ucov_glo(:,:),teta_glo(:,:)
62  REAL,ALLOCATABLE :: q_glo(:,:),masse_glo(:,:),ps_glo(:)
63  REAL,ALLOCATABLE :: phis_glo(:)
64  REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
65  REAL pks(ip1jmp1)                      ! exner au  sol
66  REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
67  REAL phi(ip1jmp1,llm)                  ! geopotentiel
68  REAL ddsin,zsig,tetapv,w_pv  ! variables auxiliaires
69  real tetastrat ! potential temperature in the stratosphere, in K
70  real tetajl(jjp1,llm)
[4120]71  INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent
[1749]72
[4419]73  integer :: nid_relief,varid,ierr
74  real, dimension(iip1,jjp1) :: relief
75
76
[1749]77  REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T
78  REAL k_f,k_c_a,k_c_s         ! Constantes de rappel
79  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
80  LOGICAL ok_pv                ! Polar Vortex
[3976]81  REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex
[1749]82
83  real zz,ran1
84  integer idum
85
[4325]86  REAL zdtvr, tnat, alpha_ideal
[1749]87 
88  character(len=*),parameter :: modname="iniacademic"
89  character(len=80) :: abort_message
90
[2083]91  ! Sanity check: verify that options selected by user are not incompatible
[2087]92  if ((iflag_phys==1).and. .not. read_start) then
[2083]93    write(lunout,*) trim(modname)," error: if read_start is set to ", &
94    " false then iflag_phys should not be 1"
95    write(lunout,*) "You most likely want an aquaplanet initialisation", &
96    " (iflag_phys >= 100)"
97    call abort_gcm(modname,"incompatible iflag_phys==1 and read_start==.false.",1)
98  endif
99 
[1749]100  !-----------------------------------------------------------------------
101  ! 1. Initializations for Earth-like case
102  ! --------------------------------------
103  !
104  ! initialize planet radius, rotation rate,...
105  call conf_planete
106
107  time_0=0.
108  day_ref=1
[3435]109  ! annee_ref=0
[1749]110
111  im         = iim
112  jm         = jjm
113  day_ini    = 1
114  dtvr    = daysec/REAL(day_step)
115  zdtvr=dtvr
116  etot0      = 0.
117  ptot0      = 0.
118  ztot0      = 0.
119  stot0      = 0.
[4056]120  ang0       = 0.
[1749]121
122  if (llm == 1) then
123     ! specific initializations for the shallow water case
124     kappa=1
125  endif
126
127  CALL iniconst
128  CALL inigeom
129  CALL inifilr
130
[3976]131  ! Initialize pressure and mass field if read_start=.false.
132  IF (.NOT. read_start) THEN
133    ! allocate global fields:
134!    allocate(vcov_glo(ip1jm,llm))
[4419]135
[3976]136    allocate(ucov_glo(ip1jmp1,llm))
137    allocate(teta_glo(ip1jmp1,llm))
138    allocate(ps_glo(ip1jmp1))
139    allocate(masse_glo(ip1jmp1,llm))
140    allocate(phis_glo(ip1jmp1))
141
142     ! surface pressure
[4376]143     ps_glo(:)=preff
[4056]144
[4419]145     !------------------------------------------------------------------
146     ! Lecture eventuelle d'un fichier de relief interpollee sur la grille
147     ! du modele.
148     ! On suppose que le fichier relief_in.nc est stoké sur une grille
149     ! iim*jjp1
150     ! Facile a créer à partir de la commande
151     ! cdo remapcon,fichier_output_phys.nc Relief.nc relief_in.nc
152     !------------------------------------------------------------------
153
154     relief=0.
155     ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief)
156     if (ierr.EQ.NF90_NOERR) THEN
157         ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid)
158         if (ierr==NF90_NOERR) THEN
159              ierr=NF90_GET_VAR(nid_relief,varid,relief(1:iim,1:jjp1))
160              relief(iip1,:)=relief(1,:)
161         else
162              CALL abort_gcm ('iniacademic','variable RELIEF pas la',1)
163         endif
164     endif
165     ierr = NF90_CLOSE (nid_relief)
166
167
168     !------------------------------------------------------------------
169     ! Initialisation du geopotentiel au sol et de la pression
170     !------------------------------------------------------------------
171
172     print*,'relief=',minval(relief),maxval(relief),'g=',g
173     do j=1,jjp1
174        do i=1,iip1
175           phis_glo((j-1)*iip1+i)=g*relief(i,j)
176        enddo
177     enddo
178     print*,'phis=',minval(phis),maxval(phis),'g=',g
179
[3976]180     CALL pression ( ip1jmp1, ap, bp, ps_glo, p       )
181     if (pressure_exner) then
182       CALL exner_hyb( ip1jmp1, ps_glo, p, pks, pk )
183     else
184       call exner_milieu(ip1jmp1,ps_glo,p,pks,pk)
185     endif
186     CALL massdair(p,masse_glo)
187  ENDIF
188
[1749]189  if (llm == 1) then
190     ! initialize fields for the shallow water case, if required
191     if (.not.read_start) then
192        phis(ijb_u:ije_u)=0.
193        q(ijb_u:ije_u,1:llm,1:nqtot)=0
194        CALL sw_case_williamson91_6_loc(vcov,ucov,teta,masse,ps)
195     endif
196  endif
197
198  academic_case: if (iflag_phys >= 2) then
199     ! initializations
200
201     ! 1. local parameters
202     ! by convention, winter is in the southern hemisphere
203     ! Geostrophic wind or no wind?
204     ok_geost=.TRUE.
205     CALL getin('ok_geost',ok_geost)
206     ! Constants for Newtonian relaxation and friction
207     k_f=1.                !friction
208     CALL getin('k_j',k_f)
209     k_f=1./(daysec*k_f)
210     k_c_s=4.  !cooling surface
211     CALL getin('k_c_s',k_c_s)
212     k_c_s=1./(daysec*k_c_s)
213     k_c_a=40. !cooling free atm
214     CALL getin('k_c_a',k_c_a)
215     k_c_a=1./(daysec*k_c_a)
216     ! Constants for Teta equilibrium profile
217     teta0=315.     ! mean Teta (S.H. 315K)
218     CALL getin('teta0',teta0)
219     ttp=200.       ! Tropopause temperature (S.H. 200K)
220     CALL getin('ttp',ttp)
221     eps=0.         ! Deviation to N-S symmetry(~0-20K)
222     CALL getin('eps',eps)
223     delt_y=60.     ! Merid Temp. Gradient (S.H. 60K)
224     CALL getin('delt_y',delt_y)
225     delt_z=10.     ! Vertical Gradient (S.H. 10K)
226     CALL getin('delt_z',delt_z)
227     ! Polar vortex
228     ok_pv=.false.
229     CALL getin('ok_pv',ok_pv)
230     phi_pv=-50.            ! Latitude of edge of vortex
231     CALL getin('phi_pv',phi_pv)
232     phi_pv=phi_pv*pi/180.
233     dphi_pv=5.             ! Width of the edge
234     CALL getin('dphi_pv',dphi_pv)
235     dphi_pv=dphi_pv*pi/180.
236     gam_pv=4.              ! -dT/dz vortex (in K/km)
237     CALL getin('gam_pv',gam_pv)
[3976]238     tetanoise=0.005
239     CALL getin('tetanoise',tetanoise)
[1749]240
241     ! 2. Initialize fields towards which to relax
242     ! Friction
243     knewt_g=k_c_a
244     DO l=1,llm
245        zsig=presnivs(l)/preff
246        knewt_t(l)=(k_c_s-k_c_a)*MAX(0.,(zsig-0.7)/0.3)
247        kfrict(l)=k_f*MAX(0.,(zsig-0.7)/0.3)
248     ENDDO
249     DO j=1,jjp1
250        clat4((j-1)*iip1+1:j*iip1)=cos(rlatu(j))**4
251     ENDDO
252
253     ! Potential temperature
254     DO l=1,llm
255        zsig=presnivs(l)/preff
256        tetastrat=ttp*zsig**(-kappa)
257        tetapv=tetastrat
258        IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
259           tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
260        ENDIF
261        DO j=1,jjp1
262           ! Troposphere
263           ddsin=sin(rlatu(j))
264           tetajl(j,l)=teta0-delt_y*ddsin*ddsin+eps*ddsin &
265                -delt_z*(1.-ddsin*ddsin)*log(zsig)
266           if (planet_type=="giant") then
267             tetajl(j,l)=teta0+(delt_y*                   &
268                ((sin(rlatu(j)*3.14159*eps+0.0001))**2)   &
269                / ((rlatu(j)*3.14159*eps+0.0001)**2))     &
270                -delt_z*log(zsig)
271           endif
272           ! Profil stratospherique isotherme (+vortex)
273           w_pv=(1.-tanh((rlatu(j)-phi_pv)/dphi_pv))/2.
274           tetastrat=tetastrat*(1.-w_pv)+tetapv*w_pv             
275           tetajl(j,l)=MAX(tetajl(j,l),tetastrat) 
276        ENDDO
277     ENDDO
278
279     !          CALL writefield('theta_eq',tetajl)
280
281     do l=1,llm
282        do j=1,jjp1
283           do i=1,iip1
284              ij=(j-1)*iip1+i
285              tetarappel(ij,l)=tetajl(j,l)
286           enddo
287        enddo
288     enddo
289
290     ! 3. Initialize fields (if necessary)
291     IF (.NOT. read_start) THEN
292        ! bulk initialization of temperature
[3976]293        IF (iflag_phys>10000) THEN
294        ! Particular case to impose a constant temperature T0=0.01*iflag_phys
295           teta_glo(:,:)= 0.01*iflag_phys/(pk(:,:)/cpp)
296        ELSE
297           teta_glo(:,:)=tetarappel(:,:)
298        ENDIF
[1749]299        ! geopotential
300        CALL geopot(ip1jmp1,teta_glo,pk,pks,phis_glo,phi)
301
302        ! winds
303        if (ok_geost) then
304           call ugeostr(phi,ucov_glo)
305        else
306           ucov_glo(:,:)=0.
307        endif
308        vcov(ijb_v:ije_v,1:llm)=0.
309
310        ! bulk initialization of tracers
311        if (planet_type=="earth") then
312           ! Earth: first two tracers will be water
[4050]313           do iq=1,nqtot
314              q(ijb_u:ije_u,:,iq)=0.
[4120]315              IF(tracers(iq)%name == addPhase('H2O', 'g')) q(ijb_u:ije_u,:,iq)=1.e-10
316              IF(tracers(iq)%name == addPhase('H2O', 'l')) q(ijb_u:ije_u,:,iq)=1.e-15
[2270]317
318              ! CRisi: init des isotopes
319              ! distill de Rayleigh très simplifiée
[4143]320              iName    = tracers(iq)%iso_iName
[4124]321              if (niso <= 0 .OR. iName <= 0) CYCLE
[4056]322              iPhase   = tracers(iq)%iso_iPhase
[4050]323              iqParent = tracers(iq)%iqParent
[4120]324              IF(tracers(iq)%iso_iZone == 0) THEN
[4325]325                 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
326                    CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
327                 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.)
[4120]328              ELSE
[4143]329                 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))
[4120]330              END IF
[1749]331           enddo
332        else
333           q(ijb_u:ije_u,:,:)=0
334        endif ! of if (planet_type=="earth")
335
[4143]336        call check_isotopes(q,ijb_u,ije_u,'iniacademic_loc')
[2270]337
[1749]338        ! add random perturbation to temperature
339        idum  = -1
340        zz = ran1(idum)
341        idum  = 0
342        do l=1,llm
343           do ij=iip2,ip1jm
[3976]344              teta_glo(ij,l)=teta_glo(ij,l)*(1.+tetanoise*ran1(idum))
[1749]345           enddo
346        enddo
347
348        ! maintain periodicity in longitude
349        do l=1,llm
350           do ij=1,ip1jmp1,iip1
351              teta_glo(ij+iim,l)=teta_glo(ij,l)
352           enddo
353        enddo
354
355        ! copy data from global array to local array:
356        teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:)
357        ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:)
358!        vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:)
359        masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
360        ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u)
361        phis(ijb_u:ije_u)=phis_glo(ijb_u:ije_u)
362
363        deallocate(teta_glo)
364        deallocate(ucov_glo)
365!        deallocate(vcov_glo)
366        deallocate(masse_glo)
367        deallocate(ps_glo)
368        deallocate(phis_glo)
369     ENDIF ! of IF (.NOT. read_start)
370  endif academic_case
371
372END SUBROUTINE iniacademic_loc
Note: See TracBrowser for help on using the repository browser.