| 1 | subroutine thermcell_dqup(ngrid,nlayer,ptimestep,fm,entr,detr, & |
|---|
| 2 | & masse0,q_therm,dq_therm,ndt,zlmax) |
|---|
| 3 | implicit none |
|---|
| 4 | |
|---|
| 5 | !======================================================================= |
|---|
| 6 | ! |
|---|
| 7 | ! Calcul du transport verticale dans la couche limite en presence |
|---|
| 8 | ! de "thermiques" explicitement representes |
|---|
| 9 | ! calcul du dq/dt une fois qu'on connait les ascendances |
|---|
| 10 | ! Version modifiee pour prendre les downdrafts a la place de la |
|---|
| 11 | ! subsidence compensatoire |
|---|
| 12 | ! |
|---|
| 13 | ! Version with sub-timestep for Martian thin layers |
|---|
| 14 | ! |
|---|
| 15 | !======================================================================= |
|---|
| 16 | |
|---|
| 17 | #include "dimensions.h" |
|---|
| 18 | #include "dimphys.h" |
|---|
| 19 | |
|---|
| 20 | ! ============================ INPUTS ============================ |
|---|
| 21 | |
|---|
| 22 | INTEGER, INTENT(IN) :: ngrid,nlayer |
|---|
| 23 | REAL, INTENT(IN) :: ptimestep |
|---|
| 24 | REAL, INTENT(IN) :: fm(ngridmx,nlayermx+1) |
|---|
| 25 | REAL, INTENT(IN) :: entr(ngridmx,nlayermx) |
|---|
| 26 | REAL, INTENT(IN) :: detr(ngridmx,nlayermx) |
|---|
| 27 | REAL, INTENT(IN) :: q_therm(ngridmx,nlayermx) |
|---|
| 28 | REAL, INTENT(IN) :: masse0(ngridmx,nlayermx) |
|---|
| 29 | INTEGER, INTENT(IN) :: ndt |
|---|
| 30 | INTEGER, INTENT(IN) :: zlmax |
|---|
| 31 | |
|---|
| 32 | ! ============================ OUTPUTS =========================== |
|---|
| 33 | |
|---|
| 34 | REAL, INTENT(OUT) :: dq_therm(ngridmx,nlayermx) ! dq/dt -> derivative |
|---|
| 35 | |
|---|
| 36 | ! ============================ LOCAL ============================= |
|---|
| 37 | |
|---|
| 38 | REAL q(ngridmx,nlayermx) |
|---|
| 39 | REAL qa(ngridmx,nlayermx) |
|---|
| 40 | INTEGER ig,k,i |
|---|
| 41 | REAL invflux0(ngridmx,nlayermx) |
|---|
| 42 | REAL ztimestep |
|---|
| 43 | |
|---|
| 44 | ! =========== Init ============================================== |
|---|
| 45 | |
|---|
| 46 | qa(:,:)=q_therm(:,:) |
|---|
| 47 | q(:,:)=q_therm(:,:) |
|---|
| 48 | |
|---|
| 49 | ! ====== Computing q ============================================ |
|---|
| 50 | |
|---|
| 51 | dq_therm(:,:)=0. |
|---|
| 52 | ztimestep=ptimestep/real(ndt) |
|---|
| 53 | invflux0(:,:)=ztimestep/masse0(:,:) |
|---|
| 54 | |
|---|
| 55 | do i=1,ndt |
|---|
| 56 | |
|---|
| 57 | do ig=1,ngrid |
|---|
| 58 | qa(ig,1)=q(ig,1) |
|---|
| 59 | enddo |
|---|
| 60 | |
|---|
| 61 | do k=2,zlmax |
|---|
| 62 | do ig=1,ngridmx |
|---|
| 63 | if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. & |
|---|
| 64 | & 1.e-5*masse0(ig,k)) then |
|---|
| 65 | qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) & |
|---|
| 66 | & /(fm(ig,k+1)+detr(ig,k)) |
|---|
| 67 | else |
|---|
| 68 | qa(ig,k)=q(ig,k) |
|---|
| 69 | endif |
|---|
| 70 | enddo |
|---|
| 71 | enddo |
|---|
| 72 | |
|---|
| 73 | do k=1,zlmax |
|---|
| 74 | q(:,k)=q(:,k)+ & |
|---|
| 75 | & (detr(:,k)*qa(:,k)-entr(:,k)*q(:,k) & |
|---|
| 76 | & -fm(:,k)*q(:,k)+fm(:,k+1)*q(:,k+1)) & |
|---|
| 77 | & *invflux0(:,k) |
|---|
| 78 | enddo |
|---|
| 79 | |
|---|
| 80 | enddo !of do i=1,ndt |
|---|
| 81 | |
|---|
| 82 | ! ====== Derivative ============================================== |
|---|
| 83 | |
|---|
| 84 | |
|---|
| 85 | do k=1,zlmax |
|---|
| 86 | dq_therm(:,k)=(q(:,k)-q_therm(:,k))/ptimestep |
|---|
| 87 | enddo |
|---|
| 88 | |
|---|
| 89 | ! ============== |
|---|
| 90 | |
|---|
| 91 | return |
|---|
| 92 | end |
|---|
| 93 | |
|---|
