| 1 | ! |
|---|
| 2 | ! $Id: calltherm.F90 1428 2010-09-13 08:43:37Z fairhead $ |
|---|
| 3 | ! |
|---|
| 4 | subroutine calltherm_mars(dtime,zzlev,zzlay & |
|---|
| 5 | & ,pplay,paprs,pphi & |
|---|
| 6 | & ,u_seri,v_seri,t_seri,pq_therm,q2_therm & |
|---|
| 7 | & ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs,dq2_therm & |
|---|
| 8 | & ,fm_therm,entr_therm,detr_therm,lmax,zmaxth,& |
|---|
| 9 | & zw2,fraca,zpopsk,ztla,heatFlux,heatFlux_down,& |
|---|
| 10 | & buoyancyOut,buoyancyEst,hfmax,wmax) |
|---|
| 11 | |
|---|
| 12 | USE ioipsl_getincom |
|---|
| 13 | implicit none |
|---|
| 14 | |
|---|
| 15 | #include "dimensions.h" |
|---|
| 16 | #include "dimphys.h" |
|---|
| 17 | |
|---|
| 18 | REAL dtime |
|---|
| 19 | LOGICAL logexpr0, logexpr2(ngridmx,nlayermx), logexpr1(ngridmx) |
|---|
| 20 | REAL fact |
|---|
| 21 | INTEGER nbptspb |
|---|
| 22 | |
|---|
| 23 | REAL, INTENT(IN) :: zzlay(ngridmx,nlayermx) |
|---|
| 24 | REAL, INTENT(IN) :: zzlev(ngridmx,nlayermx+1) |
|---|
| 25 | |
|---|
| 26 | REAL u_seri(ngridmx,nlayermx),v_seri(ngridmx,nlayermx) |
|---|
| 27 | REAL t_seri(ngridmx,nlayermx),pq_therm(ngridmx,nlayermx,nqmx) |
|---|
| 28 | REAL q2_therm(ngridmx,nlayermx) |
|---|
| 29 | REAL paprs(ngridmx,nlayermx+1) |
|---|
| 30 | REAL pplay(ngridmx,nlayermx) |
|---|
| 31 | REAL pphi(ngridmx,nlayermx) |
|---|
| 32 | real zlev(ngridmx,nlayermx+1) |
|---|
| 33 | !test: on sort lentr et a* pour alimenter KE |
|---|
| 34 | REAL zw2(ngridmx,nlayermx+1),fraca(ngridmx,nlayermx+1) |
|---|
| 35 | REAL zzw2(ngridmx,nlayermx+1) |
|---|
| 36 | |
|---|
| 37 | !FH Update Thermiques |
|---|
| 38 | REAL d_t_ajs(ngridmx,nlayermx), d_q_ajs(ngridmx,nlayermx,nqmx) |
|---|
| 39 | REAL d_u_ajs(ngridmx,nlayermx),d_v_ajs(ngridmx,nlayermx) |
|---|
| 40 | REAL dq2_therm(ngridmx,nlayermx), dq2_the(ngridmx,nlayermx) |
|---|
| 41 | real fm_therm(ngridmx,nlayermx+1) |
|---|
| 42 | real entr_therm(ngridmx,nlayermx),detr_therm(ngridmx,nlayermx) |
|---|
| 43 | |
|---|
| 44 | !******************************************************** |
|---|
| 45 | ! declarations |
|---|
| 46 | real zpopsk(ngridmx,nlayermx) |
|---|
| 47 | real ztla(ngridmx,nlayermx) |
|---|
| 48 | real wmax(ngridmx) |
|---|
| 49 | real hfmax(ngridmx) |
|---|
| 50 | integer lmax(ngridmx) |
|---|
| 51 | real lmax_real(ngridmx) |
|---|
| 52 | real zmax(ngridmx),zmaxth(ngridmx) |
|---|
| 53 | |
|---|
| 54 | !nouvelles variables pour la convection |
|---|
| 55 | !RC |
|---|
| 56 | !on garde le zmax du pas de temps precedent |
|---|
| 57 | !******************************************************** |
|---|
| 58 | |
|---|
| 59 | |
|---|
| 60 | ! variables locales |
|---|
| 61 | REAL d_t_the(ngridmx,nlayermx), d_q_the(ngridmx,nlayermx,nqmx) |
|---|
| 62 | REAL d_u_the(ngridmx,nlayermx),d_v_the(ngridmx,nlayermx) |
|---|
| 63 | ! |
|---|
| 64 | integer isplit,nsplit_thermals |
|---|
| 65 | real r_aspect_thermals |
|---|
| 66 | |
|---|
| 67 | real zfm_therm(ngridmx,nlayermx+1),zdt |
|---|
| 68 | real zentr_therm(ngridmx,nlayermx),zdetr_therm(ngridmx,nlayermx) |
|---|
| 69 | real heatFlux(ngridmx,nlayermx) |
|---|
| 70 | real heatFlux_down(ngridmx,nlayermx) |
|---|
| 71 | real buoyancyOut(ngridmx,nlayermx) |
|---|
| 72 | real buoyancyEst(ngridmx,nlayermx) |
|---|
| 73 | real zheatFlux(ngridmx,nlayermx) |
|---|
| 74 | real zheatFlux_down(ngridmx,nlayermx) |
|---|
| 75 | real zbuoyancyOut(ngridmx,nlayermx) |
|---|
| 76 | real zbuoyancyEst(ngridmx,nlayermx) |
|---|
| 77 | |
|---|
| 78 | character (len=20) :: modname='calltherm' |
|---|
| 79 | character (len=80) :: abort_message |
|---|
| 80 | |
|---|
| 81 | integer i,k |
|---|
| 82 | logical, save :: first=.true. |
|---|
| 83 | |
|---|
| 84 | REAL tstart,tstop |
|---|
| 85 | |
|---|
| 86 | |
|---|
| 87 | ! Modele du thermique |
|---|
| 88 | ! =================== |
|---|
| 89 | |
|---|
| 90 | ! r_aspect_thermals ! ultimately conrols the amount of mass going through the thermals |
|---|
| 91 | ! decreasing it increases the thermals effect. Tests at gcm resolution |
|---|
| 92 | ! shows that too low values destabilize the model |
|---|
| 93 | ! when changing this value, one should check that the surface layer model |
|---|
| 94 | ! outputs the correct Cd*u and Ch*u through changing the gustiness coefficient beta |
|---|
| 95 | |
|---|
| 96 | |
|---|
| 97 | #ifdef MESOSCALE |
|---|
| 98 | !! valid for timesteps < 200s |
|---|
| 99 | nsplit_thermals=2 |
|---|
| 100 | r_aspect_thermals=0.7 |
|---|
| 101 | #else |
|---|
| 102 | nsplit_thermals=25 |
|---|
| 103 | r_aspect_thermals=1.8 |
|---|
| 104 | #endif |
|---|
| 105 | |
|---|
| 106 | call getin("nsplit_thermals",nsplit_thermals) |
|---|
| 107 | call getin("r_aspect_thermals",r_aspect_thermals) |
|---|
| 108 | |
|---|
| 109 | ! fm_therm(:,:)=0. |
|---|
| 110 | ! detr_therm(:,:)=0. |
|---|
| 111 | ! entr_therm(:,:)=0. |
|---|
| 112 | |
|---|
| 113 | heatFlux(:,:)=0. |
|---|
| 114 | heatFlux_down(:,:)=0. |
|---|
| 115 | ! buoyancyOut(:,:)=0. |
|---|
| 116 | ! buoyancyEst(:,:)=0. |
|---|
| 117 | |
|---|
| 118 | zw2(:,:)=0. |
|---|
| 119 | zmaxth(:)=0. |
|---|
| 120 | lmax_real(:)=0. |
|---|
| 121 | |
|---|
| 122 | zdt=dtime/REAL(nsplit_thermals) |
|---|
| 123 | |
|---|
| 124 | do isplit=1,nsplit_thermals |
|---|
| 125 | |
|---|
| 126 | ! call cpu_time(tstart) |
|---|
| 127 | |
|---|
| 128 | |
|---|
| 129 | ! On reinitialise les flux de masse a zero pour le cumul en |
|---|
| 130 | ! cas de splitting |
|---|
| 131 | |
|---|
| 132 | ! zfm_therm(:,:)=0. |
|---|
| 133 | ! zentr_therm(:,:)=0. |
|---|
| 134 | ! zdetr_therm(:,:)=0. |
|---|
| 135 | ! |
|---|
| 136 | zheatFlux(:,:)=0. |
|---|
| 137 | zheatFlux_down(:,:)=0. |
|---|
| 138 | ! zbuoyancyOut(:,:)=0. |
|---|
| 139 | ! zbuoyancyEst(:,:)=0. |
|---|
| 140 | |
|---|
| 141 | zzw2(:,:)=0. |
|---|
| 142 | zmax(:)=0. |
|---|
| 143 | lmax(:)=0. |
|---|
| 144 | |
|---|
| 145 | d_t_the(:,:)=0. |
|---|
| 146 | d_u_the(:,:)=0. |
|---|
| 147 | d_v_the(:,:)=0. |
|---|
| 148 | ! dq2_the(:,:)=0. |
|---|
| 149 | if (nqmx .ne. 0) then |
|---|
| 150 | d_q_the(:,:,:)=0. |
|---|
| 151 | endif |
|---|
| 152 | |
|---|
| 153 | CALL thermcell_main_mars(zdt & |
|---|
| 154 | ! CALL thermcell_main_mars_coupled_v2(zdt & |
|---|
| 155 | & ,pplay,paprs,pphi,zzlev,zzlay & |
|---|
| 156 | & ,u_seri,v_seri,t_seri,pq_therm,q2_therm & |
|---|
| 157 | & ,d_u_the,d_v_the,d_t_the,d_q_the,dq2_the & |
|---|
| 158 | & ,zfm_therm,zentr_therm,zdetr_therm,lmax,zmax & |
|---|
| 159 | & ,r_aspect_thermals & |
|---|
| 160 | & ,zzw2,fraca,zpopsk & |
|---|
| 161 | & ,ztla,zheatFlux,zheatFlux_down & |
|---|
| 162 | & ,zbuoyancyOut,zbuoyancyEst) |
|---|
| 163 | |
|---|
| 164 | fact=1./REAL(nsplit_thermals) |
|---|
| 165 | ! transformation de la derivee en tendance |
|---|
| 166 | |
|---|
| 167 | d_t_the(:,:)=d_t_the(:,:)*dtime*fact |
|---|
| 168 | d_u_the(:,:)=d_u_the(:,:)*fact |
|---|
| 169 | d_v_the(:,:)=d_v_the(:,:)*fact |
|---|
| 170 | ! dq2_the(:,:)=dq2_the(:,:)*fact |
|---|
| 171 | |
|---|
| 172 | if (nqmx .ne. 0) then |
|---|
| 173 | d_q_the(:,:,:)=d_q_the(:,:,:)*fact |
|---|
| 174 | endif |
|---|
| 175 | |
|---|
| 176 | zmaxth(:)=zmaxth(:)+zmax(:)*fact |
|---|
| 177 | lmax_real(:)=lmax_real(:)+float(lmax(:))*fact |
|---|
| 178 | ! fm_therm(:,:)=fm_therm(:,:) & |
|---|
| 179 | ! & +zfm_therm(:,:)*fact |
|---|
| 180 | ! entr_therm(:,:)=entr_therm(:,:) & |
|---|
| 181 | ! & +zentr_therm(:,:)*fact |
|---|
| 182 | ! detr_therm(:,:)=detr_therm(:,:) & |
|---|
| 183 | ! & +zdetr_therm(:,:)*fact |
|---|
| 184 | |
|---|
| 185 | heatFlux(:,:)=heatFlux(:,:) & |
|---|
| 186 | & +zheatFlux(:,:)*fact |
|---|
| 187 | heatFlux_down(:,:)=heatFlux_down(:,:) & |
|---|
| 188 | & +zheatFlux_down(:,:)*fact |
|---|
| 189 | ! buoyancyOut(:,:)=buoyancyOut(:,:) & |
|---|
| 190 | ! & +zbuoyancyOut(:,:)*fact |
|---|
| 191 | ! buoyancyEst(:,:)=buoyancyEst(:,:) & |
|---|
| 192 | ! & +zbuoyancyEst(:,:)*fact |
|---|
| 193 | |
|---|
| 194 | zw2(:,:)=zw2(:,:) + zzw2(:,:)*fact |
|---|
| 195 | |
|---|
| 196 | ! accumulation de la tendance |
|---|
| 197 | |
|---|
| 198 | d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:) |
|---|
| 199 | d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:) |
|---|
| 200 | d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:) |
|---|
| 201 | d_q_ajs(:,:,:)=d_q_ajs(:,:,:)+d_q_the(:,:,:) |
|---|
| 202 | ! dq2_therm(:,:)=dq2_therm(:,:)+dq2_the(:,:) |
|---|
| 203 | ! incrementation des variables meteo |
|---|
| 204 | |
|---|
| 205 | t_seri(:,:) = t_seri(:,:) + d_t_the(:,:) |
|---|
| 206 | u_seri(:,:) = u_seri(:,:) + d_u_the(:,:) |
|---|
| 207 | v_seri(:,:) = v_seri(:,:) + d_v_the(:,:) |
|---|
| 208 | pq_therm(:,:,:) = pq_therm(:,:,:) + d_q_the(:,:,:) |
|---|
| 209 | ! q2_therm(:,:) = q2_therm(:,:) + dq2_therm(:,:) |
|---|
| 210 | |
|---|
| 211 | |
|---|
| 212 | ! call cpu_time(tstop) |
|---|
| 213 | ! print*,'elapsed time in thermals : ',tstop-tstart |
|---|
| 214 | |
|---|
| 215 | enddo ! isplit |
|---|
| 216 | |
|---|
| 217 | |
|---|
| 218 | !**************************************************************** |
|---|
| 219 | |
|---|
| 220 | ! do i=1,ngridmx |
|---|
| 221 | ! do k=1,nlayermx |
|---|
| 222 | ! if (ztla(i,k) .lt. 1.e-10) fraca(i,k) =0. |
|---|
| 223 | ! print*,'youpi je sers a quelque chose !' |
|---|
| 224 | ! enddo |
|---|
| 225 | ! enddo |
|---|
| 226 | |
|---|
| 227 | DO i=1,ngridmx |
|---|
| 228 | hfmax(i)=MAXVAL(heatFlux(i,:)+heatFlux_down(i,:)) |
|---|
| 229 | wmax(i)=MAXVAL(zw2(i,:)) |
|---|
| 230 | ENDDO |
|---|
| 231 | |
|---|
| 232 | lmax(:)=nint(lmax_real(:)) |
|---|
| 233 | |
|---|
| 234 | return |
|---|
| 235 | |
|---|
| 236 | end |
|---|
