--- trunk/dyn3d/advtrac.f 2014/03/05 14:57:53 82 +++ trunk/Sources/dyn3d/advtrac.f 2016/03/11 18:47:26 178 @@ -11,10 +11,12 @@ USE comconst, ONLY : dtvr USE conf_gcm_m, ONLY : iapp_tracvl - USE dimens_m, ONLY : iim, jjm, llm, nqmx + USE dimens_m, ONLY : jjm, llm, nqmx USE iniadvtrac_m, ONLY : iadv - USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, jjp1, & - llmp1 + use massbar_m, only: massbar + USE paramet_m, ONLY : iip1, iip2, ijmllm, ijp1llm, ip1jm, ip1jmp1, llmp1 + use vlsplt_m, only: vlsplt + use vlspltqs_m, only: vlspltqs REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm) REAL, intent(in):: p(ip1jmp1, llmp1) @@ -31,26 +33,15 @@ REAL, save:: massem(ip1jmp1, llm) real zdp(ip1jmp1) REAL pbarug(ip1jmp1, llm), pbarvg(ip1jm, llm), wg(ip1jmp1, llm) - REAL cpuadv(nqmx) INTEGER:: iadvtr = 0 INTEGER ij, l, iq REAL zdpmin, zdpmax EXTERNAL minmax - ! Rajouts pour PPM - INTEGER indice, n ! Pas de temps adaptatif pour que CFL < 1 REAL dtbon - REAL cflmaxz ! CFL maximum - real aaa, bbb - REAL psppm(iim, jjp1) ! pression au sol - REAL unatppm(iim, jjp1, llm), vnatppm(iim, jjp1, llm) - REAL qppm(iim*jjp1, llm, nqmx) - REAL fluxwppm(iim, jjp1, llm) - REAL apppm(llmp1), bpppm(llmp1) - LOGICAL:: dum = .TRUE., fill = .TRUE. !----------------------------------------------------------- @@ -81,7 +72,7 @@ ! 1. calcul de w ! 2. groupement des mailles pres du pole. - CALL groupe(massem, pbaruc, pbarvc, pbarug, pbarvg, wg) + CALL groupe(pbaruc, pbarvc, pbarug, pbarvg, wg) ! test sur l'eventuelle creation de valeurs negatives de la masse DO l = 1, llm - 1 @@ -103,27 +94,20 @@ ! Advection proprement dite - ! Calcul des moyennes basées sur la masse + ! Calcul des moyennes bas\'ees sur la masse CALL massbar(massem, massebx, masseby) ! Appel des sous programmes d'advection DO iq = 1, nqmx - IF (iadv(iq)==0) CYCLE - - ! Schema de Van Leer I MUSCL - - IF (iadv(iq)==10) THEN + select case (iadv(iq)) + case (10) + ! Schema de Van Leer I MUSCL CALL vlsplt(q(:, :, iq), 2., massem, wg, pbarug, pbarvg, dtvr) - ! Schema "pseudo amont" + test sur humidite specifique - ! pour la vapeur d'eau. F. Codron - ELSE IF (iadv(iq)==14) THEN - CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, & - p, pk, teta) + case (12) ! Schema de Frederic Hourdin - ELSE IF (iadv(iq)==12) THEN ! Pas de temps adaptatif - CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem) + CALL adaptdt(dtbon, n, pbarug, massem) IF (n>1) THEN WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, & 'n=', n @@ -131,9 +115,9 @@ DO indice = 1, n CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 1) END DO - ELSE IF (iadv(iq)==13) THEN + case (13) ! Pas de temps adaptatif - CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem) + CALL adaptdt(dtbon, n, pbarug, massem) IF (n>1) THEN WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, & 'n=', n @@ -141,77 +125,12 @@ DO indice = 1, n CALL advn(q(1, 1, iq), massem, wg, pbarug, pbarvg, dtbon, 2) END DO - ! Schema de pente SLOPES - ELSE IF (iadv(iq)==20) THEN - CALL pentes_ini(q(1, 1, iq), wg, massem, pbarug, pbarvg, 0) - ! Schema de Prather - ELSE IF (iadv(iq)==30) THEN - ! Pas de temps adaptatif - CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem) - IF (n>1) THEN - WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, & - 'n=', n - END IF - CALL prather(q(1, 1, iq), wg, massem, pbarug, pbarvg, n, dtbon) - ! Schemas PPM Lin et Rood - ELSE IF (iadv(iq)==11 .OR. (iadv(iq)>=16 .AND. iadv(iq)<=18)) THEN - ! Test sur le flux horizontal - ! Pas de temps adaptatif - CALL adaptdt(iadv(iq), dtbon, n, pbarug, massem) - IF (n>1) THEN - WRITE (*, *) 'WARNING horizontal dt=', dtbon, 'dtvr=', dtvr, & - 'n=', n - END IF - ! Test sur le flux vertical - cflmaxz = 0. - DO l = 2, llm - DO ij = iip2, ip1jm - aaa = wg(ij, l)*dtvr/massem(ij, l) - cflmaxz = max(cflmaxz, aaa) - bbb = -wg(ij, l)*dtvr/massem(ij, l-1) - cflmaxz = max(cflmaxz, bbb) - END DO - END DO - IF (cflmaxz>=1) THEN - WRITE (*, *) 'WARNING vertical', 'CFLmaxz=', cflmaxz - END IF - - ! Ss-prg interface LMDZ.4->PPM3d - CALL interpre(q(1, 1, iq), qppm(1, 1, iq), wg, fluxwppm, massem, & - apppm, bpppm, massebx, masseby, pbarug, pbarvg, unatppm, & - vnatppm, psppm) - - DO indice = 1, n - ! VL (version PPM) horiz. et PPM vert. - IF (iadv(iq)==11) THEN - ! Ss-prg PPM3d de Lin - CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, & - vnatppm, fluxwppm, dtbon, 2, 2, 2, 1, iim, jjp1, 2, & - llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.) - ! Monotonic PPM - ELSE IF (iadv(iq)==16) THEN - ! Ss-prg PPM3d de Lin - CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, & - vnatppm, fluxwppm, dtbon, 3, 3, 3, 1, iim, jjp1, 2, & - llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.) - ! Semi Monotonic PPM - ELSE IF (iadv(iq)==17) THEN - ! Ss-prg PPM3d de Lin - CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, & - vnatppm, fluxwppm, dtbon, 4, 4, 4, 1, iim, jjp1, 2, & - llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.) - ! Positive Definite PPM - ELSE IF (iadv(iq)==18) THEN - ! Ss-prg PPM3d de Lin - CALL ppm3d(1, qppm(1, 1, iq), psppm, psppm, unatppm, & - vnatppm, fluxwppm, dtbon, 5, 5, 5, 1, iim, jjp1, 2, & - llm, apppm, bpppm, 0.01, 6400000, fill, dum, 220.) - END IF - END DO - - ! Ss-prg interface PPM3d-LMDZ.4 - CALL interpost(q(1, 1, iq), qppm(1, 1, iq)) - END IF + case (14) + ! Schema "pseudo amont" + test sur humidite specifique + ! pour la vapeur d'eau. F. Codron + CALL vlspltqs(q(1, 1, 1), 2., massem, wg, pbarug, pbarvg, dtvr, & + p, pk, teta) + END select END DO ! on reinitialise a zero les flux de masse cumules