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

Diff of /trunk/libf/dyn3d/etat0.f90

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

revision 12 by guez, Mon Jul 21 16:05:07 2008 UTC revision 13 by guez, Fri Jul 25 19:59:34 2008 UTC
# Line 36  contains Line 36  contains
36      use serre, only: alphax      use serre, only: alphax
37      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
38      use temps, only: itau_dyn, itau_phy, annee_ref, day_ref, dt      use temps, only: itau_dyn, itau_phy, annee_ref, day_ref, dt
     use clesphys2, only: ok_orodr, nbapp_rad  
39      use grid_atob, only: grille_m      use grid_atob, only: grille_m
40      use grid_change, only: init_dyn_phy, dyn_phy      use grid_change, only: init_dyn_phy, dyn_phy
41      use q_sat_m, only: q_sat      use q_sat_m, only: q_sat
# Line 81  contains Line 80  contains
80      REAL zsig(klon), zgam(klon)      REAL zsig(klon), zgam(klon)
81      REAL zthe(klon)      REAL zthe(klon)
82      REAL zpic(klon), zval(klon)      REAL zpic(klon), zval(klon)
     REAL rugsrel(klon)  
83      REAL t_ancien(klon, llm), q_ancien(klon, llm)      !      REAL t_ancien(klon, llm), q_ancien(klon, llm)      !
84      REAL run_off_lic_0(klon)      REAL run_off_lic_0(klon)
85      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)      real clwcon(klon, llm), rnebcon(klon, llm), ratqs(klon, llm)
# Line 104  contains Line 102  contains
102      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)      REAL pbaru(ip1jmp1, llm), pbarv(ip1jm, llm)
103      REAL w(ip1jmp1, llm)      REAL w(ip1jmp1, llm)
104      REAL phystep      REAL phystep
     INTEGER radpas  
105    
106      !---------------------------------      !---------------------------------
107    
# Line 192  contains Line 189  contains
189         q3d(:, :, :, 5) = q3d(:, :, :, 5)  * 48. / 29.         q3d(:, :, :, 5) = q3d(:, :, :, 5)  * 48. / 29.
190      end if      end if
191    
192      tsol(:) = pack(tsol_2d, dyn_phy)      tsol = pack(tsol_2d, dyn_phy)
193      qsol(:) = pack(qsol_2d, dyn_phy)      qsol = pack(qsol_2d, dyn_phy)
194      sn(:) = 0. ! snow      sn = 0. ! snow
195      radsol(:) = 0.      radsol = 0.
196      tslab(:) = 0. ! IM "slab" ocean      tslab = 0. ! IM "slab" ocean
197      seaice(:) = 0.      seaice = 0.
198      rugmer(:) = 0.001      rugmer = 0.001
199      zmea(:) = pack(relief, dyn_phy)      zmea = pack(relief, dyn_phy)
200      zstd(:) = pack(zstd_2d, dyn_phy)      zstd = pack(zstd_2d, dyn_phy)
201      zsig(:) = pack(zsig_2d, dyn_phy)      zsig = pack(zsig_2d, dyn_phy)
202      zgam(:) = pack(zgam_2d, dyn_phy)      zgam = pack(zgam_2d, dyn_phy)
203      zthe(:) = pack(zthe_2d, dyn_phy)      zthe = pack(zthe_2d, dyn_phy)
204      zpic(:) = pack(zpic_2d, dyn_phy)      zpic = pack(zpic_2d, dyn_phy)
205      zval(:) = pack(zval_2d, dyn_phy)      zval = pack(zval_2d, dyn_phy)
   
     rugsrel(:) = 0.  
     IF (ok_orodr) rugsrel(:) = MAX(1.e-05, zstd(:) * zsig(:) / 2)  
206    
207      ! On initialise les sous-surfaces:      ! On initialise les sous-surfaces:
208      ! Lecture du fichier glace de terre pour fixer la fraction de terre      ! Lecture du fichier glace de terre pour fixer la fraction de terre
# Line 240  contains Line 234  contains
234         lat_lic(:, :) = lat_lic(:, :) * pi/ 180.         lat_lic(:, :) = lat_lic(:, :) * pi/ 180.
235      ENDIF      ENDIF
236    
237      dlon_lic(:) = lon_lic(:, 1)      dlon_lic = lon_lic(:, 1)
238      dlat_lic(:) = lat_lic(1, :)      dlat_lic = lat_lic(1, :)
239    
240      flic_tmp(:iim, :) = grille_m(dlon_lic, dlat_lic, fraclic, rlonv(:iim), &      flic_tmp(:iim, :) = grille_m(dlon_lic, dlat_lic, fraclic, rlonv(:iim), &
241           rlatu)           rlatu)
# Line 252  contains Line 246  contains
246      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
247      ! Adéquation avec le maque terre/mer      ! Adéquation avec le maque terre/mer
248      WHERE (pctsrf(:, is_lic) < EPSFRA ) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA ) pctsrf(:, is_lic) = 0.
249      WHERE (zmasq(:) < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
250      pctsrf(:, is_ter) = zmasq(:)      pctsrf(:, is_ter) = zmasq
251      where (zmasq(:) > EPSFRA)      where (zmasq > EPSFRA)
252         where (pctsrf(:, is_lic) >= zmasq(:))         where (pctsrf(:, is_lic) >= zmasq)
253            pctsrf(:, is_lic) = zmasq(:)            pctsrf(:, is_lic) = zmasq
254            pctsrf(:, is_ter) = 0.            pctsrf(:, is_ter) = 0.
255         elsewhere         elsewhere
256            pctsrf(:, is_ter) = zmasq(:) - pctsrf(:, is_lic)            pctsrf(:, is_ter) = zmasq - pctsrf(:, is_lic)
257            where (pctsrf(:, is_ter) < EPSFRA)            where (pctsrf(:, is_ter) < EPSFRA)
258               pctsrf(:, is_ter) = 0.               pctsrf(:, is_ter) = 0.
259               pctsrf(:, is_lic) = zmasq(:)               pctsrf(:, is_lic) = zmasq
260            end where            end where
261         end where         end where
262      end where      end where
263    
264      ! Sous-surface océan et glace de mer (pour démarrer on met glace      ! Sous-surface océan et glace de mer (pour démarrer on met glace
265      ! de mer à 0) :      ! de mer à 0) :
266      pctsrf(:, is_oce) = 1. - zmasq(:)      pctsrf(:, is_oce) = 1. - zmasq
267      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
268    
269      ! Vérification que somme des sous-surfaces vaut 1:      ! Vérification que somme des sous-surfaces vaut 1:
# Line 306  contains Line 300  contains
300      ! Ecriture état initial physique:      ! Ecriture état initial physique:
301      print *, 'dtvr = ', dtvr      print *, 'dtvr = ', dtvr
302      print *, "iphysiq = ", iphysiq      print *, "iphysiq = ", iphysiq
     print *, "nbapp_rad = ", nbapp_rad  
303      phystep   = dtvr * REAL(iphysiq)      phystep   = dtvr * REAL(iphysiq)
     radpas    = NINT (86400./phystep/ nbapp_rad)  
304      print *, 'phystep = ', phystep      print *, 'phystep = ', phystep
     print *, "radpas = ", radpas  
305    
306      ! Initialisations :      ! Initialisations :
307      tsolsrf(:, is_ter) = tsol      tsolsrf(:, is_ter) = tsol
# Line 340  contains Line 331  contains
331      q_ancien = 0.      q_ancien = 0.
332      agesno = 0.      agesno = 0.
333      !IM "slab" ocean      !IM "slab" ocean
334      tslab(:) = tsolsrf(:, is_oce)      tslab = tsolsrf(:, is_oce)
335      seaice = 0.      seaice = 0.
336    
337      frugs(:, is_oce) = rugmer(:)      frugs(:, is_oce) = rugmer
338      frugs(:, is_ter) = MAX(1.e-05, zstd(:) * zsig(:) / 2)      frugs(:, is_ter) = MAX(1.e-05, zstd * zsig / 2)
339      frugs(:, is_lic) = MAX(1.e-05, zstd(:) * zsig(:) / 2)      frugs(:, is_lic) = MAX(1.e-05, zstd * zsig / 2)
340      frugs(:, is_sic) = 0.001      frugs(:, is_sic) = 0.001
341      fder = 0.      fder = 0.
342      clwcon = 0.      clwcon = 0.
# Line 353  contains Line 344  contains
344      ratqs = 0.      ratqs = 0.
345      run_off_lic_0 = 0.      run_off_lic_0 = 0.
346    
347      call phyredem("startphy.nc", radpas, latfi, lonfi, pctsrf, &      call phyredem("startphy.nc", latfi, lonfi, pctsrf, &
348           tsolsrf, tsoil, tslab, seaice, qsolsrf, qsol, snsrf, albe, alblw, &           tsolsrf, tsoil, tslab, seaice, qsolsrf, qsol, snsrf, albe, alblw, &
349           evap, rain_fall, snow_fall, solsw, sollw, fder, radsol, frugs, &           evap, rain_fall, snow_fall, solsw, sollw, fder, radsol, frugs, &
350           agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, rugsrel, &           agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
351           t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)           t_ancien, q_ancien, rnebcon, ratqs, clwcon, run_off_lic_0)
352      CALL histclo      CALL histclo
353    
Legend:
Removed from v.12  
changed lines
  Added in v.13
  ViewVC Help
Powered by ViewVC 1.1.21