/[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 157 by guez, Mon Jul 20 16:01:49 2015 UTC trunk/dyn3d/etat0.f revision 279 by guez, Fri Jul 20 14:30:23 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, rlatu, rlatv, rlonu, rlonv, &
20           rlatu2, rlatu, rlatv, yprimu1, yprimu2, rlonu, rlonv, xprimu, xprimv           fyhyp, fxhyp
21      use dynredem0_m, only: dynredem0      use dynredem0_m, only: dynredem0
22      use dynredem1_m, only: dynredem1      use dynredem1_m, only: dynredem1
23      use exner_hyb_m, only: exner_hyb      use exner_hyb_m, only: exner_hyb
     use fxhyp_m, only: fxhyp  
     use fyhyp_m, only: fyhyp  
24      use geopot_m, only: geopot      use geopot_m, only: geopot
25      use grid_atob, only: grille_m      use grille_m_m, only: grille_m
26      use grid_change, only: init_dyn_phy, dyn_phy      use grid_change, only: init_dyn_phy, dyn_phy
27      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
28      use iniadvtrac_m, only: iniadvtrac      use iniadvtrac_m, only: iniadvtrac
29      use inifilr_m, only: inifilr      use inifilr_m, only: inifilr
30      use massdair_m, only: massdair      use massdair_m, only: massdair
# Line 43  contains Line 32  contains
32      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, &
33           nf95_inq_varid, nf95_open           nf95_inq_varid, nf95_open
34      use nr_util, only: pi, assert      use nr_util, only: pi, assert
35      use paramet_m, only: ip1jm, ip1jmp1      use phyetat0_m, only: zmasq, phyetat0_new
     use phyetat0_m, only: rlat, rlon  
36      use phyredem0_m, only: phyredem0, ncid_restartphy      use phyredem0_m, only: phyredem0, ncid_restartphy
37      use phyredem_m, only: phyredem      use phyredem_m, only: phyredem
38      use q_sat_m, only: q_sat      use q_sat_m, only: q_sat
39      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz      use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz
40      use regr_pr_o3_m, only: regr_pr_o3      use regr_pr_o3_m, only: regr_pr_o3
41      use startdyn, only: start_init_dyn      use startdyn, only: start_init_dyn
42      USE start_init_orog_m, only: start_init_orog, mask      USE start_init_orog_m, only: start_init_orog
43      use start_init_phys_m, only: start_init_phys      use start_init_phys_m, only: start_init_phys
44      use start_inter_3d_m, only: start_inter_3d      use start_inter_3d_m, only: start_inter_3d
     use temps, only: itau_phy  
45      use test_disvert_m, only: test_disvert      use test_disvert_m, only: test_disvert
46      use unit_nml_m, only: unit_nml      use unit_nml_m, only: unit_nml
47    
48      REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)      REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1)
49      ! surface geopotential, in m2 s-2      ! surface geopotential, in m2 s-2
50    
51        REAL, intent(out):: pctsrf(:, :) ! (klon, nbsrf)
52        ! "pctsrf(i, :)" is the composition of the surface at horizontal
53        ! position "i".
54    
55      ! Local:      ! Local:
56    
57      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta      REAL, dimension(iim + 1, jjm + 1, llm):: ucov, t3d, teta
# Line 93  contains Line 84  contains
84      ! D\'eclarations pour lecture glace de mer :      ! D\'eclarations pour lecture glace de mer :
85      INTEGER iml_lic, jml_lic      INTEGER iml_lic, jml_lic
86      INTEGER ncid, varid      INTEGER ncid, varid
87      REAL, pointer:: dlon_lic(:), dlat_lic(:)      REAL, ALLOCATABLE:: dlon_lic(:), dlat_lic(:)
88      REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice      REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice
89      REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary      REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary
90    
# Line 101  contains Line 92  contains
92    
93      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
94      real pks(iim + 1, jjm + 1)      real pks(iim + 1, jjm + 1)
   
95      REAL masse(iim + 1, jjm + 1, llm)      REAL masse(iim + 1, jjm + 1, llm)
96      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)  
   
97      real sig1(klon, llm) ! section adiabatic updraft      real sig1(klon, llm) ! section adiabatic updraft
98      real w01(klon, llm) ! vertical velocity within adiabatic updraft      real w01(klon, llm) ! vertical velocity within adiabatic updraft
99    
# Line 136  contains Line 123  contains
123      pa = 5e4      pa = 5e4
124      CALL disvert      CALL disvert
125      call test_disvert      call test_disvert
126        CALL fyhyp
127      CALL fyhyp(rlatu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)      CALL fxhyp
     CALL fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)  
   
     rlatu(1) = pi / 2.  
     rlatu(jjm + 1) = -rlatu(1)  
   
128      CALL inigeom      CALL inigeom
129      CALL inifilr      CALL inifilr
   
     rlat(1) = 90.  
     rlat(2:klon-1) = pack(spread(rlatu(2:jjm), 1, iim), .true.) * 180. / pi  
     ! (with conversion to degrees)  
     rlat(klon) = - 90.  
   
     rlon(1) = 0.  
     rlon(2:klon-1) = pack(spread(rlonv(:iim), 2, jjm - 1), .true.) * 180. / pi  
     ! (with conversion to degrees)  
     rlon(klon) = 0.  
   
130      call start_init_orog(phis, zmea_2d, zstd_2d, zsig_2d, zgam_2d, zthe_2d, &      call start_init_orog(phis, zmea_2d, zstd_2d, zsig_2d, zgam_2d, zthe_2d, &
131           zpic_2d, zval_2d) ! also compute "mask"           zpic_2d, zval_2d) ! also compute "mask"
132      call init_dyn_phy ! define the mask "dyn_phy" for distinct grid points      call init_dyn_phy ! define the mask "dyn_phy" for distinct grid points
133      zmasq = pack(mask, dyn_phy)      call phyetat0_new
     PRINT *, 'Masque construit'  
134    
135      call start_init_phys(tsol_2d, qsol_2d)      call start_init_phys(tsol_2d, qsol_2d)
136      CALL start_init_dyn(tsol_2d, phis, ps)      CALL start_init_dyn(tsol_2d, phis, ps)
# Line 267  contains Line 237  contains
237           rlatu)           rlatu)
238      flic_tmp(iim + 1, :) = flic_tmp(1, :)      flic_tmp(iim + 1, :) = flic_tmp(1, :)
239    
240      deallocate(dlon_lic, dlat_lic) ! pointers      ! Passage sur la grille physique :
   
     ! Passage sur la grille physique  
241      pctsrf = 0.      pctsrf = 0.
242      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)      pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy)
243      ! Ad\'equation avec le maque terre/mer      
244        ! Ad\'equation avec le maque terre/mer :
245      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0.
246      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.      WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0.
247      pctsrf(:, is_ter) = zmasq      where (zmasq <= EPSFRA) pctsrf(:, is_ter) = zmasq
248      where (zmasq > EPSFRA)      where (zmasq > EPSFRA)
249         where (pctsrf(:, is_lic) >= zmasq)         where (pctsrf(:, is_lic) >= zmasq)
250            pctsrf(:, is_lic) = zmasq            pctsrf(:, is_lic) = zmasq
# Line 294  contains Line 263  contains
263      pctsrf(:, is_oce) = 1. - zmasq      pctsrf(:, is_oce) = 1. - zmasq
264      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.      WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0.
265    
266      ! V\'erification que somme des sous-surfaces vaut 1 :      ! V\'erification que la somme des sous-surfaces vaut 1 :
267      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)      ji = count(abs(sum(pctsrf, dim = 2) - 1.) > EPSFRA)
268      IF (ji /= 0) then      IF (ji /= 0) then
269         PRINT *, 'Bad surface percentages for ', ji, 'points'         PRINT *, 'Bad surface percentages for ', ji, 'points'
# Line 311  contains Line 280  contains
280    
281      call iniadvtrac      call iniadvtrac
282      CALL geopot(teta, pk , pks, phis, phi)      CALL geopot(teta, pk , pks, phis, phi)
283      CALL caldyn0(ucov, vcov, teta, ps, masse, pk, phis, phi, w, pbaru, pbarv)      CALL caldyn0(ucov, vcov, teta, ps, pk, phis, phi)
284      CALL dynredem0(day_ref, phis)      CALL dynredem0(day_ref, phis)
285      CALL dynredem1(vcov, ucov, teta, q, masse, ps, itau = 0)      CALL dynredem1(vcov, ucov, teta, q, masse, ps, itau = 0)
286    
# Line 340  contains Line 309  contains
309      sig1 = 0.      sig1 = 0.
310      w01 = 0.      w01 = 0.
311    
     itau_phy = 0  
312      nday = 0      nday = 0
313      call phyredem0(lmt_pas = day_step / iphysiq)      call phyredem0
314    
315      call nf95_inq_varid(ncid_restartphy, "trs", varid)      call nf95_inq_varid(ncid_restartphy, "trs", varid)
316      call nf95_put_var(ncid_restartphy, varid, null_array)      call nf95_put_var(ncid_restartphy, varid, null_array)
317    
318      call phyredem(pctsrf, tsoil(:, 1, :), tsoil, tsoil(:, 1, is_oce), &      call phyredem(pctsrf, tsoil(:, 1, :), tsoil, qsolsrf, &
319           null_array, qsolsrf, pack(qsol_2d, dyn_phy), snsrf, albe, evap, &           pack(qsol_2d, dyn_phy), snsrf, albe, evap, null_array, null_array, &
320           null_array, null_array, solsw, sollw, null_array, null_array, frugs, &           solsw, sollw, null_array, null_array, frugs, agesno, zmea, zstd, &
321           agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, t_ancien, &           zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, &
322           q_ancien, rnebcon, ratqs, clwcon, null_array, sig1, w01)           clwcon, null_array, sig1, w01)
323    
324    END SUBROUTINE etat0    END SUBROUTINE etat0
325    
326  end module etat0_mod  end module etat0_m
Legend:
Removed from v.157  
changed lines
  Added in v.279
  ViewVC Help
Powered by ViewVC 1.1.21