| 1 | Subroutine aeropacity(ngrid,nlayer,pplay,pplev,pt, & |
|---|
| 2 | aerosol,reffrad,nueffrad,QREFvis3d,tau_col) |
|---|
| 3 | |
|---|
| 4 | use radinc_h, only : naerkind |
|---|
| 5 | use aerosol_mod |
|---|
| 6 | use YOMCST_mod |
|---|
| 7 | |
|---|
| 8 | implicit none |
|---|
| 9 | !#include "YOMCST.h" |
|---|
| 10 | |
|---|
| 11 | !================================================================== |
|---|
| 12 | ! |
|---|
| 13 | ! Purpose |
|---|
| 14 | ! ------- |
|---|
| 15 | ! Compute aerosol optical depth in each gridbox. |
|---|
| 16 | ! |
|---|
| 17 | ! Authors |
|---|
| 18 | ! ------- |
|---|
| 19 | ! F. Forget |
|---|
| 20 | ! F. Montmessin (water ice scheme) |
|---|
| 21 | ! update J.-B. Madeleine (2008) |
|---|
| 22 | ! dust removal, simplification by Robin Wordsworth (2009) |
|---|
| 23 | ! Generic n-layer aerosol - J. Vatant d'Ollone (2020) |
|---|
| 24 | ! |
|---|
| 25 | ! Input |
|---|
| 26 | ! ----- |
|---|
| 27 | ! ngrid Number of horizontal gridpoints |
|---|
| 28 | ! nlayer Number of layers |
|---|
| 29 | ! pplev Pressure (Pa) at each layer boundary |
|---|
| 30 | ! reffrad(ngrid,nlayer,naerkind) Aerosol effective radius |
|---|
| 31 | ! QREFvis3d(ngrid,nlayer,naerkind) \ 3d extinction coefficients |
|---|
| 32 | ! QREFir3d(ngrid,nlayer,naerkind) / at reference wavelengths |
|---|
| 33 | ! |
|---|
| 34 | ! Output |
|---|
| 35 | ! ------ |
|---|
| 36 | ! aerosol Aerosol optical depth in layer l, grid point ig |
|---|
| 37 | ! tau_col Total column optical depth at grid point ig |
|---|
| 38 | ! |
|---|
| 39 | !======================================================================= |
|---|
| 40 | |
|---|
| 41 | INTEGER,INTENT(IN) :: ngrid ! number of atmospheric columns |
|---|
| 42 | INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers |
|---|
| 43 | REAL,INTENT(IN) :: pplay(ngrid,nlayer) ! mid-layer pressure (Pa) |
|---|
| 44 | REAL,INTENT(IN) :: pplev(ngrid,nlayer+1) ! inter-layer pressure (Pa) |
|---|
| 45 | REAL,INTENT(IN) :: pt(ngrid,nlayer) ! mid-layer temperatre (K) |
|---|
| 46 | REAL,INTENT(OUT) :: aerosol(ngrid,nlayer,naerkind) ! aerosol optical depth |
|---|
| 47 | REAL,INTENT(IN) :: reffrad(ngrid,nlayer,naerkind) ! aerosol effective radius |
|---|
| 48 | REAL,INTENT(IN) :: nueffrad(ngrid,nlayer,naerkind) ! aerosol effective variance |
|---|
| 49 | REAL,INTENT(IN) :: QREFvis3d(ngrid,nlayer,naerkind) ! extinction coefficient in the visible |
|---|
| 50 | REAL,INTENT(OUT):: tau_col(ngrid) !column integrated visible optical depth |
|---|
| 51 | |
|---|
| 52 | INTEGER l,ig,iaer,ll |
|---|
| 53 | |
|---|
| 54 | LOGICAL,SAVE :: firstcall=.true. |
|---|
| 55 | !$OMP THREADPRIVATE(firstcall) |
|---|
| 56 | character*80 abort_message |
|---|
| 57 | character*20 modname |
|---|
| 58 | |
|---|
| 59 | ! for venus clouds |
|---|
| 60 | real,ALLOCATABLE,SAVE :: pbot2(:,:),pbot(:,:),ptop(:,:),ptop2(:,:) |
|---|
| 61 | real,ALLOCATABLE,SAVE :: hbot2(:,:),hbot(:,:),htop(:,:),htop2(:,:) |
|---|
| 62 | real,ALLOCATABLE,SAVE :: nmode(:,:) |
|---|
| 63 | !$OMP THREADPRIVATE(pbot2,pbot,ptop,ptop2) |
|---|
| 64 | !$OMP THREADPRIVATE(hbot2,hbot,htop,htop2) |
|---|
| 65 | !$OMP THREADPRIVATE(nmode) |
|---|
| 66 | real :: mode_dens,hlay |
|---|
| 67 | |
|---|
| 68 | ! --------------------------------------------------------- |
|---|
| 69 | ! --------------------------------------------------------- |
|---|
| 70 | ! First call only |
|---|
| 71 | IF (firstcall) THEN |
|---|
| 72 | |
|---|
| 73 | modname = 'aeropacity' |
|---|
| 74 | |
|---|
| 75 | ! verify tracers |
|---|
| 76 | write(*,*) "Active aerosols found in aeropacity, designed for Venus" |
|---|
| 77 | |
|---|
| 78 | if (iaero_venus1.eq.1) then |
|---|
| 79 | print*,'iaero_venus1= ',iaero_venus1 |
|---|
| 80 | else |
|---|
| 81 | abort_message='iaero_venus1 is not 1...' |
|---|
| 82 | call abort_physic(modname,abort_message,1) |
|---|
| 83 | endif |
|---|
| 84 | if (iaero_venus2.eq.2) then |
|---|
| 85 | print*,'iaero_venus2= ',iaero_venus2 |
|---|
| 86 | else |
|---|
| 87 | abort_message='iaero_venus2 is not 2...' |
|---|
| 88 | call abort_physic(modname,abort_message,1) |
|---|
| 89 | endif |
|---|
| 90 | if (iaero_venus2p.eq.3) then |
|---|
| 91 | print*,'iaero_venus2p= ',iaero_venus2p |
|---|
| 92 | else |
|---|
| 93 | abort_message='iaero_venus2p is not 3...' |
|---|
| 94 | call abort_physic(modname,abort_message,1) |
|---|
| 95 | endif |
|---|
| 96 | if (iaero_venus3.eq.4) then |
|---|
| 97 | print*,'iaero_venus3= ',iaero_venus3 |
|---|
| 98 | else |
|---|
| 99 | abort_message='iaero_venus3 is not 4...' |
|---|
| 100 | call abort_physic(modname,abort_message,1) |
|---|
| 101 | endif |
|---|
| 102 | if (iaero_venusUV.eq.5) then |
|---|
| 103 | print*,'iaero_venusUV= ',iaero_venusUV |
|---|
| 104 | else |
|---|
| 105 | abort_message='iaero_venus1UV is not 5...' |
|---|
| 106 | call abort_physic(modname,abort_message,1) |
|---|
| 107 | endif |
|---|
| 108 | |
|---|
| 109 | ! cloud model |
|---|
| 110 | allocate(pbot2(ngrid,naerkind),pbot(ngrid,naerkind)) |
|---|
| 111 | allocate(ptop(ngrid,naerkind),ptop2(ngrid,naerkind)) |
|---|
| 112 | allocate(hbot2(ngrid,naerkind),hbot(ngrid,naerkind)) |
|---|
| 113 | allocate(htop(ngrid,naerkind),htop2(ngrid,naerkind)) |
|---|
| 114 | allocate(nmode(ngrid,naerkind)) |
|---|
| 115 | call cloud_haus16(ngrid,pbot2,pbot,hbot2,hbot,ptop,ptop2,htop,htop2,nmode) |
|---|
| 116 | |
|---|
| 117 | firstcall=.false. |
|---|
| 118 | ENDIF ! of IF (firstcall) |
|---|
| 119 | ! --------------------------------------------------------- |
|---|
| 120 | ! --------------------------------------------------------- |
|---|
| 121 | |
|---|
| 122 | aerosol(:,:,:) = 0. |
|---|
| 123 | tau_col(:) = 0. |
|---|
| 124 | |
|---|
| 125 | do ig=1,ngrid |
|---|
| 126 | do iaer=1,naerkind |
|---|
| 127 | |
|---|
| 128 | ! Opacity calculation |
|---|
| 129 | |
|---|
| 130 | ! determine the approximate middle of the mode layer |
|---|
| 131 | ll=1 |
|---|
| 132 | DO l=1,nlayer-1 ! high p to low p |
|---|
| 133 | IF (pplay(ig,l) .gt. (ptop(ig,iaer)+pbot(ig,iaer))/2) ll=l |
|---|
| 134 | ENDDO |
|---|
| 135 | ! from there go DOWN for profile N |
|---|
| 136 | mode_dens = nmode(ig,iaer) ! m-3 |
|---|
| 137 | DO l=ll,1,-1 |
|---|
| 138 | hlay=RD*(pt(ig,l+1)+pt(ig,l))/2./RG |
|---|
| 139 | IF (pplay(ig,l) .le. pbot(ig,iaer)) THEN |
|---|
| 140 | mode_dens = nmode(ig,iaer) ! m-3 |
|---|
| 141 | ELSEIF (pplay(ig,l) .gt. pbot(ig,iaer) .and. pplay(ig,l) .le. pbot2(ig,iaer)) THEN |
|---|
| 142 | mode_dens = mode_dens*(pplay(ig,l+1)/pplay(ig,l))**(hlay/hbot(ig,iaer)) |
|---|
| 143 | ELSEIF (pplay(ig,l) .gt. pbot2(ig,iaer)) THEN |
|---|
| 144 | mode_dens = mode_dens*(pplay(ig,l+1)/pplay(ig,l))**(hlay/hbot2(ig,iaer)) |
|---|
| 145 | ENDIF |
|---|
| 146 | mode_dens=max(1.e-30,mode_dens) |
|---|
| 147 | if (iaer.lt.5) then |
|---|
| 148 | aerosol(ig,l,iaer) = QREFvis3d(ig,l,iaer)* & |
|---|
| 149 | RPI*(reffrad(ig,l,iaer))**2*exp(-3.*log(1+nueffrad(ig,l,iaer)))* & |
|---|
| 150 | mode_dens*hlay*(pplev(ig,l)-pplev(ig,l+1))/pplay(ig,l) |
|---|
| 151 | else ! for UV absorber |
|---|
| 152 | ! normalized to 0.35 microns (peak of absorption) |
|---|
| 153 | aerosol(ig,l,iaer) = QREFvis3d(ig,l,iaer)*mode_dens |
|---|
| 154 | endif |
|---|
| 155 | ENDDO |
|---|
| 156 | ! ... then UP for profile N |
|---|
| 157 | mode_dens = nmode(ig,iaer) ! m-3 |
|---|
| 158 | DO l=ll+1,nlayer-1 |
|---|
| 159 | hlay=RD*(pt(ig,l-1)+pt(ig,l))/2./RG |
|---|
| 160 | IF (pplay(ig,l) .gt. ptop(ig,iaer)) THEN |
|---|
| 161 | mode_dens = nmode(ig,iaer) ! m-3 |
|---|
| 162 | ELSEIF (pplay(ig,l) .le. ptop(ig,iaer) .and. pplay(ig,l) .gt. ptop2(ig,iaer)) THEN |
|---|
| 163 | mode_dens = mode_dens*(pplay(ig,l)/pplay(ig,l-1))**(hlay/htop(ig,iaer)) |
|---|
| 164 | ELSEIF (pplay(ig,l) .le. ptop2(ig,iaer)) THEN |
|---|
| 165 | mode_dens = mode_dens*(pplay(ig,l)/pplay(ig,l-1))**(hlay/htop2(ig,iaer)) |
|---|
| 166 | ENDIF |
|---|
| 167 | mode_dens=max(1.e-30,mode_dens) |
|---|
| 168 | if (iaer.lt.5) then |
|---|
| 169 | aerosol(ig,l,iaer) = QREFvis3d(ig,l,iaer)* & |
|---|
| 170 | RPI*(reffrad(ig,l,iaer))**2*exp(-3.*log(1+nueffrad(ig,l,iaer)))* & |
|---|
| 171 | mode_dens*hlay*(pplev(ig,l)-pplev(ig,l+1))/pplay(ig,l) |
|---|
| 172 | else ! for UV absorber |
|---|
| 173 | ! normalized to 0.35 microns (peak of absorption) |
|---|
| 174 | aerosol(ig,l,iaer) = QREFvis3d(ig,l,iaer)*mode_dens |
|---|
| 175 | endif |
|---|
| 176 | ENDDO |
|---|
| 177 | |
|---|
| 178 | if (iaer.eq.5) then ! for UV absorber |
|---|
| 179 | DO l=1,nlayer |
|---|
| 180 | tau_col(ig) = tau_col(ig) & |
|---|
| 181 | + aerosol(ig,l,iaer) |
|---|
| 182 | ENDDO |
|---|
| 183 | DO l=1,nlayer |
|---|
| 184 | aerosol(ig,l,iaer)=aerosol(ig,l,iaer)*0.205/tau_col(ig) |
|---|
| 185 | ENDDO |
|---|
| 186 | endif |
|---|
| 187 | |
|---|
| 188 | enddo |
|---|
| 189 | enddo |
|---|
| 190 | |
|---|
| 191 | !================================================================== |
|---|
| 192 | ! if (is_master) then |
|---|
| 193 | ! ig=10 |
|---|
| 194 | ! do l=1,nlayer |
|---|
| 195 | ! write(82,*) l,pplay(ig,l),aerosol(ig,l,1) |
|---|
| 196 | ! write(83,*) l,pplay(ig,l),aerosol(ig,l,2) |
|---|
| 197 | ! write(84,*) l,pplay(ig,l),aerosol(ig,l,3) |
|---|
| 198 | ! write(85,*) l,pplay(ig,l),aerosol(ig,l,4) |
|---|
| 199 | ! write(86,*) l,pplay(ig,l),aerosol(ig,l,5) |
|---|
| 200 | ! enddo |
|---|
| 201 | ! endif |
|---|
| 202 | ! stop |
|---|
| 203 | !================================================================== |
|---|
| 204 | |
|---|
| 205 | ! -------------------------------------------------------------------------- |
|---|
| 206 | ! Column integrated visible optical depth in each point (used for diagnostic) |
|---|
| 207 | |
|---|
| 208 | tau_col(:)=0.0 |
|---|
| 209 | do ig=1,ngrid |
|---|
| 210 | do l=1,nlayer |
|---|
| 211 | do iaer = 1, naerkind |
|---|
| 212 | tau_col(ig) = tau_col(ig) + aerosol(ig,l,iaer) |
|---|
| 213 | end do |
|---|
| 214 | end do |
|---|
| 215 | end do |
|---|
| 216 | |
|---|
| 217 | do ig=1,ngrid |
|---|
| 218 | do l=1,nlayer |
|---|
| 219 | do iaer = 1, naerkind |
|---|
| 220 | if(aerosol(ig,l,iaer).gt.1.e3)then |
|---|
| 221 | print*,'WARNING: aerosol=',aerosol(ig,l,iaer) |
|---|
| 222 | print*,'at ig=',ig,', l=',l,', iaer=',iaer |
|---|
| 223 | print*,'QREFvis3d=',QREFvis3d(ig,l,iaer) |
|---|
| 224 | print*,'reffrad=',reffrad(ig,l,iaer) |
|---|
| 225 | endif |
|---|
| 226 | end do |
|---|
| 227 | end do |
|---|
| 228 | end do |
|---|
| 229 | |
|---|
| 230 | do ig=1,ngrid |
|---|
| 231 | if(tau_col(ig).gt.1.e3)then |
|---|
| 232 | print*,'WARNING: tau_col=',tau_col(ig) |
|---|
| 233 | print*,'at ig=',ig |
|---|
| 234 | print*,'aerosol=',aerosol(ig,:,:) |
|---|
| 235 | print*,'QREFvis3d=',QREFvis3d(ig,:,:) |
|---|
| 236 | print*,'reffrad=',reffrad(ig,:,:) |
|---|
| 237 | endif |
|---|
| 238 | end do |
|---|
| 239 | |
|---|
| 240 | return |
|---|
| 241 | end subroutine aeropacity |
|---|
| 242 | |
|---|
| 243 | ! -------------------------------------------------------------------------- |
|---|
| 244 | ! -------------------------------------------------------------------------- |
|---|
| 245 | subroutine cloud_haus16(ngrid,pbot2,pbot,hbot2,hbot,ptop,ptop2,htop,htop2,nmode) |
|---|
| 246 | |
|---|
| 247 | !================================================================== |
|---|
| 248 | ! Venus clouds (4 modes) |
|---|
| 249 | ! S. Lebonnois (jan 2016) |
|---|
| 250 | !================================================================== |
|---|
| 251 | ! distributions from Haus et al, 2016 |
|---|
| 252 | ! ------------------------------------ |
|---|
| 253 | ! |
|---|
| 254 | ! mode 1 2 2p 3 |
|---|
| 255 | ! r (microns) 0.30 1.05 1.40 3.65 |
|---|
| 256 | ! sigma 1.56 1.29 1.23 1.28 |
|---|
| 257 | ! reff (microns) 0.49 1.23 1.56 4.25 |
|---|
| 258 | ! nueff 0.21 0.067 0.044 0.063 |
|---|
| 259 | ! (nueff=exp(ln^2 sigma)-1) |
|---|
| 260 | ! |
|---|
| 261 | ! pbot <=> zb ; ptop <=> zb+zc ; hbot <=> Hlo ; htop <=> Hup |
|---|
| 262 | ! p<ptop: N(i+1)=N(i)*(p(i+1)/p(i))**(hlay(i)/htop) |
|---|
| 263 | ! hlay=R(T(i)+T(i+1))/2/g (in m) |
|---|
| 264 | ! R=8.31/mu (mu in kg/mol) |
|---|
| 265 | ! p>pbot: N(i-1)=N(i)*(p(i)/p(i-1))**(hlay(i)/hbot) |
|---|
| 266 | ! N is in m-3 |
|---|
| 267 | ! |
|---|
| 268 | ! values in each mode below from Table 1 and text (p.186) |
|---|
| 269 | ! |
|---|
| 270 | ! dTau = Qext*[pi*reff**2*exp(-3*ln(1+nueff))]*N*hlay*(-dp)/p |
|---|
| 271 | ! |
|---|
| 272 | ! Latitudinal dependence (values from tables 3 and 4): |
|---|
| 273 | ! mode factor MF12(lat) for modes 1 and 2 |
|---|
| 274 | ! mode 2' unchanged |
|---|
| 275 | ! mode factor MF3(lat) for mode 3 |
|---|
| 276 | ! + for mode 2 only : pbot(lat), ptop(lat), htop(lat), htop2(lat) |
|---|
| 277 | !================================================================== |
|---|
| 278 | |
|---|
| 279 | use radinc_h, only : naerkind |
|---|
| 280 | USE geometry_mod, ONLY: latitude_deg |
|---|
| 281 | implicit none |
|---|
| 282 | |
|---|
| 283 | INTEGER,INTENT(IN) :: ngrid ! number of atmospheric columns |
|---|
| 284 | real,INTENT(out) :: pbot2(ngrid,naerkind),pbot(ngrid,naerkind) |
|---|
| 285 | real,INTENT(out) :: ptop(ngrid,naerkind),ptop2(ngrid,naerkind) |
|---|
| 286 | real,INTENT(out) :: hbot2(ngrid,naerkind),hbot(ngrid,naerkind) |
|---|
| 287 | real,INTENT(out) :: htop(ngrid,naerkind),htop2(ngrid,naerkind) |
|---|
| 288 | real,INTENT(out) :: nmode(ngrid,naerkind) |
|---|
| 289 | |
|---|
| 290 | ! For latitudinal dependence |
|---|
| 291 | integer :: i,j,ilat |
|---|
| 292 | real :: latit,factlat |
|---|
| 293 | integer,parameter :: nlat_H16 = 16 |
|---|
| 294 | real :: lat_H16(nlat_H16) |
|---|
| 295 | real :: MF12(nlat_H16),MF3(nlat_H16) |
|---|
| 296 | real :: pbotM2(nlat_H16),ptopM2(nlat_H16),htopM2(nlat_H16) |
|---|
| 297 | |
|---|
| 298 | !------------------------- |
|---|
| 299 | !! Equatorial model |
|---|
| 300 | !------------------------- |
|---|
| 301 | ! initialization |
|---|
| 302 | pbot2(:,:) = 1.e8 |
|---|
| 303 | pbot(:,:) = 1.e8 |
|---|
| 304 | ptop2(:,:) = 0. |
|---|
| 305 | ptop(:,:) = 0. |
|---|
| 306 | hbot2(:,:) = 1. |
|---|
| 307 | hbot(:,:) = 1. |
|---|
| 308 | htop2(:,:) = 1. |
|---|
| 309 | htop(:,:) = 1. |
|---|
| 310 | nmode(:,:) = 0. |
|---|
| 311 | |
|---|
| 312 | ! table of values(lat,mode) |
|---|
| 313 | |
|---|
| 314 | ! Mode 1 |
|---|
| 315 | pbot2(:,1) = 2.0e5 ! Pa |
|---|
| 316 | hbot2(:,1) = 5.0e3 ! m |
|---|
| 317 | pbot(:,1) = 1.2e5 |
|---|
| 318 | hbot(:,1) = 1.0e3 |
|---|
| 319 | nmode(:,1) = 1.935e8 ! m-3 |
|---|
| 320 | ptop(:,1) = 1.0e4 |
|---|
| 321 | htop(:,1) = 3.5e3 |
|---|
| 322 | ptop2(:,1) = 4.5e2 |
|---|
| 323 | htop2(:,1) = 2.0e3 |
|---|
| 324 | |
|---|
| 325 | ! Mode 2 |
|---|
| 326 | pbot(:,2) = 1.0e4 |
|---|
| 327 | hbot(:,2) = 3.0e3 |
|---|
| 328 | nmode(:,2) = 1.00e8 ! m-3 |
|---|
| 329 | ptop(:,2) = 8.0e3 |
|---|
| 330 | htop(:,2) = 3.5e3 |
|---|
| 331 | ptop2(:,2) = 4.5e2 |
|---|
| 332 | htop2(:,2) = 2.0e3 |
|---|
| 333 | |
|---|
| 334 | ! Mode 2p |
|---|
| 335 | pbot(:,3) = 1.2e5 |
|---|
| 336 | hbot(:,3) = 0.1e3 |
|---|
| 337 | nmode(:,3) = 5.0e7 ! m-3 |
|---|
| 338 | ptop(:,3) = 2.3e4 |
|---|
| 339 | htop(:,3) = 1.0e3 |
|---|
| 340 | |
|---|
| 341 | ! Mode 3 |
|---|
| 342 | pbot(:,4) = 1.2e5 |
|---|
| 343 | hbot(:,4) = 0.5e3 |
|---|
| 344 | nmode(:,4) = 1.4e7 ! m-3 |
|---|
| 345 | ptop(:,4) = 3.9e4 |
|---|
| 346 | htop(:,4) = 1.0e3 |
|---|
| 347 | |
|---|
| 348 | ! UV absorber |
|---|
| 349 | pbot(:,5) = 3.3e4 ! 58 km |
|---|
| 350 | hbot(:,5) = 1.0e3 |
|---|
| 351 | nmode(:,5) = 1.00e7 !m-3 |
|---|
| 352 | ptop(:,5) = 3.7e3 ! 70 km |
|---|
| 353 | htop(:,5) = 1.0e3 |
|---|
| 354 | |
|---|
| 355 | !---------------------------- |
|---|
| 356 | !! Latitudinal variations |
|---|
| 357 | !---------------------------- |
|---|
| 358 | lat_H16(:) = (/0.,15.,20.,25.,30.,35.,40.,45.,50.,55.,60.,65.,70.,75.,80.,90./) |
|---|
| 359 | MF12(:) = (/0.98,0.98,0.99,1.00,0.98,0.94,0.86,0.81,0.73,0.67,0.64,0.61,0.59,0.47,0.36,0.36/) |
|---|
| 360 | MF3(:) = (/1.30,1.30,1.26,1.23,1.17,1.13,1.06,1.03,1.04,1.09,1.22,1.51,1.82,2.02,2.09,2.09/) |
|---|
| 361 | pbotM2(:) = (/1.0e4,1.0e4,1.0e4,1.0e4,1.0e4,1.0e4,1.0e4,1.0e4,9.4e3, & |
|---|
| 362 | 9.2e3,9.1e3,9.6e3,1.14e4,1.21e4,1.25e4,1.25e4/) |
|---|
| 363 | ptopM2(:) = (/8.0e3,8.0e3,8.0e3,8.0e3,8.0e3,8.0e3,8.0e3,8.0e3,7.7e3, & |
|---|
| 364 | 7.5e3,7.5e3,8.0e3,9.2e3,1.0e4,1.06e4,1.06e4/) |
|---|
| 365 | htopM2(:) = (/3.5e3,3.5e3,3.5e3,3.5e3,3.5e3,3.5e3,3.5e3,3.5e3,3.4e3, & |
|---|
| 366 | 3.2e3,2.6e3,2.0e3,2.0e3,0.6e3,0.5e3,0.5e3/) |
|---|
| 367 | |
|---|
| 368 | do i=1,ngrid |
|---|
| 369 | latit = abs(latitude_deg(i)) |
|---|
| 370 | ilat=2 |
|---|
| 371 | do j=2,nlat_H16 |
|---|
| 372 | if (latit.gt.lat_H16(j-1)) ilat=j |
|---|
| 373 | enddo |
|---|
| 374 | factlat = (lat_H16(ilat)-latit)/(lat_H16(ilat)-lat_H16(ilat-1)) |
|---|
| 375 | pbot(i,2) = pbotM2(ilat)*(1.-factlat) + pbotM2(ilat-1)*factlat |
|---|
| 376 | ptop(i,2) = ptopM2(ilat)*(1.-factlat) + ptopM2(ilat-1)*factlat |
|---|
| 377 | htop(i,2) = htopM2(ilat)*(1.-factlat) + htopM2(ilat-1)*factlat |
|---|
| 378 | htop2(i,2) = min(htop2(i,2),htop(i,2)) |
|---|
| 379 | nmode(i,1) = nmode(i,1)*(MF12(ilat)*(1.-factlat)+MF12(ilat-1)*factlat) |
|---|
| 380 | nmode(i,2) = nmode(i,2)*(MF12(ilat)*(1.-factlat)+MF12(ilat-1)*factlat) |
|---|
| 381 | nmode(i,3) = nmode(i,3)*(MF3(ilat) *(1.-factlat)+MF3(ilat-1) *factlat) |
|---|
| 382 | enddo |
|---|
| 383 | |
|---|
| 384 | return |
|---|
| 385 | end subroutine cloud_haus16 |
|---|
