/[lmdze]/trunk/dyn3d/etat0.f90
ViewVC logotype

Diff of /trunk/dyn3d/etat0.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/Sources/dyn3d/etat0.f revision 156 by guez, Thu Jul 16 17:39:10 2015 UTC trunk/dyn3d/etat0.f revision 254 by guez, Mon Feb 5 10:39:38 2018 UTC
# Line 20  contains Line 20  contains
20      use caldyn0_m, only: caldyn0      use caldyn0_m, only: caldyn0
21      use comconst, only: cpp, kappa, iniconst      use comconst, only: cpp, kappa, iniconst
22      use comgeom, only: aire_2d, apoln, apols, cu_2d, cv_2d, inigeom      use comgeom, only: aire_2d, apoln, apols, cu_2d, cv_2d, inigeom
23        use conf_gcm_m, only: nday
24      use dimens_m, only: iim, jjm, llm, nqmx      use dimens_m, only: iim, jjm, llm, nqmx
25      use dimphy, only: zmasq      use dimphy, only: zmasq
26      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
# Line 32  contains Line 33  contains
33      use fxhyp_m, only: fxhyp      use fxhyp_m, only: fxhyp
34      use fyhyp_m, only: fyhyp      use fyhyp_m, only: fyhyp
35      use geopot_m, only: geopot      use geopot_m, only: geopot
36      use grid_atob, only: grille_m      use grille_m_m, only: grille_m
37      use grid_change, only: init_dyn_phy, dyn_phy      use grid_change, only: init_dyn_phy, dyn_phy
38      use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra      use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra
39      use iniadvtrac_m, only: iniadvtrac      use iniadvtrac_m, only: iniadvtrac
40      use inifilr_m, only: inifilr      use inifilr_m, only: inifilr
41      use massdair_m, only: massdair      use massdair_m, only: massdair
42      use netcdf, only: nf90_nowrite      use netcdf, only: nf90_nowrite
43      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, &      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, nf95_put_var, &
44           nf95_inq_varid, nf95_open           nf95_inq_varid, nf95_open
45      use nr_util, only: pi, assert      use nr_util, only: pi, assert
46      use paramet_m, only: ip1jm, ip1jmp1      use phyetat0_m, only: rlat, rlon, itau_phy
47      use phyetat0_m, only: rlat, rlon      use phyredem0_m, only: phyredem0, ncid_restartphy
48      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
49      use q_sat_m, only: q_sat      use q_sat_m, only: q_sat
50      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
# Line 52  contains Line 53  contains
53      USE start_init_orog_m, only: start_init_orog, mask      USE start_init_orog_m, only: start_init_orog, mask
54      use start_init_phys_m, only: start_init_phys      use start_init_phys_m, only: start_init_phys
55      use start_inter_3d_m, only: start_inter_3d      use start_inter_3d_m, only: start_inter_3d
     use temps, only: itau_phy  
56      use test_disvert_m, only: test_disvert      use test_disvert_m, only: test_disvert
57      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
58    
# Line 70  contains Line 70  contains
70      ! and pressure level "pls(i, j, l)".)      ! and pressure level "pls(i, j, l)".)
71    
72      real qsat(iim + 1, jjm + 1, llm) ! mass fraction of saturating water vapor      real qsat(iim + 1, jjm + 1, llm) ! mass fraction of saturating water vapor
     REAL sn(klon)  
73      REAL qsolsrf(klon, nbsrf), snsrf(klon, nbsrf)      REAL qsolsrf(klon, nbsrf), snsrf(klon, nbsrf)
74      REAL albe(klon, nbsrf), evap(klon, nbsrf)      REAL albe(klon, nbsrf), evap(klon, nbsrf)
75      REAL tsoil(klon, nsoilmx, nbsrf)      REAL tsoil(klon, nsoilmx, nbsrf)
76      REAL radsol(klon), rain_fall(klon), snow_fall(klon)      REAL null_array(klon)
77      REAL solsw(klon), sollw(klon), fder(klon)      REAL solsw(klon), sollw(klon)
78      !IM "slab" ocean      !IM "slab" ocean
     real seaice(klon) ! kg m-2  
79      REAL frugs(klon, nbsrf), agesno(klon, nbsrf)      REAL frugs(klon, nbsrf), agesno(klon, nbsrf)
80      REAL rugmer(klon)      REAL rugmer(klon)
81      real, dimension(iim + 1, jjm + 1):: zmea_2d, zstd_2d, zsig_2d, zgam_2d      real, dimension(iim + 1, jjm + 1):: zmea_2d, zstd_2d, zsig_2d, zgam_2d
# Line 88  contains Line 86  contains
86      REAL zthe(klon)      REAL zthe(klon)
87      REAL zpic(klon), zval(klon)      REAL zpic(klon), zval(klon)
88      REAL t_ancien(klon, llm), q_ancien(klon, llm)      REAL t_ancien(klon, llm), q_ancien(klon, llm)
     REAL run_off_lic_0(klon)  
89      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)
90    
91      ! D\'eclarations pour lecture glace de mer :      ! D\'eclarations pour lecture glace de mer :
92      INTEGER iml_lic, jml_lic      INTEGER iml_lic, jml_lic
93      INTEGER ncid, varid      INTEGER ncid, varid
94      REAL, pointer:: dlon_lic(:), dlat_lic(:)      REAL, ALLOCATABLE:: dlon_lic(:), dlat_lic(:)
95      REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice      REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice
96      REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary      REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary
97    
# Line 102  contains Line 99  contains
99    
100      REAL pk(iim + 1, jjm + 1, llm) ! fonction d'Exner aux milieux des couches      REAL pk(iim + 1, jjm + 1, llm) ! fonction d'Exner aux milieux des couches
101      real pks(iim + 1, jjm + 1)      real pks(iim + 1, jjm + 1)
   
102      REAL masse(iim + 1, jjm + 1, llm)      REAL masse(iim + 1, jjm + 1, llm)
103      REAL phi(iim + 1, jjm + 1, llm)      REAL phi(iim + 1, jjm + 1, llm)
     REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)  
     REAL w(iim + 1, jjm + 1, llm)  
   
104      real sig1(klon, llm) ! section adiabatic updraft      real sig1(klon, llm) ! section adiabatic updraft
105      real w01(klon, llm) ! vertical velocity within adiabatic updraft      real w01(klon, llm) ! vertical velocity within adiabatic updraft
106    
# Line 221  contains Line 214  contains
214         q(:, :, :, 5) = q(:, :, :, 5) * 48. / 29.         q(:, :, :, 5) = q(:, :, :, 5) * 48. / 29.
215      end if      end if
216    
217      sn = 0. ! snow      null_array = 0.
     radsol = 0.  
     seaice = 0.  
218      rugmer = 0.001      rugmer = 0.001
219      zmea = pack(zmea_2d, dyn_phy)      zmea = pack(zmea_2d, dyn_phy)
220      zstd = pack(zstd_2d, dyn_phy)      zstd = pack(zstd_2d, dyn_phy)
# Line 270  contains Line 261  contains
261           rlatu)           rlatu)
262      flic_tmp(iim + 1, :) = flic_tmp(1, :)      flic_tmp(iim + 1, :) = flic_tmp(1, :)
263    
     deallocate(dlon_lic, dlat_lic) ! pointers  
   
264      ! Passage sur la grille physique      ! Passage sur la grille physique
265      pctsrf = 0.      pctsrf = 0.
266      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
267      ! Ad\'equation avec le maque terre/mer      ! Ad\'equation avec le maque terre/mer
268      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.
269      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
270      pctsrf(:, is_ter) = zmasq      where (zmasq <= EPSFRA) pctsrf(:, is_ter) = zmasq
271      where (zmasq > EPSFRA)      where (zmasq > EPSFRA)
272         where (pctsrf(:, is_lic) >= zmasq)         where (pctsrf(:, is_lic) >= zmasq)
273            pctsrf(:, is_lic) = zmasq            pctsrf(:, is_lic) = zmasq
# Line 297  contains Line 286  contains
286      pctsrf(:, is_oce) = 1. - zmasq      pctsrf(:, is_oce) = 1. - zmasq
287      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
288    
289      ! V\'erification que somme des sous-surfaces vaut 1 :      ! V\'erification que la somme des sous-surfaces vaut 1 :
290      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)
291      IF (ji /= 0) then      IF (ji /= 0) then
292         PRINT *, 'Bad surface percentages for ', ji, 'points'         PRINT *, 'Bad surface percentages for ', ji, 'points'
# Line 312  contains Line 301  contains
301              SUM(aire_2d(:iim, jjm + 1) * masse(:iim, jjm + 1, l)) / apols              SUM(aire_2d(:iim, jjm + 1) * masse(:iim, jjm + 1, l)) / apols
302      END forall      END forall
303    
     ! Initialisation pour traceurs:  
304      call iniadvtrac      call iniadvtrac
     itau_phy = 0  
   
305      CALL geopot(teta, pk , pks, phis, phi)      CALL geopot(teta, pk , pks, phis, phi)
306      CALL caldyn0(ucov, vcov, teta, ps, masse, pk, phis, phi, w, pbaru, &      CALL caldyn0(ucov, vcov, teta, ps, pk, phis, phi)
307           pbarv)      CALL dynredem0(day_ref, phis)
308      CALL dynredem0("start.nc", day_ref, phis)      CALL dynredem1(vcov, ucov, teta, q, masse, ps, itau = 0)
     CALL dynredem1("start.nc", vcov, ucov, teta, q, masse, ps, itau=0)  
309    
310      ! Initialisations :      ! Initialisations :
311      snsrf(:, is_ter) = sn      snsrf = 0.
     snsrf(:, is_lic) = sn  
     snsrf(:, is_oce) = sn  
     snsrf(:, is_sic) = sn  
312      albe(:, is_ter) = 0.08      albe(:, is_ter) = 0.08
313      albe(:, is_lic) = 0.6      albe(:, is_lic) = 0.6
314      albe(:, is_oce) = 0.5      albe(:, is_oce) = 0.5
# Line 334  contains Line 316  contains
316      evap = 0.      evap = 0.
317      qsolsrf = 150.      qsolsrf = 150.
318      tsoil = spread(spread(pack(tsol_2d, dyn_phy), 2, nsoilmx), 3, nbsrf)      tsoil = spread(spread(pack(tsol_2d, dyn_phy), 2, nsoilmx), 3, nbsrf)
     rain_fall = 0.  
     snow_fall = 0.  
319      solsw = 165.      solsw = 165.
320      sollw = -53.      sollw = -53.
321      t_ancien = 273.15      t_ancien = 273.15
322      q_ancien = 0.      q_ancien = 0.
323      agesno = 0.      agesno = 0.
     seaice = 0.  
324    
325      frugs(:, is_oce) = rugmer      frugs(:, is_oce) = rugmer
326      frugs(:, is_ter) = MAX(1e-5, zstd * zsig / 2)      frugs(:, is_ter) = MAX(1e-5, zstd * zsig / 2)
327      frugs(:, is_lic) = MAX(1e-5, zstd * zsig / 2)      frugs(:, is_lic) = MAX(1e-5, zstd * zsig / 2)
328      frugs(:, is_sic) = 0.001      frugs(:, is_sic) = 0.001
     fder = 0.  
329      clwcon = 0.      clwcon = 0.
330      rnebcon = 0.      rnebcon = 0.
331      ratqs = 0.      ratqs = 0.
     run_off_lic_0 = 0.  
332      sig1 = 0.      sig1 = 0.
333      w01 = 0.      w01 = 0.
334    
335      call phyredem("startphy.nc", pctsrf, tsoil(:, 1, :), tsoil, &      nday = 0
336           tsoil(:, 1, is_oce), seaice, qsolsrf, pack(qsol_2d, dyn_phy), snsrf, &      itau_phy = 0 ! side effect
337           albe, evap, rain_fall, snow_fall, solsw, sollw, fder, radsol, frugs, &      call phyredem0
338           agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &  
339           q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01)      call nf95_inq_varid(ncid_restartphy, "trs", varid)
340        call nf95_put_var(ncid_restartphy, varid, null_array)
341    
342        call phyredem(pctsrf, tsoil(:, 1, :), tsoil, qsolsrf, &
343             pack(qsol_2d, dyn_phy), snsrf, albe, evap, null_array, null_array, &
344             solsw, sollw, null_array, null_array, frugs, agesno, zmea, zstd, &
345             zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, &
346             clwcon, null_array, sig1, w01)
347    
348    END SUBROUTINE etat0    END SUBROUTINE etat0
349    
Legend:
Removed from v.156  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21