! $Header$ SUBROUTINE qminimum(q, nqtot, deltap) USE infotrac, ONLY: niso, ntiso, iqIsoPha, tracers USE strings_mod, ONLY: strIdx USE readTracFiles_mod, ONLY: addPhase IMPLICIT none ! ! -- Objet : Traiter les valeurs trop petites (meme negatives) ! pour l'eau vapeur et l'eau liquide ! include "dimensions.h" include "paramet.h" ! INTEGER :: nqtot REAL :: q(ip1jmp1, llm, nqtot), deltap(ip1jmp1, llm) ! LOGICAL, SAVE :: first = .TRUE. INTEGER, SAVE :: iq_vap, iq_liq ! indices pour l'eau vapeur/liquide REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide ! ! NB. ....( Il est souhaitable mais non obligatoire que les valeurs des ! parametres seuil_vap, seuil_liq soient pareilles a celles ! qui sont utilisees dans la routine ADDFI ) ! ................................................................. ! !DC iq_val and iq_liq are usable for q only, NOT for q_follow ! and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid ! water at hardcoded indices 1/2 in these variables INTEGER :: i, k, iq REAL :: zx_defau, zx_abc, zx_pump(ip1jmp1), pompe real :: zx_defau_diag(ip1jmp1, llm, 2) real :: q_follow(ip1jmp1, llm, 2) ! REAL :: SSUM ! INTEGER :: imprim SAVE imprim DATA imprim /0/ ! !INTEGER ijb,ije ! !INTEGER Index_pump(ij_end-ij_begin+1) ! !INTEGER nb_pump INTEGER :: ixt IF(first) THEN iq_vap = strIdx(tracers(:)%name, addPhase('H2O', 'g')) iq_liq = strIdx(tracers(:)%name, addPhase('H2O', 'l')) first = .FALSE. END IF ! ! Quand l'eau liquide est trop petite (ou negative), on prend ! l'eau vapeur de la meme couche et la convertit en eau liquide ! (sans changer la temperature !) ! CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 52') zx_defau_diag(:, :, :) = 0.0 q_follow(:, :, 1) = q(:, :, iq_vap) q_follow(:, :, 2) = q(:, :, iq_liq) DO k = 1, llm DO i = 1, ip1jmp1 if (seuil_liq - q(i, k, iq_liq) > 0.d0) then if (niso > 0) zx_defau_diag(i, k, 2) = AMAX1 & (seuil_liq - q(i, k, iq_liq), 0.0) q(i, k, iq_vap) = q(i, k, iq_vap) + q(i, k, iq_liq) - seuil_liq q(i, k, iq_liq) = seuil_liq endif ENDDO ENDDO ! ! Quand l'eau vapeur est trop faible (ou negative), on complete ! le defaut en prennant de l'eau vapeur de la couche au-dessous. ! DO k = llm, 2, -1 !cc zx_abc = dpres(k) / dpres(k-1) DO i = 1, ip1jmp1 if (seuil_vap - q(i, k, iq_vap) > 0.d0) then if (niso > 0) zx_defau_diag(i, k, 1) & = AMAX1(seuil_vap - q(i, k, iq_vap), 0.0) q(i, k - 1, iq_vap) = q(i, k - 1, iq_vap) - (seuil_vap & - q(i, k, iq_vap)) * deltap(i, k) / deltap(i, k - 1) q(i, k, iq_vap) = seuil_vap endif ENDDO ENDDO ! ! Quand il s'agit de la premiere couche au-dessus du sol, on ! doit imprimer un message d'avertissement (saturation possible). ! DO i = 1, ip1jmp1 zx_pump(i) = AMAX1(0.0, seuil_vap - q(i, 1, iq_vap)) q(i, 1, iq_vap) = AMAX1(q(i, 1, iq_vap), seuil_vap) ENDDO pompe = SSUM(ip1jmp1, zx_pump, 1) IF (imprim<=500 .AND. pompe>0.0) THEN WRITE(6, '(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe DO i = 1, ip1jmp1 IF (zx_pump(i)>0.0) THEN imprim = imprim + 1 PRINT*, 'QMINIMUM: en ', i, zx_pump(i) ENDIF ENDDO ENDIF ! !write(*,*) 'qminimum 128' if (niso > 0) then ! ! CRisi: traiter de même les traceurs d'eau ! ! Mais il faut les prendre à l'envers pour essayer de conserver la ! ! masse. ! ! 1) pompage dans le sol ! ! On suppose que ce pompage se fait sans isotopes -> on ne modifie ! ! rien ici et on croise les doigts pour que ça ne soit pas trop ! ! génant DO i = 1, ip1jmp1 if (zx_pump(i)>0.0) then q_follow(i, 1, 1) = q_follow(i, 1, 1) + zx_pump(i) endif !if (zx_pump(i).gt.0.0) then enddo !DO i = 1,ip1jmp1 ! ! 2) transfert de vap vers les couches plus hautes ! !write(*,*) 'qminimum 139' do k = 2, llm DO i = 1, ip1jmp1 if (zx_defau_diag(i, k, 1)>0.0) then ! ! on ajoute la vapeur en k do ixt = 1, ntiso q(i, k, iqIsoPha(ixt, iq_vap)) = q(i, k, iqIsoPha(ixt, iq_vap)) & + zx_defau_diag(i, k, 1) & * q(i, k - 1, iqIsoPha(ixt, iq_vap)) / q_follow(i, k - 1, 1) ! ! et on la retranche en k-1 q(i, k - 1, iqIsoPha(ixt, iq_vap)) = & q(i, k - 1, iqIsoPha(ixt, iq_vap)) & - zx_defau_diag(i, k, 1) & * deltap(i, k) / deltap(i, k - 1) & * q(i, k - 1, iqIsoPha(ixt, iq_vap)) & / q_follow(i, k - 1, 1) enddo !do ixt=1,niso q_follow(i, k, 1) = q_follow(i, k, 1) & + zx_defau_diag(i, k, 1) q_follow(i, k - 1, 1) = q_follow(i, k - 1, 1) & - zx_defau_diag(i, k, 1) & * deltap(i, k) / deltap(i, k - 1) endif !if (zx_defau_diag(i,k,1).gt.0.0) then enddo !DO i = 1, ip1jmp1 enddo !do k=2,llm CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 168') ! ! 3) transfert d'eau de la vapeur au liquide ! !write(*,*) 'qminimum 164' do k = 1, llm DO i = 1, ip1jmp1 if (zx_defau_diag(i, k, 2)>0.0) then ! ! on ajoute eau liquide en k en k do ixt = 1, ntiso q(i, k, iqIsoPha(ixt, iq_liq)) = q(i, k, iqIsoPha(ixt, iq_liq)) & + zx_defau_diag(i, k, 2) & * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1) ! ! et on la retranche à la vapeur en k q(i, k, iqIsoPha(ixt, iq_vap)) = q(i, k, iqIsoPha(ixt, iq_vap)) & - zx_defau_diag(i, k, 2) & * q(i, k, iqIsoPha(ixt, iq_vap)) / q_follow(i, k, 1) enddo !do ixt=1,niso q_follow(i, k, 2) = q_follow(i, k, 2) & + zx_defau_diag(i, k, 2) q_follow(i, k, 1) = q_follow(i, k, 1) & - zx_defau_diag(i, k, 2) endif !if (zx_defau_diag(i,k,1).gt.0.0) then enddo !DO i = 1, ip1jmp1 enddo !do k=2,llm CALL check_isotopes_seq(q, ip1jmp1, 'qminimum 197') endif !if (niso > 0) then ! !write(*,*) 'qminimum 188' ! RETURN END SUBROUTINE qminimum