| 1 | ! |
|---|
| 2 | ! AC 2011-01-05 |
|---|
| 3 | ! |
|---|
| 4 | SUBROUTINE calltherm_interface (ngrid,nlayer,firstcall, & |
|---|
| 5 | & long,lati,zzlev,zzlay, & |
|---|
| 6 | & ptimestep,pu,pv,pt,pq,pdu,pdv,pdt,pdq,q2, & |
|---|
| 7 | & pplay,pplev,pphi,nq,zpopsk, & |
|---|
| 8 | & pdu_th,pdv_th,pdt_th,pdq_th,lmax_th,pbl_dtke,hfmax,wmax) |
|---|
| 9 | |
|---|
| 10 | USE ioipsl_getincom |
|---|
| 11 | |
|---|
| 12 | implicit none |
|---|
| 13 | #include "callkeys.h" |
|---|
| 14 | !-------------------------------------------------------- |
|---|
| 15 | ! Variables d'entree |
|---|
| 16 | !-------------------------------------------------------- |
|---|
| 17 | |
|---|
| 18 | INTEGER, INTENT(IN) :: ngrid,nlayer,nq |
|---|
| 19 | REAL, INTENT(IN) :: ptimestep |
|---|
| 20 | REAL, INTENT(IN) :: pplev(ngrid,nlayer+1),pplay(ngrid,nlayer) |
|---|
| 21 | REAL, INTENT(IN) :: pphi(ngrid,nlayer) |
|---|
| 22 | REAL, INTENT(IN) :: pu(ngrid,nlayer),pv(ngrid,nlayer) |
|---|
| 23 | REAL, INTENT(IN) :: pt(ngrid,nlayer),pq(ngrid,nlayer,nq) |
|---|
| 24 | REAL, INTENT(IN) :: zzlay(ngrid,nlayer) |
|---|
| 25 | REAL, INTENT(IN) :: zzlev(ngrid,nlayer+1) |
|---|
| 26 | LOGICAL, INTENT(IN) :: firstcall |
|---|
| 27 | REAL, INTENT(IN) :: pdu(ngrid,nlayer),pdv(ngrid,nlayer) |
|---|
| 28 | REAL, INTENT(IN) :: pdq(ngrid,nlayer,nq),pdt(ngrid,nlayer) |
|---|
| 29 | REAL, INTENT(IN) :: q2(ngrid,nlayer+1) |
|---|
| 30 | REAL, INTENT(IN) :: long(ngrid),lati(ngrid) |
|---|
| 31 | REAL, INTENT(IN) :: zpopsk(ngrid,nlayer) |
|---|
| 32 | |
|---|
| 33 | !-------------------------------------------------------- |
|---|
| 34 | ! Variables de sortie (ou entree/sortie) |
|---|
| 35 | !-------------------------------------------------------- |
|---|
| 36 | |
|---|
| 37 | REAL pdu_th(ngrid,nlayer),pdv_th(ngrid,nlayer) |
|---|
| 38 | REAL pdt_th(ngrid,nlayer),pdq_th(ngrid,nlayer,nq) |
|---|
| 39 | INTEGER lmax_th(ngrid) |
|---|
| 40 | REAL pbl_dtke(ngrid,nlayer+1) |
|---|
| 41 | |
|---|
| 42 | !-------------------------------------------------------- |
|---|
| 43 | ! Variables du thermique |
|---|
| 44 | !-------------------------------------------------------- |
|---|
| 45 | REAL u_seri(ngrid,nlayer), v_seri(ngrid,nlayer) |
|---|
| 46 | REAL t_seri(ngrid,nlayer) |
|---|
| 47 | REAL d_t_ajs(ngrid,nlayer) |
|---|
| 48 | REAL d_u_ajs(ngrid,nlayer), d_q_ajs(ngrid,nlayer,nq) |
|---|
| 49 | REAL d_v_ajs(ngrid,nlayer) |
|---|
| 50 | REAL fm_therm(ngrid,nlayer+1), entr_therm(ngrid,nlayer) |
|---|
| 51 | REAL detr_therm(ngrid,nlayer) |
|---|
| 52 | REAL zw2(ngrid,nlayer+1) |
|---|
| 53 | REAL fraca(ngrid,nlayer+1) |
|---|
| 54 | REAL ztla(ngrid,nlayer) |
|---|
| 55 | REAL q_therm(ngrid,nlayer), pq_therm(ngrid,nlayer,nq) |
|---|
| 56 | REAL dq_therm(ngrid,nlayer), dq_thermdown(ngrid,nlayer) |
|---|
| 57 | REAL q2_therm(ngrid,nlayer), dq2_therm(ngrid,nlayer) |
|---|
| 58 | |
|---|
| 59 | LOGICAL qtransport_thermals,dtke_thermals |
|---|
| 60 | |
|---|
| 61 | INTEGER l,ig,iq |
|---|
| 62 | |
|---|
| 63 | ! Variable de diagnostique : flux de chaleur vertical |
|---|
| 64 | |
|---|
| 65 | REAL heatFlux(ngrid,nlayer) |
|---|
| 66 | REAL heatFlux_down(ngrid,nlayer) |
|---|
| 67 | REAL buoyancyOut(ngrid,nlayer) |
|---|
| 68 | REAL buoyancyEst(ngrid,nlayer) |
|---|
| 69 | REAL hfmax(ngrid),wmax(ngrid) |
|---|
| 70 | |
|---|
| 71 | !--------------------------------------------------------- |
|---|
| 72 | !--------------------------------------------------------- |
|---|
| 73 | ! ********************************************************************** |
|---|
| 74 | ! Thermique |
|---|
| 75 | ! ********************************************************************** |
|---|
| 76 | |
|---|
| 77 | ! Initialisation des sorties |
|---|
| 78 | |
|---|
| 79 | lmax_th(:)=1 |
|---|
| 80 | pdu_th(:,:)=0. |
|---|
| 81 | pdv_th(:,:)=0. |
|---|
| 82 | pdt_th(:,:)=0. |
|---|
| 83 | entr_therm(:,:)=0. |
|---|
| 84 | detr_therm(:,:)=0. |
|---|
| 85 | q2_therm(:,:)=0. |
|---|
| 86 | dq2_therm(:,:)=0. |
|---|
| 87 | dq_therm(:,:)=0. |
|---|
| 88 | dq_thermdown(:,:)=0. |
|---|
| 89 | ztla(:,:)=0. |
|---|
| 90 | pbl_dtke(:,:)=0. |
|---|
| 91 | fm_therm(:,:)=0. |
|---|
| 92 | zw2(:,:)=0. |
|---|
| 93 | fraca(:,:)=0. |
|---|
| 94 | if (tracer) then |
|---|
| 95 | pdq_th(:,:,:)=0. |
|---|
| 96 | end if |
|---|
| 97 | |
|---|
| 98 | ! Dans le model terrestres, les seri sont des q+dq tendances déja cumulées. Il n'y a donc pas de |
|---|
| 99 | ! cumulage à l'intérieur de la routine comme dans le model martien. On le fait ici : |
|---|
| 100 | |
|---|
| 101 | u_seri(:,:)=pu(:,:)+pdu(:,:)*ptimestep |
|---|
| 102 | v_seri(:,:)=pv(:,:)+pdv(:,:)*ptimestep |
|---|
| 103 | t_seri(:,:)=pt(:,:)+pdt(:,:)*ptimestep |
|---|
| 104 | |
|---|
| 105 | pq_therm(:,:,:)=0. |
|---|
| 106 | qtransport_thermals=.true. |
|---|
| 107 | call getin("qtransport_thermals",qtransport_thermals) |
|---|
| 108 | if(qtransport_thermals) then |
|---|
| 109 | if(tracer) then |
|---|
| 110 | pq_therm(:,:,:)=pq(:,:,:)+pdq(:,:,:)*ptimestep |
|---|
| 111 | endif |
|---|
| 112 | endif |
|---|
| 113 | |
|---|
| 114 | d_t_ajs(:,:)=0. |
|---|
| 115 | d_u_ajs(:,:)=0. |
|---|
| 116 | d_v_ajs(:,:)=0. |
|---|
| 117 | d_q_ajs(:,:,:)=0. |
|---|
| 118 | heatFlux(:,:)=0. |
|---|
| 119 | heatFlux_down(:,:)=0. |
|---|
| 120 | buoyancyOut(:,:)=0. |
|---|
| 121 | buoyancyEst(:,:)=0. |
|---|
| 122 | |
|---|
| 123 | dtke_thermals=.false. |
|---|
| 124 | call getin("dtke_thermals",dtke_thermals) |
|---|
| 125 | if(dtke_thermals) then |
|---|
| 126 | |
|---|
| 127 | DO l=1,nlayer |
|---|
| 128 | q2_therm(:,l)=0.5*(q2(:,l)+q2(:,l+1)) |
|---|
| 129 | ENDDO |
|---|
| 130 | endif |
|---|
| 131 | |
|---|
| 132 | CALL calltherm_mars(ngrid,nlayer,ptimestep,nq,zzlev,zzlay & |
|---|
| 133 | & ,pplay,pplev,pphi & |
|---|
| 134 | & ,u_seri,v_seri,t_seri,pq_therm, q2_therm & |
|---|
| 135 | & ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, dq2_therm & |
|---|
| 136 | & ,fm_therm,entr_therm,detr_therm & |
|---|
| 137 | & ,lmax_th & |
|---|
| 138 | & ,zw2,fraca & |
|---|
| 139 | & ,zpopsk,ztla,heatFlux,heatFlux_down & |
|---|
| 140 | & ,buoyancyOut,buoyancyEst,hfmax,wmax) |
|---|
| 141 | |
|---|
| 142 | |
|---|
| 143 | ! Accumulation des tendances. On n'accumule pas les quantités de traceurs car celle ci n'a pas du changer |
|---|
| 144 | ! étant donné qu'on ne prends en compte que q_seri de la vap d'eau = 0 |
|---|
| 145 | |
|---|
| 146 | ! INCREMENTATION : les d_u_ sont des tendances alors que les pdu sont des dérivees, attention ! |
|---|
| 147 | |
|---|
| 148 | pdu_th(:,:)=d_u_ajs(:,:)/ptimestep |
|---|
| 149 | pdv_th(:,:)=d_v_ajs(:,:)/ptimestep |
|---|
| 150 | pdt_th(:,:)=d_t_ajs(:,:)/ptimestep |
|---|
| 151 | if(qtransport_thermals) then |
|---|
| 152 | if(tracer) then |
|---|
| 153 | pdq_th(:,:,:)=d_q_ajs(:,:,:)/ptimestep |
|---|
| 154 | endif |
|---|
| 155 | endif |
|---|
| 156 | |
|---|
| 157 | |
|---|
| 158 | DO l=2,nlayer |
|---|
| 159 | pbl_dtke(:,l)=0.5*(dq2_therm(:,l-1)+dq2_therm(:,l))/ptimestep |
|---|
| 160 | ENDDO |
|---|
| 161 | |
|---|
| 162 | pbl_dtke(:,1)=0.5*dq2_therm(:,1)/ptimestep |
|---|
| 163 | pbl_dtke(:,nlayer+1)=0. |
|---|
| 164 | !! DIAGNOSTICS |
|---|
| 165 | |
|---|
| 166 | if(outptherm) then |
|---|
| 167 | if (ngrid .eq. 1) then |
|---|
| 168 | call WRITEDIAGFI(ngrid,'entr_therm','entrainement thermique',& |
|---|
| 169 | & 'kg/m-2',1,entr_therm) |
|---|
| 170 | call WRITEDIAGFI(ngrid,'detr_therm','detrainement thermique',& |
|---|
| 171 | & 'kg/m-2',1,detr_therm) |
|---|
| 172 | call WRITEDIAGFI(ngrid,'fm_therm','flux masse thermique',& |
|---|
| 173 | & 'kg/m-2',1,fm_therm) |
|---|
| 174 | call WRITEDIAGFI(ngrid,'zw2','vitesse verticale thermique',& |
|---|
| 175 | & 'm/s',1,zw2) |
|---|
| 176 | call WRITEDIAGFI(ngrid,'heatFlux_up','heatFlux_updraft',& |
|---|
| 177 | & 'SI',1,heatFlux) |
|---|
| 178 | call WRITEDIAGFI(ngrid,'heatFlux_down','heatFlux_downdraft',& |
|---|
| 179 | & 'SI',1,heatFlux_down) |
|---|
| 180 | call WRITEDIAGFI(ngrid,'fraca','fraction coverage',& |
|---|
| 181 | & 'percent',1,fraca) |
|---|
| 182 | call WRITEDIAGFI(ngrid,'buoyancyOut','buoyancyOut',& |
|---|
| 183 | & 'm.s-2',1,buoyancyOut) |
|---|
| 184 | call WRITEDIAGFI(ngrid,'buoyancyEst','buoyancyEst',& |
|---|
| 185 | & 'm.s-2',1,buoyancyEst) |
|---|
| 186 | call WRITEDIAGFI(ngrid,'d_t_th', & |
|---|
| 187 | & 'tendance temp TH','K',1,d_t_ajs) |
|---|
| 188 | else |
|---|
| 189 | |
|---|
| 190 | call WRITEDIAGFI(ngrid,'entr_therm','entrainement thermique',& |
|---|
| 191 | & 'kg/m-2',3,entr_therm) |
|---|
| 192 | call WRITEDIAGFI(ngrid,'detr_therm','detrainement thermique',& |
|---|
| 193 | & 'kg/m-2',3,detr_therm) |
|---|
| 194 | call WRITEDIAGFI(ngrid,'fm_therm','flux masse thermique',& |
|---|
| 195 | & 'kg/m-2',3,fm_therm) |
|---|
| 196 | call WRITEDIAGFI(ngrid,'zw2','vitesse verticale thermique',& |
|---|
| 197 | & 'm/s',3,zw2) |
|---|
| 198 | call WRITEDIAGFI(ngrid,'heatFlux','heatFlux',& |
|---|
| 199 | & 'SI',3,heatFlux) |
|---|
| 200 | call WRITEDIAGFI(ngrid,'buoyancyOut','buoyancyOut',& |
|---|
| 201 | & 'SI',3,buoyancyOut) |
|---|
| 202 | call WRITEDIAGFI(ngrid,'d_t_th', & |
|---|
| 203 | & 'tendance temp TH','K',3,d_t_ajs) |
|---|
| 204 | |
|---|
| 205 | endif |
|---|
| 206 | endif |
|---|
| 207 | |
|---|
| 208 | END |
|---|
