--- trunk/dyn3d/guide.f 2014/03/11 15:09:02 88 +++ trunk/dyn3d/guide.f 2014/03/12 21:16:36 90 @@ -38,8 +38,8 @@ ! variables dynamiques REAL ucov(ip1jmp1, llm), vcov(ip1jm, llm) ! vents covariants - REAL, intent(inout):: teta(ip1jmp1, llm) ! temperature potentielle - REAL q(ip1jmp1, llm) ! temperature potentielle + REAL, intent(inout):: teta(iim + 1, jjm + 1, llm) ! température potentielle + REAL q(iim + 1, jjm + 1, llm) REAL, intent(out):: masse(ip1jmp1, llm) ! masse d'air REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol @@ -47,37 +47,37 @@ ! variables dynamiques pour les reanalyses. REAL, save:: ucovrea1(ip1jmp1, llm), vcovrea1(ip1jm, llm) !vts cov reas - REAL, save:: tetarea1(ip1jmp1, llm) ! temp pot reales - REAL, save:: qrea1(ip1jmp1, llm) ! temp pot reales + REAL, save:: tetarea1(iim + 1, jjm + 1, llm) ! temp pot reales + REAL, save:: qrea1(iim + 1, jjm + 1, llm) ! temp pot reales REAL, save:: ucovrea2(ip1jmp1, llm), vcovrea2(ip1jm, llm) !vts cov reas - REAL, save:: tetarea2(ip1jmp1, llm) ! temp pot reales - REAL, save:: qrea2(ip1jmp1, llm) ! temp pot reales + REAL, save:: tetarea2(iim + 1, jjm + 1, llm) ! temp pot reales + REAL, save:: qrea2(iim + 1, jjm + 1, llm) ! temp pot reales REAL, save:: masserea2(ip1jmp1, llm) ! masse - REAL, save:: alpha_q(ip1jmp1) - REAL, save:: alpha_t(ip1jmp1), alpha_p(ip1jmp1) + REAL, save:: alpha_q(iim + 1, jjm + 1) + REAL, save:: alpha_t(iim + 1, jjm + 1), alpha_p(ip1jmp1) REAL, save:: alpha_u(ip1jmp1), alpha_v(ip1jm) REAL dday_step, toto, reste real, save:: itau_test INTEGER, save:: step_rea, count_no_rea INTEGER ilon, ilat - REAL factt, ztau(ip1jmp1) + REAL factt, ztau(iim + 1, jjm + 1) - INTEGER ij, l - INTEGER ncidpl, varidpl, status + INTEGER ij, i, j, l + INTEGER ncidpl, status INTEGER rcod, rid REAL ditau, tau, a INTEGER, SAVE:: nlev ! TEST SUR QSAT - REAL p(iim + 1, jjm + 1, llmp1), pk(ip1jmp1, llm), pks(ip1jmp1) - REAL pkf(ip1jmp1, llm) - REAL pres(ip1jmp1, llm) + REAL p(iim + 1, jjm + 1, llmp1) + real pk(iim + 1, jjm + 1, llm), pks(iim + 1, jjm + 1) + REAL pres(iim + 1, jjm + 1, llm) - REAL qsat(ip1jmp1, llm) + REAL qsat(iim + 1, jjm + 1, llm) REAL unskap - REAL tnat(ip1jmp1, llm) + REAL tnat(iim + 1, jjm + 1, llm) LOGICAL:: first = .TRUE. CHARACTER(len=10) file @@ -92,10 +92,10 @@ forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps CALL massdair(p, masse) - CALL exner_hyb(ps, p, pks, pk, pkf) - tnat(:, :) = pk(:, :)*teta(:, :)/cpp - unskap = 1./kappa - pres(:, :) = preff*(pk(:, :)/cpp)**unskap + CALL exner_hyb(ps, p, pks, pk) + tnat = pk * teta / cpp + unskap = 1. / kappa + pres = preff * (pk / cpp)**unskap qsat = q_sat(tnat, pres) ! initialisations pour la lecture des reanalyses. @@ -103,17 +103,17 @@ ! alpha=1 signifie pas d'injection ! alpha=0 signifie injection totale - IF (online==-1) THEN + IF (online== - 1) THEN RETURN END IF IF (first) THEN CALL conf_guide file = 'guide' - CALL inigrads(igrads, rlonv, 180./pi, -180., 180., rlatu, -90., 90., & - 180./pi, presnivs, 1., dtgrads, file, 'dyn_zon ') + CALL inigrads(igrads, rlonv, 180. / pi, -180., 180., rlatu, -90., 90., & + 180. / pi, presnivs, 1., dtgrads, file, 'dyn_zon ') PRINT *, '1: en-ligne, 0: hors-ligne (x=x_rea), -1: climat (x=x_gcm)' - IF (online==-1) RETURN + IF (online== - 1) RETURN IF (online==1) THEN ! Constantes de temps de rappel en jour @@ -123,14 +123,14 @@ ! 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_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 = pas de temps en fraction de jour - factt = dtvr*iperiod/daysec + 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) @@ -159,19 +159,19 @@ ! itau_test montre si l'importation a deja ete faite au rang itau ! lecture d'un fichier netcdf pour determiner le nombre de niveaux if (guide_u) then - if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) + if (ncidpl.eq. - 99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) endif if (guide_v) then - if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) + if (ncidpl.eq. - 99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) endif if (guide_T) then - if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) + if (ncidpl.eq. - 99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) endif if (guide_Q) then - if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) + if (ncidpl.eq. - 99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) endif IF (ncep) THEN @@ -185,7 +185,7 @@ ! Lecture du premier etat des reanalyses. CALL read_reanalyse(1, ps, ucovrea2, vcovrea2, tetarea2, qrea2, & masserea2, nlev) - qrea2(:, :) = max(qrea2(:, :), 0.1) + qrea2 = max(qrea2, 0.1) ! Debut de l'integration temporelle: END IF ! first @@ -196,7 +196,7 @@ dday_step = real(day_step) WRITE (*, *) 'ditau, dday_step' WRITE (*, *) ditau, dday_step - toto = 4*ditau/dday_step + toto = 4 * ditau / dday_step reste = toto - aint(toto) IF (reste==0.) THEN @@ -204,10 +204,10 @@ WRITE (*, *) 'deuxieme passage de advreel a itau=', itau STOP ELSE - vcovrea1(:, :) = vcovrea2(:, :) - ucovrea1(:, :) = ucovrea2(:, :) - tetarea1(:, :) = tetarea2(:, :) - qrea1(:, :) = qrea2(:, :) + vcovrea1 = vcovrea2 + ucovrea1 = ucovrea2 + tetarea1 = tetarea2 + qrea1 = qrea2 PRINT *, 'LECTURE REANALYSES, pas ', step_rea, 'apres ', & count_no_rea, ' non lectures' @@ -215,9 +215,9 @@ itau_test = itau 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(:), 1.E-10) + 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 ') @@ -238,22 +238,22 @@ END IF ! Guidage - ! x_gcm = a * x_gcm + (1-a) * x_reanalyses + ! x_gcm = a * x_gcm + (1 - a) * x_reanalyses IF (ini_anal) PRINT *, 'ATTENTION !!! ON PART DU GUIDAGE' ditau = real(itau) dday_step = real(day_step) - tau = 4*ditau/dday_step + tau = 4 * ditau / dday_step tau = tau - aint(tau) ! ucov IF (guide_u) THEN DO l = 1, llm DO ij = 1, ip1jmp1 - a = (1.-tau)*ucovrea1(ij, l) + tau*ucovrea2(ij, l) - ucov(ij, l) = (1.-alpha_u(ij))*ucov(ij, l) + alpha_u(ij)*a + a = (1. - tau) * ucovrea1(ij, l) + tau * ucovrea2(ij, l) + ucov(ij, l) = (1. - alpha_u(ij)) * ucov(ij, l) + alpha_u(ij) * a IF (first .AND. ini_anal) ucov(ij, l) = a END DO END DO @@ -261,23 +261,29 @@ IF (guide_t) THEN DO l = 1, llm - DO ij = 1, ip1jmp1 - a = (1.-tau)*tetarea1(ij, l) + tau*tetarea2(ij, l) - teta(ij, l) = (1.-alpha_t(ij))*teta(ij, l) + alpha_t(ij)*a - IF (first .AND. ini_anal) teta(ij, l) = a - END DO + do j = 1, jjm + 1 + DO i = 1, iim + 1 + a = (1. - tau) * tetarea1(i, j, l) + tau * tetarea2(i, j, l) + teta(i, j, l) = (1. - alpha_t(i, j)) * teta(i, j, l) & + + alpha_t(i, j) * a + IF (first .AND. ini_anal) teta(i, j, l) = a + END DO + end do END DO END IF IF (guide_q) THEN DO l = 1, llm - DO ij = 1, ip1jmp1 - a = (1.-tau)*qrea1(ij, l) + tau*qrea2(ij, l) - ! hum relative en % -> hum specif - a = qsat(ij, l)*a*0.01 - q(ij, l) = (1.-alpha_q(ij))*q(ij, l) + alpha_q(ij)*a - IF (first .AND. ini_anal) q(ij, l) = a - END DO + do j = 1, jjm + 1 + DO i = 1, iim + 1 + a = (1. - tau) * qrea1(i, j, l) + tau * qrea2(i, j, l) + ! hum relative en % -> hum specif + a = qsat(i, j, l) * a * 0.01 + q(i, j, l) = (1. - alpha_q(i, j)) * q(i, j, l) & + + alpha_q(i, j) * a + IF (first .AND. ini_anal) q(i, j, l) = a + END DO + end do END DO END IF @@ -285,8 +291,8 @@ IF (guide_v) THEN DO l = 1, llm DO ij = 1, ip1jm - a = (1.-tau)*vcovrea1(ij, l) + tau*vcovrea2(ij, l) - vcov(ij, l) = (1.-alpha_v(ij))*vcov(ij, l) + alpha_v(ij)*a + a = (1. - tau) * vcovrea1(ij, l) + tau * vcovrea2(ij, l) + vcov(ij, l) = (1. - alpha_v(ij)) * vcov(ij, l) + alpha_v(ij) * a IF (first .AND. ini_anal) vcov(ij, l) = a END DO IF (first .AND. ini_anal) vcov(ij, l) = a