source: LMDZ5/branches/LMDZ5_AR5/libf/dyn3d/etat0_netcdf.F90 @ 3172

Last change on this file since 3172 was 1520, checked in by Ehouarn Millour, 14 years ago

Implementation of a different vertical discretization (from/for planets, but
can in principle also be used for Earth).
Choice of vertical discretization is set by flag 'disvert_type';
'disvert_type=1' is Earth standard (default; ie set to 1 if
planet_type=="earth") case.
With 'disvert_type=2', approximate altitude of layers and reference atmospheric
scale height must be given using an input file ("z2sig.def", first line
should give scale height, in km, following lines must specify the altitude,
in km above surface, of mid-layers, one per line; see disvert_noterre.F).

Checked that these changes do not impact on 'bench' results, on Vargas.

EM.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 19.4 KB
Line 
1!
2! $Id: etat0_netcdf.F90 1520 2011-05-23 11:37:09Z idelkadi $
3!
4!-------------------------------------------------------------------------------
5!
6SUBROUTINE etat0_netcdf(ib, masque, phis, letat0)
7!
8!-------------------------------------------------------------------------------
9! Purpose: Creates initial states
10!-------------------------------------------------------------------------------
11! Note: This routine is designed to work for Earth
12!-------------------------------------------------------------------------------
13  USE control_mod
14#ifdef CPP_EARTH
15  USE startvar
16  USE ioipsl
17  USE dimphy
18  USE infotrac
19  USE fonte_neige_mod
20  USE pbl_surface_mod
21  USE phys_state_var_mod
22  USE filtreg_mod
23  USE regr_lat_time_climoz_m, ONLY: regr_lat_time_climoz
24  USE conf_phys_m,            ONLY: conf_phys
25! For parameterization of ozone chemistry:
26  use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
27  use press_coefoz_m, only: press_coefoz
28  use regr_pr_o3_m, only: regr_pr_o3
29  USE netcdf, ONLY : NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
30#endif
31  IMPLICIT NONE
32!-------------------------------------------------------------------------------
33! Arguments:
34#include "dimensions.h"
35#include "paramet.h"
36#include "iniprint.h"
37  LOGICAL,                    INTENT(IN)    :: ib     ! barycentric interpolat.
38  REAL, DIMENSION(iip1,jjp1), INTENT(INOUT) :: masque ! land mask
39  REAL, DIMENSION(iip1,jjp1), INTENT(OUT)   :: phis   ! geopotentiel au sol
40  LOGICAL,                    INTENT(IN)    :: letat0 ! F: masque only required
41#ifndef CPP_EARTH
42  WRITE(lunout,*)'limit_netcdf: Earth-specific routine, needs Earth physics'
43#else
44!-------------------------------------------------------------------------------
45! Local variables:
46#include "comgeom2.h"
47#include "comvert.h"
48#include "comconst.h"
49#include "indicesol.h"
50#include "dimsoil.h"
51#include "temps.h"
52  REAL,    DIMENSION(klon)                 :: tsol, qsol
53  REAL,    DIMENSION(klon)                 :: sn, rugmer, run_off_lic_0
54  REAL,    DIMENSION(iip1,jjp1)            :: orog, rugo, psol
55  REAL,    DIMENSION(iip1,jjp1,llm+1)      :: p3d
56  REAL,    DIMENSION(iip1,jjp1,llm)        :: uvent, t3d, tpot, qsat, qd
57  REAL,    DIMENSION(iip1,jjm ,llm)        :: vvent
58  REAL,    DIMENSION(:,:,:,:), ALLOCATABLE :: q3d
59  REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf, evap
60  REAL,    DIMENSION(klon,nbsrf)           :: frugs, agesno
61  REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
62
63!--- Local variables for sea-ice reading:
64  INTEGER                                  :: iml_lic, jml_lic, llm_tmp
65  INTEGER                                  :: ttm_tmp, iret, fid
66  INTEGER, DIMENSION(1)                    :: itaul
67  REAL,    DIMENSION(1)                    :: lev
68  REAL                                     :: date
69  REAL,    DIMENSION(:,:),   ALLOCATABLE   ::  lon_lic,  lat_lic, fraclic
70  REAL,    DIMENSION(:),     ALLOCATABLE   :: dlon_lic, dlat_lic
71  REAL,    DIMENSION(iip1,jjp1)            :: flic_tmp
72
73!--- Misc
74  CHARACTER(LEN=80)                        :: x, fmt
75  INTEGER                                  :: i, j, l, ji
76  REAL,    DIMENSION(iip1,jjp1,llm)        :: alpha, beta, pk, pls, y
77  REAL,    DIMENSION(ip1jmp1)              :: pks
78
79#include "comdissnew.h"
80#include "serre.h"
81#include "clesphys.h"
82
83  REAL,    DIMENSION(iip1,jjp1,llm)        :: masse
84  INTEGER :: itau, iday
85  REAL    :: xpn, xps, time, phystep
86  REAL,    DIMENSION(iim)                  :: xppn, xpps
87  REAL,    DIMENSION(ip1jmp1,llm)          :: pbaru, phi, w
88  REAL,    DIMENSION(ip1jm  ,llm)          :: pbarv
89  REAL,    DIMENSION(klon)                 :: fder
90
91!--- Local variables for ocean mask reading:
92  INTEGER :: nid_o2a, iml_omask, jml_omask
93  LOGICAL :: couple=.FALSE.
94  REAL,    DIMENSION(:,:), ALLOCATABLE ::  lon_omask, lat_omask, ocemask, ocetmp
95  REAL,    DIMENSION(:),   ALLOCATABLE :: dlon_omask,dlat_omask
96  REAL,    DIMENSION(klon)             :: ocemask_fi
97  INTEGER, DIMENSION(klon-2)           :: isst
98  REAL,    DIMENSION(iim,jjp1)         :: zx_tmp_2d
99  REAL    :: dummy
100  LOGICAL :: ok_newmicro, ok_journe, ok_mensuel, ok_instan, ok_hf
101  LOGICAL :: ok_LES, ok_ade, ok_aie, aerosol_couple, new_aod, callstats
102  INTEGER :: iflag_radia, flag_aerosol
103  REAL    :: bl95_b0, bl95_b1, fact_cldcon, facttemps, ratqsbas, ratqshaut
104  REAL    :: tau_ratqs
105  INTEGER :: iflag_cldcon, iflag_ratqs, iflag_coupl, iflag_clos, iflag_wake
106  INTEGER :: iflag_thermals, nsplit_thermals
107  INTEGER :: iflag_thermals_ed, iflag_thermals_optflux
108  REAL    :: tau_thermals, solarlong0,  seuil_inversion
109  INTEGER :: read_climoz ! read ozone climatology
110!  Allowed values are 0, 1 and 2
111!     0: do not read an ozone climatology
112!     1: read a single ozone climatology that will be used day and night
113!     2: read two ozone climatologies, the average day and night
114!     climatology and the daylight climatology
115!-------------------------------------------------------------------------------
116  REAL    :: alp_offset
117  logical found
118
119!--- Constants
120  pi     = 4. * ATAN(1.)
121  rad    = 6371229.
122  daysec = 86400.
123  omeg   = 2.*pi/daysec
124  g      = 9.8
125  kappa  = 0.2857143
126  cpp    = 1004.70885
127  preff  = 101325.
128  pa     = 50000.
129  jmp1   = jjm + 1
130
131!--- CONSTRUCT A GRID
132  CALL conf_phys(  ok_journe, ok_mensuel, ok_instan, ok_hf, ok_LES,     &
133                   callstats,                                           &
134                   solarlong0,seuil_inversion,                          &
135                   fact_cldcon, facttemps,ok_newmicro,iflag_radia,      &
136                   iflag_cldcon,                                        &
137                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
138                   ok_ade, ok_aie, aerosol_couple,                      &
139                   flag_aerosol, new_aod,                               &
140                   bl95_b0, bl95_b1,                                    &
141                   read_climoz,                                         &
142                   alp_offset)
143
144! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value)
145  co2_ppm0 = co2_ppm
146
147  dtvr   = daysec/FLOAT(day_step)
148  WRITE(lunout,*)'dtvr',dtvr
149
150  CALL iniconst()
151  CALL inigeom()
152
153!--- Initializations for tracers
154  CALL infotrac_init
155  ALLOCATE(q3d(iip1,jjp1,llm,nqtot))
156
157  CALL inifilr()
158  CALL phys_state_var_init(read_climoz)
159
160  rlat(1) = ASIN(1.0)
161  DO j=2,jjm; rlat((j-2)*iim+2:(j-1)*iim+1)=rlatu(j);     END DO
162  rlat(klon) = - ASIN(1.0)
163  rlat(:)=rlat(:)*(180.0/pi)
164
165  rlon(1) = 0.0
166  DO j=2,jjm; rlon((j-2)*iim+2:(j-1)*iim+1)=rlonv(1:iim); END DO
167  rlon(klon) = 0.0
168  rlon(:)=rlon(:)*(180.0/pi)
169
170! For a coupled simulation, the ocean mask from ocean model is used to compute
171! the weights an to insure ocean fractions are the same for atmosphere and ocean
172! Otherwise, mask is created using Relief file.
173
174  WRITE(lunout,*)'Essai de lecture masque ocean'
175  iret = NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)
176  IF(iret/=NF90_NOERR) THEN
177    WRITE(lunout,*)'ATTENTION!! pas de fichier o2a.nc trouve'
178    WRITE(lunout,*)'Run force'
179    x='masque'
180    masque(:,:)=0.0
181    CALL startget_phys2d(x, iip1, jjp1, rlonv, rlatu, masque, 0.0, jjm, &
182   &              rlonu, rlatv, ib)
183    WRITE(lunout,*)'MASQUE construit : Masque'
184    WRITE(lunout,'(97I1)') nINT(masque)
185    CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, zmasq)
186    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
187    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.
188  ELSE
189    WRITE(lunout,*)'ATTENTION!! fichier o2a.nc trouve'
190    WRITE(lunout,*)'Run couple'
191    couple=.true.
192    iret=NF90_CLOSE(nid_o2a)
193    CALL flininfo("o2a.nc", iml_omask, jml_omask, llm_tmp, ttm_tmp, nid_o2a)
194    IF(iml_omask/=iim .OR.jml_omask/=jjp1) THEN
195      WRITE(lunout,*)'Dimensions non compatibles pour masque ocean'
196      WRITE(lunout,*)'iim = ',iim,' iml_omask = ',iml_omask
197      WRITE(lunout,*)'jjp1 = ',jjp1,' jml_omask = ',jml_omask
198      CALL abort_gcm('etat0_netcdf','Dimensions non compatibles pour masque oc&
199     &ean',1)
200    END IF
201    ALLOCATE(   ocemask(iml_omask,jml_omask),   ocetmp(iml_omask,jml_omask))
202    ALLOCATE( lon_omask(iml_omask,jml_omask),lat_omask(iml_omask,jml_omask))
203    ALLOCATE(dlon_omask(iml_omask),         dlat_omask(jml_omask))
204    CALL flinopen("o2a.nc", .FALSE., iml_omask, jml_omask, llm_tmp, lon_omask,&
205   &              lat_omask, lev, ttm_tmp, itaul, date, dt, fid)
206    CALL flinget(fid, 'OceMask', iml_omask, jml_omask, llm_tmp, ttm_tmp, &
207   &              1, 1, ocetmp)
208    CALL flinclo(fid)
209    dlon_omask(1:iml_omask) = lon_omask(1:iml_omask,1)
210    dlat_omask(1:jml_omask) = lat_omask(1,1:jml_omask)
211    ocemask = ocetmp
212    IF(dlat_omask(1)<dlat_omask(jml_omask)) THEN
213      DO j=1,jml_omask
214        ocemask(:,j) = ocetmp(:,jml_omask-j+1)
215      END DO
216    END IF
217!
218! Ocean mask to physical grid
219!*******************************************************************************
220    WRITE(lunout,*)'ocemask '
221    WRITE(fmt,"(i4,'i1)')")iml_omask ; fmt='('//ADJUSTL(fmt)
222    WRITE(lunout,fmt)int(ocemask)
223    ocemask_fi(1)=ocemask(1,1)
224    DO j=2,jjm; ocemask_fi((j-2)*iim+2:(j-1)*iim+1)=ocemask(1:iim,j); END DO
225    ocemask_fi(klon)=ocemask(1,jjp1)
226    zmasq=1.-ocemask_fi
227  END IF
228
229  CALL gr_fi_dyn(1,klon,iip1,jjp1,zmasq,masque)
230
231  ! The startget calls need to be replaced by a call to restget to get the
232  ! values in the restart file
233  x = 'relief'; orog(:,:) = 0.0
234  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, orog, 0.0,jjm,rlonu,rlatv,ib,&
235 &               masque)
236
237  x = 'rugosite'; rugo(:,:) = 0.0
238  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu, rugo, 0.0,jjm, rlonu,rlatv,ib)
239!  WRITE(lunout,'(49I1)') INT(orog(:,:)*10)
240!  WRITE(lunout,'(49I1)') INT(rugo(:,:)*10)
241
242! Sub-surfaces initialization
243!*******************************************************************************
244  pctsrf=0.
245  x = 'psol'; psol(:,:) = 0.0
246  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,psol,0.0,jjm,rlonu,rlatv,ib)
247!  WRITE(lunout,*) 'PSOL :', psol(10,20)
248!  WRITE(lunout,*) ap(:), bp(:)
249
250! Mid-levels pressure computation
251!*******************************************************************************
252  CALL pression(ip1jmp1, ap, bp, psol, p3d)
253  if (disvert_type.eq.1) then
254    CALL exner_hyb(ip1jmp1, psol, p3d, alpha, beta, pks, pk, y)
255  else ! we assume that we are in the disvert_type==2 case
256    CALL exner_milieu(ip1jmp1,psol,p3d,beta,pks,pk,y)
257  endif
258  pls(:,:,:)=preff*(pk(:,:,:)/cpp)**(1./kappa)
259!  WRITE(lunout,*) 'P3D :', p3d(10,20,:)
260!  WRITE(lunout,*) 'PK:',    pk(10,20,:)
261!  WRITE(lunout,*) 'PLS :', pls(10,20,:)
262
263  x = 'surfgeo'; phis(:,:) = 0.0
264  CALL startget_phys2d(x,iip1,jjp1,rlonv,rlatu,phis, 0.0,jjm, rlonu,rlatv,ib)
265
266  x = 'u';    uvent(:,:,:) = 0.0
267  CALL startget_dyn(x,rlonu,rlatu,pls,y,uvent,0.0,  &
268 &                  rlonv,rlatv,ib)
269
270  x = 'v';    vvent(:,:,:) = 0.0
271  CALL startget_dyn(x, rlonv,rlatv,pls(:, :jjm, :),y(:, :jjm, :),vvent,0.0, &
272 &                  rlonu,rlatu(:jjm),ib)
273
274  x = 't';    t3d(:,:,:) = 0.0
275  CALL startget_dyn(x,rlonv,rlatu,pls,y,t3d,0.0,    &
276 &                  rlonu,rlatv,ib)
277
278  x = 'tpot'; tpot(:,:,:) = 0.0
279  CALL startget_dyn(x,rlonv,rlatu,pls,pk,tpot,0.0,  &
280 &                  rlonu,rlatv,ib)
281
282  WRITE(lunout,*) 'T3D min,max:',minval(t3d(:,:,:)),maxval(t3d(:,:,:))
283  WRITE(lunout,*) 'PLS min,max:',minval(pls(:,:,:)),maxval(pls(:,:,:))
284
285! Humidity at saturation computation
286!*******************************************************************************
287  WRITE(lunout,*) 'avant q_sat'
288  CALL q_sat(llm*jjp1*iip1, t3d, pls, qsat)
289  WRITE(lunout,*) 'apres q_sat'
290  WRITE(lunout,*) 'QSAT min,max:',minval(qsat(:,:,:)),maxval(qsat(:,:,:))
291!  WRITE(lunout,*) 'QSAT :',qsat(10,20,:)
292
293  x = 'q';    qd (:,:,:) = 0.0
294  CALL startget_dyn(x,rlonv,rlatu,pls,qsat,qd,0.0, rlonu,rlatv,ib)
295  q3d(:,:,:,:) = 0.0 ; q3d(:,:,:,1) = qd(:,:,:)
296
297! Parameterization of ozone chemistry:
298! Look for ozone tracer:
299  i = 1
300  DO
301    found = tname(i)=="O3" .OR. tname(i)=="o3"
302    if (found .or. i == nqtot) exit
303    i = i + 1
304  end do
305  if (found) then
306    call regr_lat_time_coefoz
307    call press_coefoz
308    call regr_pr_o3(p3d, q3d(:, :, :, i))
309!   Convert from mole fraction to mass fraction:
310    q3d(:, :, :, i) = q3d(:, :, :, i)  * 48. / 29.
311  end if
312
313!--- OZONE CLIMATOLOGY
314  IF(read_climoz>=1) CALL regr_lat_time_climoz(read_climoz)
315
316  x = 'tsol'; tsol(:) = 0.0
317  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,tsol,0.0,jjm,rlonu,rlatv,ib)
318
319  x = 'qsol';  qsol(:) = 0.0
320  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,qsol,0.0,jjm,rlonu,rlatv,ib)
321
322  x = 'snow';  sn(:) = 0.0
323  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,sn,0.0,jjm,rlonu,rlatv,ib)
324
325  x = 'rads';  radsol(:) = 0.0
326  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,radsol,0.0,jjm,rlonu,rlatv,ib)
327
328  x = 'rugmer'; rugmer(:) = 0.0
329  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,rugmer,0.0,jjm,rlonu,rlatv,ib)
330
331  x = 'zmea';  zmea(:) = 0.0
332  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zmea,0.0,jjm,rlonu,rlatv,ib)
333
334  x = 'zstd';  zstd(:) = 0.0
335  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zstd,0.0,jjm,rlonu,rlatv,ib)
336
337  x = 'zsig';  zsig(:) = 0.0
338  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zsig,0.0,jjm,rlonu,rlatv,ib)
339
340  x = 'zgam';  zgam(:) = 0.0
341  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zgam,0.0,jjm,rlonu,rlatv,ib)
342
343  x = 'zthe';  zthe(:) = 0.0
344  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zthe,0.0,jjm,rlonu,rlatv,ib)
345
346  x = 'zpic';  zpic(:) = 0.0
347  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zpic,0.0,jjm,rlonu,rlatv,ib)
348
349  x = 'zval';  zval(:) = 0.0
350  CALL startget_phys1d(x,iip1,jjp1,rlonv,rlatu,klon,zval,0.0,jjm,rlonu,rlatv,ib)
351
352!  WRITE(lunout,'(48I3)') 'TSOL :', INT(tsol(2:klon)-273)
353
354! Soil ice file reading for soil fraction and soil ice fraction
355!*******************************************************************************
356  CALL flininfo("landiceref.nc", iml_lic, jml_lic, llm_tmp, ttm_tmp, fid)
357  ALLOCATE( lat_lic(iml_lic,jml_lic),lon_lic(iml_lic, jml_lic))
358  ALLOCATE(dlat_lic(jml_lic),       dlon_lic(iml_lic))
359  ALLOCATE( fraclic(iml_lic,jml_lic))
360  CALL flinopen("landiceref.nc", .FALSE., iml_lic, jml_lic, llm_tmp,  &
361 &               lon_lic, lat_lic, lev, ttm_tmp, itaul, date, dt, fid)
362  CALL flinget(fid, 'landice', iml_lic, jml_lic, llm_tmp, ttm_tmp, 1,1, fraclic)
363  CALL flinclo(fid)
364
365! Interpolation on model T-grid
366!*******************************************************************************
367  WRITE(lunout,*)'dimensions de landice iml_lic, jml_lic : ',iml_lic,jml_lic
368! conversion if coordinates are in degrees
369  IF(MAXVAL(lon_lic)>pi) lon_lic=lon_lic*pi/180.
370  IF(MAXVAL(lat_lic)>pi) lat_lic=lat_lic*pi/180.
371  dlon_lic(:)=lon_lic(:,1)
372  dlat_lic(:)=lat_lic(1,:)
373  CALL grille_m( iml_lic, jml_lic, dlon_lic, dlat_lic, fraclic, iim,jjp1,   &
374 &               rlonv, rlatu, flic_tmp(1:iim,:) )
375  flic_tmp(iip1,:)=flic_tmp(1,:)
376
377!--- To the physical grid
378  CALL gr_dyn_fi(1, iip1, jjp1, klon, flic_tmp, pctsrf(:,is_lic))
379
380!--- Adequation with soil/sea mask
381  WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
382  WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.
383  pctsrf(:,is_ter)=zmasq(:)
384  DO ji=1,klon
385    IF(zmasq(ji)>EPSFRA) THEN
386      IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
387        pctsrf(ji,is_lic)=zmasq(ji)
388        pctsrf(ji,is_ter)=0.
389      ELSE
390        pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
391        IF(pctsrf(ji,is_ter)<EPSFRA) THEN
392          pctsrf(ji,is_ter)=0.
393          pctsrf(ji,is_lic)=zmasq(ji)
394        END IF
395      END IF
396    END IF
397  END DO
398
399! sub-surface ocean and sea ice (sea ice set to zero for start)
400!*******************************************************************************
401  pctsrf(:,is_oce)=(1.-zmasq(:))
402  WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
403  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
404  isst=0
405  WHERE(pctsrf(2:klon-1,is_oce)>0.) isst=1
406
407! It is checked that the sub-surfaces sum is equal to 1
408!*******************************************************************************
409  ji=COUNT((ABS(SUM(pctsrf(:,:),dim=2))-1.0)>EPSFRA)
410  IF(ji/=0) WRITE(lunout,*) 'pb repartition sous maille pour ',ji,' points'
411  CALL gr_fi_ecrit(1, klon, iim, jjp1, zmasq, zx_tmp_2d)
412!  WRITE(fmt,"(i3,')')")iim; fmt='(i'//ADJUSTL(fmt)
413!  WRITE(lunout,*)'zmasq = '
414!  WRITE(lunout,TRIM(fmt))NINT(zx_tmp_2d)
415  CALL gr_fi_dyn(1, klon, iip1, jjp1, zmasq, masque)
416  WRITE(fmt,"(i4,'i1)')")iip1 ; fmt='('//ADJUSTL(fmt)
417  WRITE(lunout,*) 'MASQUE construit : Masque'
418  WRITE(lunout,TRIM(fmt))NINT(masque(:,:))
419
420! Intermediate computation
421!*******************************************************************************
422  CALL massdair(p3d,masse)
423  WRITE(lunout,*)' ALPHAX ',alphax
424  DO l=1,llm
425    xppn(:)=aire(1:iim,1   )*masse(1:iim,1   ,l)
426    xpps(:)=aire(1:iim,jjp1)*masse(1:iim,jjp1,l)
427    xpn=SUM(xppn)/apoln
428    xps=SUM(xpps)/apols
429    masse(:,1   ,l)=xpn
430    masse(:,jjp1,l)=xps
431  END DO
432  q3d(iip1,:,:,:)=q3d(1,:,:,:)
433  phis(iip1,:) = phis(1,:)
434
435  IF(.NOT.letat0) RETURN
436
437! Writing
438!*******************************************************************************
439  CALL inidissip(lstardis,nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,tetatemp)
440  WRITE(lunout,*)'sortie inidissip'
441  itau=0
442  itau_dyn=0
443  itau_phy=0
444  iday=dayref+itau/day_step
445  time=FLOAT(itau-(iday-dayref)*day_step)/day_step
446  IF(time>1.) THEN
447   time=time-1
448   iday=iday+1
449  END IF
450  day_ref=dayref
451  annee_ref=anneeref
452
453  CALL geopot( ip1jmp1, tpot, pk, pks, phis, phi )
454  WRITE(lunout,*)'sortie geopot'
455
456  CALL caldyn0( itau, uvent, vvent, tpot, psol, masse, pk, phis,               &
457                phi,  w, pbaru, pbarv, time+iday-dayref)
458  WRITE(lunout,*)'sortie caldyn0'     
459  CALL dynredem0( "start.nc", dayref, phis)
460  WRITE(lunout,*)'sortie dynredem0'
461  CALL dynredem1( "start.nc", 0.0, vvent, uvent, tpot, q3d, masse, psol)
462  WRITE(lunout,*)'sortie dynredem1'
463
464! Physical initial state writting
465!*******************************************************************************
466  WRITE(lunout,*)'phystep ',dtvr,iphysiq,nbapp_rad
467  phystep   = dtvr * FLOAT(iphysiq)
468  radpas    = NINT (86400./phystep/ FLOAT(nbapp_rad) )
469  WRITE(lunout,*)'phystep =', phystep, radpas
470
471! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
472!*******************************************************************************
473  DO i=1,nbsrf; ftsol(:,i) = tsol; END DO
474  DO i=1,nbsrf; snsrf(:,i) = sn;   END DO
475  falb1(:,is_ter) = 0.08; falb1(:,is_lic) = 0.6
476  falb1(:,is_oce) = 0.5;  falb1(:,is_sic) = 0.6
477  falb2 = falb1
478  evap(:,:) = 0.
479  DO i=1,nbsrf; qsolsrf(:,i)=150.; END DO
480  DO i=1,nbsrf; DO j=1,nsoilmx; tsoil(:,j,i) = tsol; END DO; END DO
481  rain_fall = 0.; snow_fall = 0.
482  solsw = 165.;   sollw = -53.
483  t_ancien = 273.15
484  q_ancien = 0.
485  agesno = 0.
486  frugs(:,is_oce) = rugmer(:)
487  frugs(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
488  frugs(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
489  frugs(:,is_sic) = 0.001
490  fder = 0.0
491  clwcon = 0.0
492  rnebcon = 0.0
493  ratqs = 0.0
494  run_off_lic_0 = 0.0
495  rugoro = 0.0
496
497! Before phyredem calling, surface modules and values to be saved in startphy.nc
498! are initialized
499!*******************************************************************************
500  dummy = 1.0
501  pbl_tke(:,:,:) = 1.e-8
502  zmax0(:) = 40.
503  f0(:) = 1.e-5
504  ema_work1(:,:) = 0.
505  ema_work2(:,:) = 0.
506  wake_deltat(:,:) = 0.
507  wake_deltaq(:,:) = 0.
508  wake_s(:) = 0.
509  wake_cstar(:) = 0.
510  wake_fip(:) = 0.
511  wake_pe = 0.
512  fm_therm = 0.
513  entr_therm = 0.
514  detr_therm = 0.
515
516  CALL fonte_neige_init(run_off_lic_0)
517  CALL pbl_surface_init( qsol, fder, snsrf, qsolsrf, evap, frugs, agesno, tsoil )
518  CALL phyredem( "startphy.nc" )
519
520!  WRITE(lunout,*)'CCCCCCCCCCCCCCCCCC REACTIVER SORTIE VISU DANS ETAT0'
521!  WRITE(lunout,*)'entree histclo'
522  CALL histclo()
523
524#endif
525!#endif of #ifdef CPP_EARTH
526  RETURN
527
528END SUBROUTINE etat0_netcdf
529!
530!-------------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.