--- trunk/libf/dyn3d/Dissipation/inidissip.f90 2011/12/12 13:25:01 55 +++ trunk/libf/dyn3d/Dissipation/inidissip.f90 2012/09/20 09:57:03 65 @@ -6,9 +6,9 @@ private llm - REAL dtdiss + REAL dtdiss ! in s integer idissip ! période de la dissipation (en pas de temps) - real tetaudiv(llm), tetaurot(llm), tetah(llm) + real tetaudiv(llm), tetaurot(llm), tetah(llm) ! in s-1 real cdivu, crot, cdivh contains @@ -20,21 +20,23 @@ ! Initialisation de la dissipation horizontale. Calcul des valeurs ! propres des opérateurs par méthode itérative. - USE comconst, ONLY : dtvr - use comdissnew, only: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, & - tetagrot, tetatemp - USE comvert, ONLY : preff, presnivs - USE conf_gcm_m, ONLY : iperiod - USE dimens_m, ONLY : iim, jjm, llm - USE paramet_m, ONLY : jjp1 - use jumble, only: new_unit + USE comconst, ONLY: dtvr + use comdissnew, only: nitergdiv, nitergrot, niterh, tetagdiv, tetagrot, & + tetatemp + USE comvert, ONLY: preff, presnivs + USE conf_gcm_m, ONLY: iperiod + USE dimens_m, ONLY: iim, jjm + use divgrad2_m, only: divgrad2 use filtreg_m, only: filtreg use gradiv2_m, only: gradiv2 + use jumble, only: new_unit + use nxgraro2_m, only: nxgraro2 + USE paramet_m, ONLY: jjp1 ! Variables local to the procedure: - REAL zvert(llm), max_zvert - REAL, dimension(iim + 1, jjm + 1):: zh, zu - real zv(iim + 1, jjm), deltap(iim + 1, jjm + 1, llm) + REAL zvert(llm), max_zvert ! no dimension + REAL, dimension(iim + 1, jjm + 1, 1):: zh, zu, gx, divgra, deltap + real zv(iim + 1, jjm, 1), gy(iim + 1, jjm, 1) REAL zllm INTEGER l, seed_size, ii, unit REAL tetamin ! in s @@ -49,78 +51,51 @@ deltap = 1. call random_number(zh) zh = zh - 0.5 - CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE., 1) + CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE.) DO l = 1, 50 - IF (lstardis) THEN - CALL divgrad2(1, zh, deltap, niterh, zh, -1.) - ELSE - CALL divgrad(1, zh, niterh, zh, -1.) - END IF - - zllm = abs(maxval(zh)) - zh = zh / zllm + CALL divgrad2(1, zh, deltap, niterh, divgra, -1.) + zllm = abs(maxval(divgra)) + zh = divgra / zllm END DO - IF (lstardis) THEN - cdivh = 1. / zllm - ELSE - cdivh = zllm**(- 1. / niterh) - END IF + cdivh = 1. / zllm PRINT *, 'cdivh = ', cdivh PRINT *, 'Calcul des valeurs propres de gradiv' call random_number(zu) zu = zu - 0.5 - CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1) + CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE.) call random_number(zv) zv = zv - 0.5 - CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1) + CALL filtreg(zv, jjm, 1, 2, 1, .FALSE.) DO l = 1, 50 - IF (lstardis) THEN - CALL gradiv2(1, zu, zv, nitergdiv, zu, zv, -1.) - ELSE - CALL gradiv(1, zu, zv, nitergdiv, zu, zv, -1.) - END IF - - zllm = max(abs(maxval(zu)), abs(maxval(zv))) - zu = zu / zllm - zv = zv / zllm + CALL gradiv2(zu, zv, nitergdiv, gx, gy, -1.) + zllm = max(abs(maxval(gx)), abs(maxval(gy))) + zu = gx / zllm + zv = gy / zllm end DO - IF (lstardis) THEN - cdivu = 1. / zllm - ELSE - cdivu = zllm**(- 1. / nitergdiv) - END IF + cdivu = 1. / zllm PRINT *, 'cdivu = ', cdivu PRINT *, 'Calcul des valeurs propres de nxgrarot' call random_number(zu) zu = zu - 0.5 - CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1) + CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE.) call random_number(zv) zv = zv - 0.5 - CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1) + CALL filtreg(zv, jjm, 1, 2, 1, .FALSE.) DO l = 1, 50 - IF (lstardis) THEN - CALL nxgraro2(1, zu, zv, nitergrot, zu, zv, -1.) - ELSE - CALL nxgrarot(1, zu, zv, nitergrot, zu, zv, -1.) - END IF - - zllm = max(abs(maxval(zu)), abs(maxval(zv))) - zu = zu / zllm - zv = zv / zllm + CALL nxgraro2(zu, zv, nitergrot, gx, gy, -1.) + zllm = max(abs(maxval(gx)), abs(maxval(gy))) + zu = gx / zllm + zv = gy / zllm end DO - IF (lstardis) THEN - crot = 1. / zllm - ELSE - crot = zllm**(-1. / nitergrot) - END IF + crot = 1. / zllm PRINT *, 'crot = ', crot ! Variation verticale du coefficient de dissipation : @@ -131,15 +106,6 @@ tetaurot = zvert / tetagrot tetah = zvert / tetatemp - call new_unit(unit) - open(unit, file="inidissip.csv", status="replace", action="write") - write(unit, fmt=*) "tetaudiv tetaurot tetah" ! title line - do l = 1, llm - write(unit, fmt=*) tetaudiv(l), tetaurot(l), tetah(l) - end do - close(unit) - print *, 'Created file "inidissip.csv".' - max_zvert = maxval(zvert) tetamin = min(1e6, tetagdiv / max_zvert, tetagrot / max_zvert, & tetatemp / max_zvert) @@ -147,7 +113,21 @@ idissip = max(1, int(tetamin / (2 * dtvr * iperiod))) * iperiod PRINT *, 'idissip = ', idissip dtdiss = idissip * dtvr - PRINT *, 'dtdiss = ', dtdiss + PRINT *, 'dtdiss = ', dtdiss, "s" + + call new_unit(unit) + open(unit, file="inidissip.csv", status="replace", action="write") + + ! Title line: + write(unit, fmt=*) '"presnivs (hPa)" "dtdiss * tetaudiv" ' & + // '"dtdiss * tetaurot" "dtdiss * tetah"' + + do l = 1, llm + write(unit, fmt=*) presnivs(l) / 100., dtdiss * tetaudiv(l), & + dtdiss * tetaurot(l), dtdiss * tetah(l) + end do + close(unit) + print *, 'Created file "inidissip.csv".' END SUBROUTINE inidissip