Changeset 5001 for LMDZ6/trunk/libf/dyn3d
- Timestamp:
- Jul 1, 2024, 11:25:05 AM (3 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/qminimum.F
r4143 r5001 28 28 c ................................................................. 29 29 c 30 cDC iq_val and iq_liq are usable for q only, NOT for q_follow 31 c and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid 32 c water at hardcoded indices 1/2 in these variables 30 33 INTEGER i, k, iq 31 34 REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe … … 58 61 59 62 zx_defau_diag(:,:,:)=0.0 60 q_follow(:,:,1:2)=q(:,:,1:2) 61 DO 1000 k = 1, llm 62 DO 1040 i = 1, ip1jmp1 63 q_follow(:,:,1)=q(:,:,iq_vap) 64 q_follow(:,:,2)=q(:,:,iq_liq) 65 DO k = 1, llm 66 DO i = 1, ip1jmp1 63 67 if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then 64 68 65 if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX169 if (niso > 0) zx_defau_diag(i,k,2)=AMAX1 66 70 : ( seuil_liq - q(i,k,iq_liq), 0.0 ) 67 71 68 69 70 71 1040 CONTINUE72 1000 CONTINUE72 q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq 73 q(i,k,iq_liq) = seuil_liq 74 endif 75 ENDDO 76 ENDDO 73 77 c 74 78 c Quand l'eau vapeur est trop faible (ou negative), on complete 75 79 c le defaut en prennant de l'eau vapeur de la couche au-dessous. 76 80 c 77 iq = iq_vap78 c79 81 DO k = llm, 2, -1 80 82 ccc zx_abc = dpres(k) / dpres(k-1) 81 83 DO i = 1, ip1jmp1 82 if ( seuil_vap - q(i,k,iq ) .gt. 0.d0 ) then84 if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then 83 85 84 if (niso > 0) 85 & zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )86 if (niso > 0) zx_defau_diag(i,k,1) 87 & = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 ) 86 88 87 q(i,k-1,iq) = q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) * 88 & deltap(i,k) / deltap(i,k-1) 89 q(i,k,iq) = seuil_vap 89 q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap 90 & -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1) 91 q(i,k,iq_vap) = seuil_vap 92 90 93 endif 91 94 ENDDO 92 95 ENDDO 96 93 97 c 94 98 c Quand il s'agit de la premiere couche au-dessus du sol, on … … 96 100 c 97 101 DO i = 1, ip1jmp1 98 zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq ) )99 q(i,1,iq ) = AMAX1( q(i,1,iq), seuil_vap )102 zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) ) 103 q(i,1,iq_vap) = AMAX1( q(i,1,iq_vap), seuil_vap ) 100 104 ENDDO 101 105 pompe = SSUM(ip1jmp1,zx_pump,1) … … 121 125 DO i = 1,ip1jmp1 122 126 if (zx_pump(i).gt.0.0) then 123 q_follow(i,1, iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)127 q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i) 124 128 endif !if (zx_pump(i).gt.0.0) then 125 129 enddo !DO i = 1,ip1jmp1 … … 129 133 do k=2,llm 130 134 DO i = 1,ip1jmp1 131 if (zx_defau_diag(i,k, iq_vap).gt.0.0) then135 if (zx_defau_diag(i,k,1).gt.0.0) then 132 136 ! on ajoute la vapeur en k 133 137 do ixt=1,ntiso 134 138 q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) 135 : +zx_defau_diag(i,k, iq_vap)136 : *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1, iq_vap)139 : +zx_defau_diag(i,k,1) 140 : *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1) 137 141 138 142 ! et on la retranche en k-1 139 143 q(i,k-1,iqIsoPha(ixt,iq_vap))= 140 144 : q(i,k-1,iqIsoPha(ixt,iq_vap)) 141 : -zx_defau_diag(i,k, iq_vap)145 : -zx_defau_diag(i,k,1) 142 146 : *deltap(i,k)/deltap(i,k-1) 143 147 : *q(i,k-1,iqIsoPha(ixt,iq_vap)) 144 : /q_follow(i,k-1, iq_vap)148 : /q_follow(i,k-1,1) 145 149 146 150 enddo !do ixt=1,niso 147 q_follow(i,k, iq_vap)= q_follow(i,k,iq_vap)148 : +zx_defau_diag(i,k, iq_vap)149 q_follow(i,k-1, iq_vap)= q_follow(i,k-1,iq_vap)150 : -zx_defau_diag(i,k, iq_vap)151 q_follow(i,k,1)= q_follow(i,k,1) 152 : +zx_defau_diag(i,k,1) 153 q_follow(i,k-1,1)= q_follow(i,k-1,1) 154 : -zx_defau_diag(i,k,1) 151 155 : *deltap(i,k)/deltap(i,k-1) 152 endif !if (zx_defau_diag(i,k, iq_vap).gt.0.0) then156 endif !if (zx_defau_diag(i,k,1).gt.0.0) then 153 157 enddo !DO i = 1, ip1jmp1 154 158 enddo !do k=2,llm … … 161 165 do k=1,llm 162 166 DO i = 1,ip1jmp1 163 if (zx_defau_diag(i,k, iq_liq).gt.0.0) then167 if (zx_defau_diag(i,k,2).gt.0.0) then 164 168 165 169 ! on ajoute eau liquide en k en k 166 170 do ixt=1,ntiso 167 171 q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq)) 168 : +zx_defau_diag(i,k, iq_liq)169 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k, iq_vap)172 : +zx_defau_diag(i,k,2) 173 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1) 170 174 ! et on la retranche à la vapeur en k 171 175 q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) 172 : -zx_defau_diag(i,k, iq_liq)173 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k, iq_vap)176 : -zx_defau_diag(i,k,2) 177 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1) 174 178 enddo !do ixt=1,niso 175 q_follow(i,k, iq_liq)= q_follow(i,k,iq_liq)176 : +zx_defau_diag(i,k, iq_liq)177 q_follow(i,k, iq_vap)= q_follow(i,k,iq_vap)178 : -zx_defau_diag(i,k, iq_liq)179 endif !if (zx_defau_diag(i,k, iq_vap).gt.0.0) then179 q_follow(i,k,2)= q_follow(i,k,2) 180 : +zx_defau_diag(i,k,2) 181 q_follow(i,k,1)= q_follow(i,k,1) 182 : -zx_defau_diag(i,k,2) 183 endif !if (zx_defau_diag(i,k,1).gt.0.0) then 180 184 enddo !DO i = 1, ip1jmp1 181 185 enddo !do k=2,llm
Note: See TracChangeset
for help on using the changeset viewer.