Changeset 855
- Timestamp:
- Oct 23, 2007, 3:03:13 PM (17 years ago)
- Location:
- LMDZ4/trunk/libf/phytherm
- Files:
-
- 1 deleted
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phytherm/thermcell_flux.F90
r852 r855 1 ! 2 ! $Header$ 3 ! 4 5 1 6 SUBROUTINE thermcell_flux(ngrid,klev,ptimestep,masse, & 2 7 & lalim,lmax,alim_star, & … … 152 157 & ptimestep,masse,entr,detr,fm,'2 ') 153 158 159 160 161 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 162 ! FH Version en cours de test; 163 ! par rapport a thermcell_flux, on fait une grande boucle sur "l" 164 ! et on modifie le flux avec tous les contrôles appliques d'affilee 165 ! pour la meme couche 166 ! Momentanement, on duplique le calcule du flux pour pouvoir comparer 167 ! les flux avant et apres modif 168 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 169 170 do l=1,klev 171 172 do ig=1,ngrid 173 if (l.lt.lmax(ig)) then 174 fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l) 175 elseif(l.eq.lmax(ig)) then 176 fm(ig,l+1)=0. 177 detr(ig,l)=fm(ig,l)+entr(ig,l) 178 else 179 fm(ig,l+1)=0. 180 endif 181 enddo 182 183 154 184 !------------------------------------------------------------------------- 155 185 ! Verification de la positivite des flux de masse 156 186 !------------------------------------------------------------------------- 157 187 158 188 ! do l=1,klev 159 189 do ig=1,ngrid 160 190 if (fm(ig,l+1).lt.0.) then … … 165 195 endif 166 196 enddo 167 168 169 if (lev_out.ge.10) & 170 & call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &171 & ptimestep,masse,entr,detr,fm,'3 ')197 ! enddo 198 199 if (lev_out.ge.10) & 200 & write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & 201 & entr(igout,l),detr(igout,l),fm(igout,l+1) 172 202 173 203 !------------------------------------------------------------------------- … … 175 205 !------------------------------------------------------------------------- 176 206 177 do l=1,klev 207 208 if (1.eq.0) then 209 ! do l=1,klev 178 210 do ig=1,ngrid 179 211 if (l.ge.lalim(ig).and.l.le.lmax(ig) & … … 189 221 endif 190 222 enddo 191 enddo 192 193 if (lev_out.ge.10) & 194 & call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, & 195 & ptimestep,masse,entr,detr,fm,'4 ') 223 ! enddo 224 225 if (lev_out.ge.10) & 226 & write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & 227 & entr(igout,l),detr(igout,l),fm(igout,l+1) 228 else 229 print*,'Test sur les fractions croissantes inhibe dans thermcell_flux2' 230 endif 196 231 197 232 … … 200 235 !------------------------------------------------------------------------- 201 236 202 237 ! do l=1,klev 203 238 do ig=1,ngrid 204 239 if ((fm(ig,l+1).gt.fm(ig,l)).and.(l.gt.lalim(ig))) then … … 209 244 endif 210 245 enddo 211 212 213 if (lev_out.ge.10) & 214 & call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &215 & ptimestep,masse,entr,detr,fm,'5 ')246 ! enddo 247 248 if (lev_out.ge.10) & 249 & write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & 250 & entr(igout,l),detr(igout,l),fm(igout,l+1) 216 251 217 252 !------------------------------------------------------------------------- … … 221 256 if(1.eq.1) then 222 257 223 258 ! do l=1,klev 224 259 do ig=1,ngrid 225 260 if (entr(ig,l)<0.) then … … 256 291 endif 257 292 enddo 258 259 endif 260 261 262 if (lev_out.ge.10) & 263 & call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &264 & ptimestep,masse,entr,detr,fm,'6 ')293 ! enddo 294 endif 295 296 297 if (lev_out.ge.10) & 298 & write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & 299 & entr(igout,l),detr(igout,l),fm(igout,l+1) 265 300 266 301 !------------------------------------------------------------------------- … … 268 303 !------------------------------------------------------------------------- 269 304 270 305 ! do l=1,klev 271 306 do ig=1,ngrid 272 307 if (fm(ig,l+1).lt.0.) then … … 283 318 endif 284 319 enddo 285 286 287 if (lev_out.ge.10) & 288 & call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &289 & ptimestep,masse,entr,detr,fm,'7 ')320 ! enddo 321 322 if (lev_out.ge.10) & 323 & write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & 324 & entr(igout,l),detr(igout,l),fm(igout,l+1) 290 325 291 326 !----------------------------------------------------------------------- … … 308 343 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 309 344 310 if(1.eq.0) then 311 312 do l=1,klev 345 ! do l=1,klev 313 346 do ig=1,ngrid 314 347 if (zw2(ig,l+1).gt.1.e-10) then … … 327 360 endif 328 361 enddo 329 362 ! enddo 330 363 ! 364 365 366 if (lev_out.ge.10) & 367 & write(lunout,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & 368 & entr(igout,l),detr(igout,l),fm(igout,l+1) 369 370 ! Fin de la grande boucle sur les niveaux verticaux 371 enddo 372 331 373 if (lev_out.ge.10) & 332 374 & call printflux(ngrid,klev,lunout,igout,f,lmax,lalim, & 333 375 & ptimestep,masse,entr,detr,fm,'8 ') 334 376 335 endif336 377 337 378 !----------------------------------------------------------------------- … … 418 459 return 419 460 end 420 421 subroutine printflux(ngrid,klev,lunout,igout,f,lmax,lalim, &422 & ptimestep,masse,entr,detr,fm,descr)423 424 implicit none425 426 integer ngrid,klev,lunout,igout,l,lm427 428 integer lmax(klev),lalim(klev)429 real ptimestep,masse(ngrid,klev),entr(ngrid,klev),detr(ngrid,klev)430 real fm(ngrid,klev+1),f(ngrid)431 432 character*3 descr433 434 lm=lmax(igout)+5435 if(lm.gt.klev) lm=klev436 437 print*,'Impression jusque lm=',lm438 439 write(lunout,*) 'Dans thermcell_flux '//descr440 write(lunout,*) 'flux base ',f(igout)441 write(lunout,*) 'lmax ',lmax(igout)442 write(lunout,*) 'lalim ',lalim(igout)443 write(lunout,*) 'ig= ',igout444 write(lunout,'(a3,4a14)') 'l','M','E','D','F'445 write(lunout,'(i4,4e14.4)') (l,masse(igout,l)/ptimestep, &446 & entr(igout,l),detr(igout,l) &447 & ,fm(igout,l+1),l=1,lm)448 449 450 do l=lmax(igout)+1,klev451 if (abs(entr(igout,l))+abs(detr(igout,l))+abs(fm(igout,l)).gt.0.) then452 print*,'cas 1 : igout,l,lmax(igout)',igout,l,lmax(igout)453 print*,'entr(igout,l)',entr(igout,l)454 print*,'detr(igout,l)',detr(igout,l)455 print*,'fm(igout,l)',fm(igout,l)456 stop457 endif458 enddo459 460 return461 end462 -
LMDZ4/trunk/libf/phytherm/thermcell_main.F90
r852 r855 385 385 !------------------------------------------------------------------------------- 386 386 387 CALL thermcell_flux 2(ngrid,nlay,ptimestep,masse, &387 CALL thermcell_flux(ngrid,nlay,ptimestep,masse, & 388 388 & lalim,lmax,alim_star, & 389 389 & entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr, &
Note: See TracChangeset
for help on using the changeset viewer.