--- trunk/dyn3d/guide.f 2014/07/15 13:43:24 102 +++ trunk/dyn3d/Guide/guide.f 2014/09/19 17:36:20 115 @@ -5,50 +5,46 @@ IMPLICIT NONE - REAL aire_min, aire_max - CONTAINS SUBROUTINE guide(itau, ucov, vcov, teta, q, ps) ! Author: F.Hourdin - USE comconst, ONLY: cpp, daysec, dtvr, kappa - USE comgeom, ONLY: aire, rlatu, rlonv - USE conf_gcm_m, ONLY: day_step, iperiod - use conf_guide_m, only: conf_guide, guide_u, guide_v, guide_t, guide_q, & - ncep, ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, & - tau_min_t, tau_max_t, tau_min_q, tau_max_q, tau_min_p, tau_max_p, & - online + USE comconst, ONLY: cpp, kappa + USE comgeom, ONLY: rlatu, rlatv + USE conf_gcm_m, ONLY: day_step + use conf_guide_m, only: guide_u, guide_v, guide_t, guide_q, ncep, & + ini_anal, tau_min_u, tau_max_u, tau_min_v, tau_max_v, tau_min_t, & + tau_max_t, tau_min_q, tau_max_q, online, factt USE dimens_m, ONLY: iim, jjm, llm USE disvert_m, ONLY: ap, bp, preff, presnivs - use dump2d_m, only: dump2d USE exner_hyb_m, ONLY: exner_hyb - USE inigrads_m, ONLY: inigrads - use massdair_m, only: massdair - use netcdf, only: nf90_nowrite, nf90_close, nf90_inq_dimid - use netcdf95, only: nf95_inquire_dimension, nf95_open + use init_tau2alpha_m, only: init_tau2alpha + use netcdf, only: nf90_nowrite + use netcdf95, only: nf95_close, nf95_inq_dimid, nf95_inquire_dimension, & + nf95_open use nr_util, only: pi - USE paramet_m, ONLY: iip1, ip1jm, ip1jmp1, jjp1, llmp1 + USE paramet_m, ONLY: iip1, ip1jmp1, jjp1, llmp1 USE q_sat_m, ONLY: q_sat use read_reanalyse_m, only: read_reanalyse - USE serre, ONLY: clat, clon - use tau2alpha_m, only: tau2alpha, dxdys + use serre, only: grossismx, grossismy + use tau2alpha_m, only: tau2alpha + use writefield_m, only: writefield INTEGER, INTENT(IN):: itau - - ! variables dynamiques - REAL, intent(inout):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm) vent covariant REAL, intent(inout):: vcov(:, :, :) ! (iim + 1, jjm, llm) ! vent covariant - REAL, intent(inout):: teta(iim + 1, jjm + 1, llm) ! température potentielle - REAL, intent(inout):: q(iim + 1, jjm + 1, llm) + REAL, intent(inout):: teta(:, :, :) ! (iim + 1, jjm + 1, llm) + ! température potentielle + + REAL, intent(inout):: q(:, :, :) ! (iim + 1, jjm + 1, llm) REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol ! Local: - ! variables dynamiques pour les reanalyses. + ! variables dynamiques pour les réanalyses REAL, save:: ucovrea1(iim + 1, jjm + 1, llm), vcovrea1(iim + 1, jjm, llm) ! vents covariants reanalyses @@ -64,93 +60,94 @@ REAL, save:: masserea2(ip1jmp1, llm) ! masse ! alpha determine la part des injections de donnees a chaque etape - ! alpha=1 signifie pas d'injection - ! alpha=0 signifie injection totale + ! alpha=0 signifie pas d'injection + ! alpha=1 signifie injection totale REAL, save:: alpha_q(iim + 1, jjm + 1) - REAL, save:: alpha_t(iim + 1, jjm + 1), alpha_p(ip1jmp1) + REAL, save:: alpha_t(iim + 1, jjm + 1) REAL, save:: alpha_u(iim + 1, jjm + 1), alpha_v(iim + 1, jjm) INTEGER, save:: step_rea, count_no_rea - INTEGER ilon, ilat - REAL factt ! pas de temps entre deux appels au guidage, en fraction de jour - real ztau(iim + 1, jjm + 1) - - INTEGER ij, l - INTEGER ncidpl, status - INTEGER rcod, rid + INTEGER l + INTEGER ncid, dimid REAL tau INTEGER, SAVE:: nlev ! TEST SUR QSAT REAL p(iim + 1, jjm + 1, llmp1) real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1) - REAL qsat(iim + 1, jjm + 1, llm) - INTEGER, parameter:: igrads = 2 - REAL:: dtgrads = 100. + REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm) !----------------------------------------------------------------------- - PRINT *, 'Call sequence information: guide' + !!PRINT *, 'Call sequence information: guide' first_call: IF (itau == 0) THEN - CALL conf_guide - CALL inigrads(igrads, rlonv, 180. / pi, -180., 180., rlatu, -90., & - 90., 180. / pi, presnivs, 1., dtgrads, 'guide', 'dyn_zon ') - IF (online) THEN - ! Constantes de temps de rappel en jour - - ! coordonnees du centre du zoom - CALL coordij(clon, clat, ilon, ilat) - ! aire de la maille au centre du zoom - aire_min = aire(ilon+(ilat - 1) * iip1) - ! aire maximale de la maille - aire_max = 0. - DO ij = 1, ip1jmp1 - aire_max = max(aire_max, aire(ij)) - END DO - - factt = dtvr * iperiod / daysec - - CALL tau2alpha(3, iip1, jjm, factt, tau_min_v, tau_max_v, alpha_v) - CALL tau2alpha(2, iip1, jjp1, factt, tau_min_u, tau_max_u, alpha_u) - CALL tau2alpha(1, iip1, jjp1, factt, tau_min_t, tau_max_t, alpha_t) - CALL tau2alpha(1, iip1, jjp1, factt, tau_min_p, tau_max_p, alpha_p) - CALL tau2alpha(1, iip1, jjp1, factt, tau_min_q, tau_max_q, alpha_q) - - CALL dump2d(iip1, jjp1, aire, 'AIRE MAILLe ') - CALL dump2d(iip1, jjp1, alpha_u, 'COEFF U ') - CALL dump2d(iip1, jjp1, alpha_t, 'COEFF T ') + IF (abs(grossismx - 1.) < 0.1 .OR. abs(grossismy - 1.) < 0.1) THEN + ! grille regulière + if (guide_u) alpha_u = factt / tau_max_u + if (guide_v) alpha_v = factt / tau_max_v + if (guide_t) alpha_t = factt / tau_max_t + if (guide_q) alpha_q = factt / tau_max_q + else + call init_tau2alpha(dxdys, dxdyu, dxdyv) + + if (guide_u) then + CALL tau2alpha(dxdyu, rlatu, tau_min_u, tau_max_u, alpha_u) + CALL writefield("alpha_u", alpha_u) + end if + + if (guide_v) then + CALL tau2alpha(dxdyv, rlatv, tau_min_v, tau_max_v, alpha_v) + CALL writefield("alpha_v", alpha_v) + end if + + if (guide_t) then + CALL tau2alpha(dxdys, rlatu, tau_min_t, tau_max_t, alpha_t) + CALL writefield("alpha_t", alpha_t) + end if + + if (guide_q) then + CALL tau2alpha(dxdys, rlatu, tau_min_q, tau_max_q, alpha_q) + CALL writefield("alpha_q", alpha_q) + end if + end IF ELSE - ! Cas ou on force exactement par les variables analysees - alpha_t = 0. - alpha_u = 0. - alpha_v = 0. - alpha_p = 0. + ! Cas où on force exactement par les variables analysées + if (guide_u) alpha_u = 1. + if (guide_v) alpha_v = 1. + if (guide_t) alpha_t = 1. + if (guide_q) alpha_q = 1. END IF step_rea = 1 count_no_rea = 0 - ncidpl = -99 - ! lecture d'un fichier netcdf pour determiner le nombre de niveaux - if (guide_u) call nf95_open('u.nc',Nf90_NOWRITe,ncidpl) - if (guide_v) call nf95_open('v.nc',nf90_nowrite,ncidpl) - if (guide_T) call nf95_open('T.nc',nf90_nowrite,ncidpl) - if (guide_Q) call nf95_open('hur.nc',nf90_nowrite, ncidpl) + ! lecture d'un fichier netcdf pour determiner le nombre de niveaux : + + if (guide_u) then + call nf95_open('u.nc',Nf90_NOWRITe,ncid) + else if (guide_v) then + call nf95_open('v.nc',nf90_nowrite,ncid) + else if (guide_T) then + call nf95_open('T.nc',nf90_nowrite,ncid) + else + call nf95_open('hur.nc',nf90_nowrite, ncid) + end if IF (ncep) THEN - status = nf90_inq_dimid(ncidpl, 'LEVEL', rid) + call nf95_inq_dimid(ncid, 'LEVEL', dimid) ELSE - status = nf90_inq_dimid(ncidpl, 'PRESSURE', rid) + call nf95_inq_dimid(ncid, 'PRESSURE', dimid) END IF - call nf95_inquire_dimension(ncidpl, rid, nclen=nlev) - PRINT *, 'nlev', nlev - rcod = nf90_close(ncidpl) - ! Lecture du premier etat des reanalyses. + call nf95_inquire_dimension(ncid, dimid, nclen=nlev) + PRINT *, 'nlev = ', nlev + call nf95_close(ncid) + + ! Lecture du premier état des réanalyses : CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, & masserea2, nlev) qrea2 = max(qrea2, 0.1) @@ -171,19 +168,21 @@ CALL read_reanalyse(step_rea, ps, ucovrea2, vcovrea2, tetarea2, qrea2, & masserea2, nlev) qrea2 = max(qrea2, 0.1) - factt = dtvr * iperiod / daysec - ztau = factt / max(alpha_t, 1E-10) - CALL wrgrads(igrads, 1, aire, 'aire ', 'aire ') - CALL wrgrads(igrads, 1, dxdys, 'dxdy ', 'dxdy ') - CALL wrgrads(igrads, 1, alpha_u, 'au ', 'au ') - CALL wrgrads(igrads, 1, alpha_t, 'at ', 'at ') - CALL wrgrads(igrads, 1, ztau, 'taut ', 'taut ') - CALL wrgrads(igrads, llm, ucov, 'u ', 'u ') - CALL wrgrads(igrads, llm, ucovrea2, 'ua ', 'ua ') - CALL wrgrads(igrads, llm, teta, 'T ', 'T ') - CALL wrgrads(igrads, llm, tetarea2, 'Ta ', 'Ta ') - CALL wrgrads(igrads, llm, qrea2, 'Qa ', 'Qa ') - CALL wrgrads(igrads, llm, q, 'Q ', 'Q ') + + if (guide_u) then + CALL writefield("ucov", ucov) + CALL writefield("ucovrea2", ucovrea2) + end if + + if (guide_t) then + CALL writefield("teta", teta) + CALL writefield("tetarea2", tetarea2) + end if + + if (guide_q) then + CALL writefield("qrea2", qrea2) + CALL writefield("q", q) + end if ELSE count_no_rea = count_no_rea + 1 END IF