--- trunk/dyn3d/etat0.f 2018/07/12 15:56:17 277 +++ trunk/dyn3d/etat0.f90 2019/07/31 17:10:31 331 @@ -15,9 +15,9 @@ use dimensions, only: iim, jjm, llm, nqmx use dimphy, only: klon use dimsoil, only: nsoilmx - use disvert_m, only: ap, bp, preff, pa, disvert - use dynetat0_m, only: day_ref, annee_ref, rlatu, rlatv, rlonu, rlonv, & - fyhyp, fxhyp + use disvert_m, only: ap, bp, preff, disvert + use dynetat0_m, only: rlatu, rlatv, rlonu, rlonv, fyhyp, fxhyp + use dynetat0_chosen_m, only: day_ref use dynredem0_m, only: dynredem0 use dynredem1_m, only: dynredem1 use exner_hyb_m, only: exner_hyb @@ -25,25 +25,24 @@ use grille_m_m, only: grille_m use grid_change, only: init_dyn_phy, dyn_phy use indicesol, only: is_oce, is_sic, is_ter, is_lic, epsfra, nbsrf - use iniadvtrac_m, only: iniadvtrac + use infotrac_init_m, only: infotrac_init use inifilr_m, only: inifilr use massdair_m, only: massdair use netcdf, only: nf90_nowrite use netcdf95, only: nf95_close, nf95_get_var, nf95_gw_var, nf95_put_var, & nf95_inq_varid, nf95_open use nr_util, only: pi, assert - use phyetat0_m, only: rlat, rlon, itau_phy, zmasq + use phyetat0_m, only: masque, phyetat0_new use phyredem0_m, only: phyredem0, ncid_restartphy use phyredem_m, only: phyredem use q_sat_m, only: q_sat use regr_lat_time_coefoz_m, only: regr_lat_time_coefoz use regr_pr_o3_m, only: regr_pr_o3 use startdyn, only: start_init_dyn - USE start_init_orog_m, only: start_init_orog, mask + USE start_init_orog_m, only: start_init_orog use start_init_phys_m, only: start_init_phys use start_inter_3d_m, only: start_inter_3d use test_disvert_m, only: test_disvert - use unit_nml_m, only: unit_nml REAL, intent(out):: phis(:, :) ! (iim + 1, jjm + 1) ! surface geopotential, in m2 s-2 @@ -63,8 +62,8 @@ ! and pressure level "pls(i, j, l)".) real qsat(iim + 1, jjm + 1, llm) ! mass fraction of saturating water vapor - REAL qsolsrf(klon, nbsrf), snsrf(klon, nbsrf) - REAL albe(klon, nbsrf), evap(klon, nbsrf) + REAL qsolsrf(klon, nbsrf), fsnow(klon, nbsrf) + REAL falbe(klon, nbsrf) REAL tsoil(klon, nsoilmx, nbsrf) REAL null_array(klon) REAL solsw(klon), sollw(klon) @@ -85,7 +84,7 @@ INTEGER iml_lic, jml_lic INTEGER ncid, varid REAL, ALLOCATABLE:: dlon_lic(:), dlat_lic(:) - REAL, ALLOCATABLE:: fraclic(:, :) ! fraction land ice + REAL, ALLOCATABLE:: landice(:, :) ! fraction land ice REAL flic_tmp(iim + 1, jjm + 1) ! fraction land ice temporary INTEGER l, ji @@ -106,43 +105,24 @@ ! ("p3d(i, j, l)" is at longitude "rlonv(i)", latitude "rlatu(j)", ! for interface "l") - namelist /etat0_nml/ day_ref, annee_ref - !--------------------------------- print *, "Call sequence information: etat0" - print *, "Enter namelist 'etat0_nml'." - read(unit=*, nml=etat0_nml) - write(unit_nml, nml=etat0_nml) - CALL iniconst ! Construct a grid: - pa = 5e4 CALL disvert call test_disvert CALL fyhyp CALL fxhyp CALL inigeom 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. - call start_init_orog(phis, zmea_2d, zstd_2d, zsig_2d, zgam_2d, zthe_2d, & zpic_2d, zval_2d) ! also compute "mask" call init_dyn_phy ! define the mask "dyn_phy" for distinct grid points - zmasq = pack(mask, dyn_phy) - PRINT *, 'Masque construit' + call phyetat0_new call start_init_phys(tsol_2d, qsol_2d) CALL start_init_dyn(tsol_2d, phis, ps) @@ -227,8 +207,8 @@ jml_lic = size(dlat_lic) call nf95_inq_varid(ncid, 'landice', varid) - ALLOCATE(fraclic(iml_lic, jml_lic)) - call nf95_get_var(ncid, varid, fraclic) + ALLOCATE(landice(iml_lic, jml_lic)) + call nf95_get_var(ncid, varid, landice) call nf95_close(ncid) @@ -245,33 +225,34 @@ dlat_lic = dlat_lic * pi/ 180. ENDIF - flic_tmp(:iim, :) = grille_m(dlon_lic, dlat_lic, fraclic, rlonv(:iim), & + flic_tmp(:iim, :) = grille_m(dlon_lic, dlat_lic, landice, rlonv(:iim), & rlatu) flic_tmp(iim + 1, :) = flic_tmp(1, :) - ! Passage sur la grille physique + ! Passage sur la grille physique : pctsrf = 0. pctsrf(:, is_lic) = pack(flic_tmp, dyn_phy) - ! Ad\'equation avec le maque terre/mer + + ! Ad\'equation avec le maque terre/mer : WHERE (pctsrf(:, is_lic) < EPSFRA) pctsrf(:, is_lic) = 0. - WHERE (zmasq < EPSFRA) pctsrf(:, is_lic) = 0. - where (zmasq <= EPSFRA) pctsrf(:, is_ter) = zmasq - where (zmasq > EPSFRA) - where (pctsrf(:, is_lic) >= zmasq) - pctsrf(:, is_lic) = zmasq + WHERE (masque < EPSFRA) pctsrf(:, is_lic) = 0. + where (masque <= EPSFRA) pctsrf(:, is_ter) = masque + where (masque > EPSFRA) + where (pctsrf(:, is_lic) >= masque) + pctsrf(:, is_lic) = masque pctsrf(:, is_ter) = 0. elsewhere - pctsrf(:, is_ter) = zmasq - pctsrf(:, is_lic) + pctsrf(:, is_ter) = masque - pctsrf(:, is_lic) where (pctsrf(:, is_ter) < EPSFRA) pctsrf(:, is_ter) = 0. - pctsrf(:, is_lic) = zmasq + pctsrf(:, is_lic) = masque end where end where end where ! Sous-surface oc\'ean et glace de mer (pour d\'emarrer on met glace ! de mer \`a 0) : - pctsrf(:, is_oce) = 1. - zmasq + pctsrf(:, is_oce) = 1. - masque WHERE (pctsrf(:, is_oce) < EPSFRA) pctsrf(:, is_oce) = 0. ! V\'erification que la somme des sous-surfaces vaut 1 : @@ -289,19 +270,18 @@ SUM(aire_2d(:iim, jjm + 1) * masse(:iim, jjm + 1, l)) / apols END forall - call iniadvtrac + call infotrac_init CALL geopot(teta, pk , pks, phis, phi) CALL caldyn0(ucov, vcov, teta, ps, pk, phis, phi) CALL dynredem0(day_ref, phis) CALL dynredem1(vcov, ucov, teta, q, masse, ps, itau = 0) ! Initialisations : - snsrf = 0. - albe(:, is_ter) = 0.08 - albe(:, is_lic) = 0.6 - albe(:, is_oce) = 0.5 - albe(:, is_sic) = 0.6 - evap = 0. + fsnow = 0. + falbe(:, is_ter) = 0.08 + falbe(:, is_lic) = 0.6 + falbe(:, is_oce) = 0.5 + falbe(:, is_sic) = 0.6 qsolsrf = 150. tsoil = spread(spread(pack(tsol_2d, dyn_phy), 2, nsoilmx), 3, nbsrf) solsw = 165. @@ -320,18 +300,17 @@ sig1 = 0. w01 = 0. - nday = 0 - itau_phy = 0 ! side effect + nday = 0 ! side effect call phyredem0 call nf95_inq_varid(ncid_restartphy, "trs", varid) call nf95_put_var(ncid_restartphy, varid, null_array) call phyredem(pctsrf, tsoil(:, 1, :), tsoil, qsolsrf, & - pack(qsol_2d, dyn_phy), snsrf, albe, evap, null_array, null_array, & - solsw, sollw, null_array, null_array, frugs, agesno, zmea, zstd, & - zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, & - clwcon, null_array, sig1, w01) + pack(qsol_2d, dyn_phy), fsnow, falbe, null_array, null_array, solsw, & + sollw, null_array, null_array, frugs, agesno, zmea, zstd, zsig, zgam, & + zthe, zpic, zval, t_ancien, q_ancien, rnebcon, ratqs, clwcon, & + null_array, sig1, w01) END SUBROUTINE etat0