/[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 191 by guez, Mon May 9 19:56:28 2016 UTC trunk/dyn3d/etat0.f revision 276 by guez, Thu Jul 12 14:49:20 2018 UTC
# Line 1  Line 1 
1  module etat0_mod  module etat0_m
   
   use indicesol, only: nbsrf  
   use dimphy, only: klon  
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
   REAL pctsrf(klon, nbsrf)  
   ! ("pctsrf(i, :)" is the composition of the surface at horizontal  
   ! position "i")  
   
   private nbsrf, klon  
   
5  contains  contains
6    
7    SUBROUTINE etat0(phis)    SUBROUTINE etat0(phis, pctsrf)
8    
9      ! From "etat0_netcdf.F", version 1.3, 2005/05/25 13:10:09      ! From "etat0_netcdf.F", version 1.3, 2005/05/25 13:10:09
10    
11      use caldyn0_m, only: caldyn0      use caldyn0_m, only: caldyn0
12      use comconst, only: cpp, kappa, iniconst      use comconst, only: cpp, kappa, iniconst
13      use comgeom, only: aire_2d, apoln, apols, cu_2d, cv_2d, inigeom      use comgeom, only: aire_2d, apoln, apols, cu_2d, cv_2d, inigeom
14      use conf_gcm_m, only: nday, day_step, iphysiq      use conf_gcm_m, only: nday
15      use dimens_m, only: iim, jjm, llm, nqmx      use dimensions, only: iim, jjm, llm, nqmx
16      use dimphy, only: zmasq      use dimphy, only: klon
17      use dimsoil, only: nsoilmx      use dimsoil, only: nsoilmx
18      use disvert_m, only: ap, bp, preff, pa, disvert      use disvert_m, only: ap, bp, preff, pa, disvert
19      use dynetat0_m, only: day_ref, annee_ref, xprimp025, xprimm025, rlatu1, &      use dynetat0_m, only: day_ref, annee_ref, xprimp025, xprimm025, rlatu1, &
# Line 33  contains Line 24  contains
24      use fxhyp_m, only: fxhyp      use fxhyp_m, only: fxhyp
25      use fyhyp_m, only: fyhyp      use fyhyp_m, only: fyhyp
26      use geopot_m, only: geopot      use geopot_m, only: geopot
27      use grid_atob, only: grille_m      use grille_m_m, only: grille_m
28      use grid_change, only: init_dyn_phy, dyn_phy      use grid_change, only: init_dyn_phy, dyn_phy
29      use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra      use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra, nbsrf
30      use iniadvtrac_m, only: iniadvtrac      use iniadvtrac_m, only: iniadvtrac
31      use inifilr_m, only: inifilr      use inifilr_m, only: inifilr
32      use massdair_m, only: massdair      use massdair_m, only: massdair
# Line 43  contains Line 34  contains
34      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, nf95_put_var, &      use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, nf95_put_var, &
35           nf95_inq_varid, nf95_open           nf95_inq_varid, nf95_open
36      use nr_util, only: pi, assert      use nr_util, only: pi, assert
37      use phyetat0_m, only: rlat, rlon, itau_phy      use phyetat0_m, only: rlat, rlon, itau_phy, zmasq
38      use phyredem0_m, only: phyredem0, ncid_restartphy      use phyredem0_m, only: phyredem0, ncid_restartphy
39      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
40      use q_sat_m, only: q_sat      use q_sat_m, only: q_sat
# Line 59  contains Line 50  contains
50      REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)      REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
51      ! surface geopotential, in m2 s-2      ! surface geopotential, in m2 s-2
52    
53        REAL, intent(out):: pctsrf(:, :) ! (klon, nbsrf)
54        ! "pctsrf(i, :)" is the composition of the surface at horizontal
55        ! position "i".
56    
57      ! Local:      ! Local:
58    
59      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta
# Line 91  contains Line 86  contains
86      ! D\'eclarations pour lecture glace de mer :      ! D\'eclarations pour lecture glace de mer :
87      INTEGER iml_lic, jml_lic      INTEGER iml_lic, jml_lic
88      INTEGER ncid, varid      INTEGER ncid, varid
89      REAL, pointer:: dlon_lic(:), dlat_lic(:)      REAL, ALLOCATABLE:: dlon_lic(:), dlat_lic(:)
90      REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice      REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice
91      REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary      REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary
92    
# Line 261  contains Line 256  contains
256           rlatu)           rlatu)
257      flic_tmp(iim + 1, :) = flic_tmp(1, :)      flic_tmp(iim + 1, :) = flic_tmp(1, :)
258    
     deallocate(dlon_lic, dlat_lic) ! pointers  
   
259      ! Passage sur la grille physique      ! Passage sur la grille physique
260      pctsrf = 0.      pctsrf = 0.
261      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
262      ! Ad\'equation avec le maque terre/mer      ! Ad\'equation avec le maque terre/mer
263      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.
264      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
265      pctsrf(:, is_ter) = zmasq      where (zmasq <= EPSFRA) pctsrf(:, is_ter) = zmasq
266      where (zmasq > EPSFRA)      where (zmasq > EPSFRA)
267         where (pctsrf(:, is_lic) >= zmasq)         where (pctsrf(:, is_lic) >= zmasq)
268            pctsrf(:, is_lic) = zmasq            pctsrf(:, is_lic) = zmasq
# Line 336  contains Line 329  contains
329    
330      nday = 0      nday = 0
331      itau_phy = 0 ! side effect      itau_phy = 0 ! side effect
332      call phyredem0(lmt_pas = day_step / iphysiq)      call phyredem0
333    
334      call nf95_inq_varid(ncid_restartphy, "trs", varid)      call nf95_inq_varid(ncid_restartphy, "trs", varid)
335      call nf95_put_var(ncid_restartphy, varid, null_array)      call nf95_put_var(ncid_restartphy, varid, null_array)
# Line 349  contains Line 342  contains
342    
343    END SUBROUTINE etat0    END SUBROUTINE etat0
344    
345  end module etat0_mod  end module etat0_m
Legend:
Removed from v.191  
changed lines
  Added in v.276
  ViewVC Help
Powered by ViewVC 1.1.21