| Directory: | ./ |
|---|---|
| File: | dyn/qminimum.f |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 22 | 56 | 39.3% |
| Branches: | 24 | 60 | 40.0% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | ! | ||
| 2 | ! $Header$ | ||
| 3 | ! | ||
| 4 | 3361 | SUBROUTINE qminimum( q,nqtot,deltap ) | |
| 5 | |||
| 6 | USE infotrac, ONLY: ok_isotopes,ntraciso,iqiso,ok_iso_verif | ||
| 7 | IMPLICIT none | ||
| 8 | c | ||
| 9 | c -- Objet : Traiter les valeurs trop petites (meme negatives) | ||
| 10 | c pour l'eau vapeur et l'eau liquide | ||
| 11 | c | ||
| 12 | include "dimensions.h" | ||
| 13 | include "paramet.h" | ||
| 14 | c | ||
| 15 | INTEGER nqtot | ||
| 16 | REAL q(ip1jmp1,llm,nqtot), deltap(ip1jmp1,llm) | ||
| 17 | c | ||
| 18 | INTEGER iq_vap, iq_liq | ||
| 19 | PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur | ||
| 20 | PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide | ||
| 21 | REAL seuil_vap, seuil_liq | ||
| 22 | PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur | ||
| 23 | PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide | ||
| 24 | c | ||
| 25 | c NB. ....( Il est souhaitable mais non obligatoire que les valeurs des | ||
| 26 | c parametres seuil_vap, seuil_liq soient pareilles a celles | ||
| 27 | c qui sont utilisees dans la routine ADDFI ) | ||
| 28 | c ................................................................. | ||
| 29 | c | ||
| 30 | INTEGER i, k, iq | ||
| 31 | REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe | ||
| 32 | |||
| 33 | real zx_defau_diag(ip1jmp1,llm,2) | ||
| 34 | real q_follow(ip1jmp1,llm,2) | ||
| 35 | c | ||
| 36 | REAL SSUM | ||
| 37 | c | ||
| 38 | INTEGER imprim | ||
| 39 | SAVE imprim | ||
| 40 | DATA imprim /0/ | ||
| 41 | !INTEGER ijb,ije | ||
| 42 | !INTEGER Index_pump(ij_end-ij_begin+1) | ||
| 43 | !INTEGER nb_pump | ||
| 44 | INTEGER ixt | ||
| 45 | c | ||
| 46 | c Quand l'eau liquide est trop petite (ou negative), on prend | ||
| 47 | c l'eau vapeur de la meme couche et la convertit en eau liquide | ||
| 48 | c (sans changer la temperature !) | ||
| 49 | c | ||
| 50 | |||
| 51 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 3361 times.
|
3361 | if (ok_iso_verif) then |
| 52 | ✗ | call check_isotopes_seq(q,ip1jmp1,'qminimum 52') | |
| 53 | endif !if (ok_iso_verif) then | ||
| 54 | |||
| 55 | 3361 | zx_defau_diag(:,:,:)=0.0 | |
| 56 |
6/6✓ Branch 0 taken 3361 times.
✓ Branch 1 taken 6722 times.
✓ Branch 2 taken 262158 times.
✓ Branch 3 taken 6722 times.
✓ Branch 4 taken 285490062 times.
✓ Branch 5 taken 262158 times.
|
285762303 | q_follow(:,:,1:2)=q(:,:,1:2) |
| 57 |
2/2✓ Branch 0 taken 3361 times.
✓ Branch 1 taken 131079 times.
|
134440 | DO 1000 k = 1, llm |
| 58 |
2/2✓ Branch 0 taken 142745031 times.
✓ Branch 1 taken 131079 times.
|
142876110 | DO 1040 i = 1, ip1jmp1 |
| 59 |
2/2✓ Branch 0 taken 23672990 times.
✓ Branch 1 taken 119072041 times.
|
142745031 | if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then |
| 60 | |||
| 61 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 23672990 times.
|
23672990 | if (ok_isotopes) then |
| 62 | zx_defau_diag(i,k,iq_liq)=AMAX1 | ||
| 63 | ✗ | : ( seuil_liq - q(i,k,iq_liq), 0.0 ) | |
| 64 | endif !if (ok_isotopes) then | ||
| 65 | |||
| 66 | 23672990 | q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq | |
| 67 | 23672990 | q(i,k,iq_liq) = seuil_liq | |
| 68 | endif | ||
| 69 | 131079 | 1040 CONTINUE | |
| 70 | 3361 | 1000 CONTINUE | |
| 71 | c | ||
| 72 | c Quand l'eau vapeur est trop faible (ou negative), on complete | ||
| 73 | c le defaut en prennant de l'eau vapeur de la couche au-dessous. | ||
| 74 | c | ||
| 75 | iq = iq_vap | ||
| 76 | c | ||
| 77 |
2/2✓ Branch 0 taken 127718 times.
✓ Branch 1 taken 3361 times.
|
131079 | DO k = llm, 2, -1 |
| 78 | ccc zx_abc = dpres(k) / dpres(k-1) | ||
| 79 |
2/2✓ Branch 0 taken 139084902 times.
✓ Branch 1 taken 127718 times.
|
139215981 | DO i = 1, ip1jmp1 |
| 80 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 139084902 times.
|
139212620 | if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then |
| 81 | |||
| 82 | ✗ | if (ok_isotopes) then | |
| 83 | ✗ | zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 ) | |
| 84 | endif !if (ok_isotopes) then | ||
| 85 | |||
| 86 | q(i,k-1,iq) = q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) * | ||
| 87 | ✗ | & deltap(i,k) / deltap(i,k-1) | |
| 88 | ✗ | q(i,k,iq) = seuil_vap | |
| 89 | endif | ||
| 90 | ENDDO | ||
| 91 | ENDDO | ||
| 92 | c | ||
| 93 | c Quand il s'agit de la premiere couche au-dessus du sol, on | ||
| 94 | c doit imprimer un message d'avertissement (saturation possible). | ||
| 95 | c | ||
| 96 |
2/2✓ Branch 0 taken 3660129 times.
✓ Branch 1 taken 3361 times.
|
3663490 | DO i = 1, ip1jmp1 |
| 97 | 3660129 | zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) ) | |
| 98 | 3663490 | q(i,1,iq) = AMAX1( q(i,1,iq), seuil_vap ) | |
| 99 | ENDDO | ||
| 100 | 3361 | pompe = SSUM(ip1jmp1,zx_pump,1) | |
| 101 |
2/4✓ Branch 0 taken 3361 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 3361 times.
|
3361 | IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN |
| 102 | ✗ | WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe | |
| 103 | ✗ | DO i = 1, ip1jmp1 | |
| 104 | ✗ | IF (zx_pump(i).GT.0.0) THEN | |
| 105 | ✗ | imprim = imprim + 1 | |
| 106 | ✗ | PRINT*,'QMINIMUM: en ',i,zx_pump(i) | |
| 107 | ENDIF | ||
| 108 | ENDDO | ||
| 109 | ENDIF | ||
| 110 | |||
| 111 | !write(*,*) 'qminimum 128' | ||
| 112 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 3361 times.
|
3361 | if (ok_isotopes) then |
| 113 | ! CRisi: traiter de même les traceurs d'eau | ||
| 114 | ! Mais il faut les prendre à l'envers pour essayer de conserver la | ||
| 115 | ! masse. | ||
| 116 | ! 1) pompage dans le sol | ||
| 117 | ! On suppose que ce pompage se fait sans isotopes -> on ne modifie | ||
| 118 | ! rien ici et on croise les doigts pour que ça ne soit pas trop | ||
| 119 | ! génant | ||
| 120 | ✗ | DO i = 1,ip1jmp1 | |
| 121 | ✗ | if (zx_pump(i).gt.0.0) then | |
| 122 | ✗ | q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i) | |
| 123 | endif !if (zx_pump(i).gt.0.0) then | ||
| 124 | enddo !DO i = 1,ip1jmp1 | ||
| 125 | |||
| 126 | ! 2) transfert de vap vers les couches plus hautes | ||
| 127 | !write(*,*) 'qminimum 139' | ||
| 128 | ✗ | do k=2,llm | |
| 129 | ✗ | DO i = 1,ip1jmp1 | |
| 130 | ✗ | if (zx_defau_diag(i,k,iq_vap).gt.0.0) then | |
| 131 | ! on ajoute la vapeur en k | ||
| 132 | ✗ | do ixt=1,ntraciso | |
| 133 | q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap)) | ||
| 134 | : +zx_defau_diag(i,k,iq_vap) | ||
| 135 | ✗ | : *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap) | |
| 136 | |||
| 137 | ! et on la retranche en k-1 | ||
| 138 | q(i,k-1,iqiso(ixt,iq_vap))=q(i,k-1,iqiso(ixt,iq_vap)) | ||
| 139 | : -zx_defau_diag(i,k,iq_vap) | ||
| 140 | : *deltap(i,k)/deltap(i,k-1) | ||
| 141 | ✗ | : *q(i,k-1,iqiso(ixt,iq_vap))/q_follow(i,k-1,iq_vap) | |
| 142 | |||
| 143 | enddo !do ixt=1,niso | ||
| 144 | q_follow(i,k,iq_vap)= q_follow(i,k,iq_vap) | ||
| 145 | ✗ | : +zx_defau_diag(i,k,iq_vap) | |
| 146 | q_follow(i,k-1,iq_vap)= q_follow(i,k-1,iq_vap) | ||
| 147 | : -zx_defau_diag(i,k,iq_vap) | ||
| 148 | ✗ | : *deltap(i,k)/deltap(i,k-1) | |
| 149 | endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then | ||
| 150 | enddo !DO i = 1, ip1jmp1 | ||
| 151 | enddo !do k=2,llm | ||
| 152 | |||
| 153 | ✗ | if (ok_iso_verif) then | |
| 154 | ✗ | call check_isotopes_seq(q,ip1jmp1,'qminimum 168') | |
| 155 | endif !if (ok_iso_verif) then | ||
| 156 | |||
| 157 | |||
| 158 | ! 3) transfert d'eau de la vapeur au liquide | ||
| 159 | !write(*,*) 'qminimum 164' | ||
| 160 | ✗ | do k=1,llm | |
| 161 | ✗ | DO i = 1,ip1jmp1 | |
| 162 | ✗ | if (zx_defau_diag(i,k,iq_liq).gt.0.0) then | |
| 163 | |||
| 164 | ! on ajoute eau liquide en k en k | ||
| 165 | ✗ | do ixt=1,ntraciso | |
| 166 | q(i,k,iqiso(ixt,iq_liq))=q(i,k,iqiso(ixt,iq_liq)) | ||
| 167 | : +zx_defau_diag(i,k,iq_liq) | ||
| 168 | ✗ | : *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap) | |
| 169 | ! et on la retranche à la vapeur en k | ||
| 170 | q(i,k,iqiso(ixt,iq_vap))=q(i,k,iqiso(ixt,iq_vap)) | ||
| 171 | : -zx_defau_diag(i,k,iq_liq) | ||
| 172 | ✗ | : *q(i,k,iqiso(ixt,iq_vap))/q_follow(i,k,iq_vap) | |
| 173 | enddo !do ixt=1,niso | ||
| 174 | q_follow(i,k,iq_liq)= q_follow(i,k,iq_liq) | ||
| 175 | ✗ | : +zx_defau_diag(i,k,iq_liq) | |
| 176 | q_follow(i,k,iq_vap)= q_follow(i,k,iq_vap) | ||
| 177 | ✗ | : -zx_defau_diag(i,k,iq_liq) | |
| 178 | endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then | ||
| 179 | enddo !DO i = 1, ip1jmp1 | ||
| 180 | enddo !do k=2,llm | ||
| 181 | |||
| 182 | ✗ | if (ok_iso_verif) then | |
| 183 | ✗ | call check_isotopes_seq(q,ip1jmp1,'qminimum 197') | |
| 184 | endif !if (ok_iso_verif) then | ||
| 185 | |||
| 186 | endif !if (ok_isotopes) then | ||
| 187 | !write(*,*) 'qminimum 188' | ||
| 188 | |||
| 189 | c | ||
| 190 | 3361 | RETURN | |
| 191 | END | ||
| 192 |