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