Changes in src/concoutput_surf.f90 [16b61a5:6a678e3] in flexpart.git
- File:
-
- 1 edited
-
src/concoutput_surf.f90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/concoutput_surf.f90
r16b61a5 r6a678e3 21 21 22 22 subroutine concoutput_surf(itime,outnum,gridtotalunc,wetgridtotalunc, & 23 drygridtotalunc)24 ! i i o o25 ! o26 !*****************************************************************************27 ! *28 ! Output of the concentration grid and the receptor concentrations. *29 ! *30 ! Author: A. Stohl *31 ! *32 ! 24 May 1995 *33 ! *34 ! 13 April 1999, Major update: if output size is smaller, dump output *35 ! in sparse matrix format; additional output of *36 ! uncertainty *37 ! *38 ! 05 April 2000, Major update: output of age classes; output for backward*39 ! runs is time spent in grid cell times total mass of *40 ! species. *41 ! *42 ! 17 February 2002, Appropriate dimensions for backward and forward runs *43 ! are now specified in file par_mod *44 ! *45 ! June 2006, write grid in sparse matrix with a single write command *46 ! in order to save disk space *47 ! *48 ! 2008 new sparse matrix format *49 ! *50 !*****************************************************************************51 ! *52 ! Variables: *53 ! outnum number of samples *54 ! ncells number of cells with non-zero concentrations *55 ! sparse .true. if in sparse matrix format, else .false. *56 ! tot_mu 1 for forward, initial mass mixing ration for backw. runs *57 ! *58 !*****************************************************************************23 drygridtotalunc) 24 ! i i o o 25 ! o 26 !***************************************************************************** 27 ! * 28 ! Output of the concentration grid and the receptor concentrations. * 29 ! * 30 ! Author: A. Stohl * 31 ! * 32 ! 24 May 1995 * 33 ! * 34 ! 13 April 1999, Major update: if output size is smaller, dump output * 35 ! in sparse matrix format; additional output of * 36 ! uncertainty * 37 ! * 38 ! 05 April 2000, Major update: output of age classes; output for backward* 39 ! runs is time spent in grid cell times total mass of * 40 ! species. * 41 ! * 42 ! 17 February 2002, Appropriate dimensions for backward and forward runs * 43 ! are now specified in file par_mod * 44 ! * 45 ! June 2006, write grid in sparse matrix with a single write command * 46 ! in order to save disk space * 47 ! * 48 ! 2008 new sparse matrix format * 49 ! * 50 !***************************************************************************** 51 ! * 52 ! Variables: * 53 ! outnum number of samples * 54 ! ncells number of cells with non-zero concentrations * 55 ! sparse .true. if in sparse matrix format, else .false. * 56 ! tot_mu 1 for forward, initial mass mixing ration for backw. runs * 57 ! * 58 !***************************************************************************** 59 59 60 60 use unc_mod … … 73 73 real :: outnum,densityoutrecept(maxreceptor),xl,yl 74 74 75 !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),76 ! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,77 ! + maxageclass)78 !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,79 ! + maxageclass)80 !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,81 ! + maxpointspec_act,maxageclass)82 !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,83 ! + maxpointspec_act,maxageclass),84 ! + drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,85 ! + maxpointspec_act,maxageclass),86 ! + wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,87 ! + maxpointspec_act,maxageclass)88 !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)89 !real sparse_dump_r(numxgrid*numygrid*numzgrid)90 !integer sparse_dump_i(numxgrid*numygrid*numzgrid)91 92 !real sparse_dump_u(numxgrid*numygrid*numzgrid)75 !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid), 76 ! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act, 77 ! + maxageclass) 78 !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act, 79 ! + maxageclass) 80 !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec, 81 ! + maxpointspec_act,maxageclass) 82 !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, 83 ! + maxpointspec_act,maxageclass), 84 ! + drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec, 85 ! + maxpointspec_act,maxageclass), 86 ! + wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec, 87 ! + maxpointspec_act,maxageclass) 88 !real factor(0:numxgrid-1,0:numygrid-1,numzgrid) 89 !real sparse_dump_r(numxgrid*numygrid*numzgrid) 90 !integer sparse_dump_i(numxgrid*numygrid*numzgrid) 91 92 !real sparse_dump_u(numxgrid*numygrid*numzgrid) 93 93 real(dep_prec) :: auxgrid(nclassunc) 94 94 real(sp) :: gridtotal,gridsigmatotal,gridtotalunc … … 104 104 105 105 if (verbosity.eq.1) then 106 print*,'inside concoutput_surf '107 CALL SYSTEM_CLOCK(count_clock)108 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0109 endif 110 111 ! Determine current calendar date, needed for the file name112 !**********************************************************106 print*,'inside concoutput_surf ' 107 CALL SYSTEM_CLOCK(count_clock) 108 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 109 endif 110 111 ! Determine current calendar date, needed for the file name 112 !********************************************************** 113 113 114 114 jul=bdate+real(itime,kind=dp)/86400._dp … … 116 116 write(adate,'(i8.8)') jjjjmmdd 117 117 write(atime,'(i6.6)') ihmmss 118 !write(unitdates,'(a)') adate//atime119 120 open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')121 write(unitdates,'(a)') adate//atime122 close(unitdates)123 124 ! For forward simulations, output fields have dimension MAXSPEC,125 ! for backward simulations, output fields have dimension MAXPOINT.126 ! Thus, make loops either about nspec, or about numpoint127 !*****************************************************************118 !write(unitdates,'(a)') adate//atime 119 120 open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND') 121 write(unitdates,'(a)') adate//atime 122 close(unitdates) 123 124 ! For forward simulations, output fields have dimension MAXSPEC, 125 ! for backward simulations, output fields have dimension MAXPOINT. 126 ! Thus, make loops either about nspec, or about numpoint 127 !***************************************************************** 128 128 129 129 … … 144 144 145 145 if (verbosity.eq.1) then 146 print*,'concoutput_surf 2'147 CALL SYSTEM_CLOCK(count_clock)148 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0149 endif 150 151 !*******************************************************************152 ! Compute air density: sufficiently accurate to take it153 ! from coarse grid at some time154 ! Determine center altitude of output layer, and interpolate density155 ! data to that altitude156 !*******************************************************************146 print*,'concoutput_surf 2' 147 CALL SYSTEM_CLOCK(count_clock) 148 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 149 endif 150 151 !******************************************************************* 152 ! Compute air density: sufficiently accurate to take it 153 ! from coarse grid at some time 154 ! Determine center altitude of output layer, and interpolate density 155 ! data to that altitude 156 !******************************************************************* 157 157 158 158 do kz=1,numzgrid … … 166 166 (height(kzz).gt.halfheight)) goto 46 167 167 end do 168 46 kzz=max(min(kzz,nz),2)168 46 kzz=max(min(kzz,nz),2) 169 169 dz1=halfheight-height(kzz-1) 170 170 dz2=height(kzz)-halfheight … … 184 184 end do 185 185 186 do i=1,numreceptor187 xl=xreceptor(i)188 yl=yreceptor(i)189 iix=max(min(nint(xl),nxmin1),0)190 jjy=max(min(nint(yl),nymin1),0)191 densityoutrecept(i)=rho(iix,jjy,1,2)192 end do193 194 195 ! Output is different for forward and backward simulations196 do kz=1,numzgrid197 do jy=0,numygrid-1198 do ix=0,numxgrid-1199 if (ldirect.eq.1) then200 factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum201 else202 factor3d(ix,jy,kz)=real(abs(loutaver))/outnum203 endif204 end do205 end do206 end do207 208 !*********************************************************************209 ! Determine the standard deviation of the mean concentration or mixing210 ! ratio (uncertainty of the output) and the dry and wet deposition211 !*********************************************************************186 do i=1,numreceptor 187 xl=xreceptor(i) 188 yl=yreceptor(i) 189 iix=max(min(nint(xl),nxmin1),0) 190 jjy=max(min(nint(yl),nymin1),0) 191 densityoutrecept(i)=rho(iix,jjy,1,2) 192 end do 193 194 195 ! Output is different for forward and backward simulations 196 do kz=1,numzgrid 197 do jy=0,numygrid-1 198 do ix=0,numxgrid-1 199 if (ldirect.eq.1) then 200 factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum 201 else 202 factor3d(ix,jy,kz)=real(abs(loutaver))/outnum 203 endif 204 end do 205 end do 206 end do 207 208 !********************************************************************* 209 ! Determine the standard deviation of the mean concentration or mixing 210 ! ratio (uncertainty of the output) and the dry and wet deposition 211 !********************************************************************* 212 212 213 213 if (verbosity.eq.1) then 214 print*,'concoutput_surf 3 (sd)'215 CALL SYSTEM_CLOCK(count_clock)216 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0214 print*,'concoutput_surf 3 (sd)' 215 CALL SYSTEM_CLOCK(count_clock) 216 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 217 217 endif 218 218 gridtotal=0. … … 228 228 do ks=1,nspec 229 229 230 write(anspec,'(i3.3)') ks 231 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then 232 if (ldirect.eq.1) then 233 open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// & 234 atime//'_'//anspec,form='unformatted') 235 else 236 open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// & 237 atime//'_'//anspec,form='unformatted') 238 endif 239 write(unitoutgrid) itime 230 write(anspec,'(i3.3)') ks 231 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then 232 if (ldirect.eq.1) then 233 open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// & 234 atime//'_'//anspec,form='unformatted') 235 else 236 open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// & 237 atime//'_'//anspec,form='unformatted') 240 238 endif 241 242 if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio243 open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// & 244 atime//'_'//anspec,form='unformatted')245 246 write(unitoutgridppt) itime247 endif 248 249 do kp=1,maxpointspec_act250 do nage=1,nageclass 251 252 do jy=0,numygrid-1253 do ix=0,numxgrid-1 254 255 ! WET DEPOSITION 256 if ((WETDEP).and.(ldirect.gt.0)) then 257 do l=1,nclassunc258 auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)259 end do260 call mean(auxgrid,wetgrid(ix,jy), &261 wetgridsigma(ix,jy),nclassunc)262 ! Multiply by number of classes to get total concentration 263 wetgrid(ix,jy)=wetgrid(ix,jy) &264 *nclassunc265 wetgridtotal=wetgridtotal+wetgrid(ix,jy)266 ! Calculate standard deviation of the mean 267 wetgridsigma(ix,jy)= &268 wetgridsigma(ix,jy)* &269 sqrt(real(nclassunc))270 wetgridsigmatotal=wetgridsigmatotal+&271 wetgridsigma(ix,jy)272 endif273 274 ! DRY DEPOSITION 275 if ((DRYDEP).and.(ldirect.gt.0)) then 276 do l=1,nclassunc277 auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)278 end do279 call mean(auxgrid,drygrid(ix,jy), &280 drygridsigma(ix,jy),nclassunc)281 ! Multiply by number of classes to get total concentration 282 drygrid(ix,jy)=drygrid(ix,jy)* &283 nclassunc284 drygridtotal=drygridtotal+drygrid(ix,jy)285 ! Calculate standard deviation of the mean 286 drygridsigma(ix,jy)= &287 drygridsigma(ix,jy)* &288 sqrt(real(nclassunc))289 125 drygridsigmatotal=drygridsigmatotal+&290 drygridsigma(ix,jy)291 endif 292 293 ! CONCENTRATION OR MIXING RATIO 294 do kz=1,numzgrid 295 do l=1,nclassunc296 auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)297 end do298 call mean(auxgrid,grid(ix,jy,kz), &299 gridsigma(ix,jy,kz),nclassunc)300 ! Multiply by number of classes to get total concentration 301 grid(ix,jy,kz)= &302 grid(ix,jy,kz)*nclassunc303 gridtotal=gridtotal+grid(ix,jy,kz)304 ! Calculate standard deviation of the mean 305 gridsigma(ix,jy,kz)= &306 gridsigma(ix,jy,kz)* &307 sqrt(real(nclassunc))308 gridsigmatotal=gridsigmatotal+&309 gridsigma(ix,jy,kz)310 end do311 end do239 write(unitoutgrid) itime 240 endif 241 242 if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio 243 open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// & 244 atime//'_'//anspec,form='unformatted') 245 246 write(unitoutgridppt) itime 247 endif 248 249 do kp=1,maxpointspec_act 250 do nage=1,nageclass 251 252 do jy=0,numygrid-1 253 do ix=0,numxgrid-1 254 255 ! WET DEPOSITION 256 if ((WETDEP).and.(ldirect.gt.0)) then 257 do l=1,nclassunc 258 auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage) 259 end do 260 call mean(auxgrid,wetgrid(ix,jy), & 261 wetgridsigma(ix,jy),nclassunc) 262 ! Multiply by number of classes to get total concentration 263 wetgrid(ix,jy)=wetgrid(ix,jy) & 264 *nclassunc 265 wetgridtotal=wetgridtotal+wetgrid(ix,jy) 266 ! Calculate standard deviation of the mean 267 wetgridsigma(ix,jy)= & 268 wetgridsigma(ix,jy)* & 269 sqrt(real(nclassunc)) 270 wetgridsigmatotal=wetgridsigmatotal+ & 271 wetgridsigma(ix,jy) 272 endif 273 274 ! DRY DEPOSITION 275 if ((DRYDEP).and.(ldirect.gt.0)) then 276 do l=1,nclassunc 277 auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage) 278 end do 279 call mean(auxgrid,drygrid(ix,jy), & 280 drygridsigma(ix,jy),nclassunc) 281 ! Multiply by number of classes to get total concentration 282 drygrid(ix,jy)=drygrid(ix,jy)* & 283 nclassunc 284 drygridtotal=drygridtotal+drygrid(ix,jy) 285 ! Calculate standard deviation of the mean 286 drygridsigma(ix,jy)= & 287 drygridsigma(ix,jy)* & 288 sqrt(real(nclassunc)) 289 125 drygridsigmatotal=drygridsigmatotal+ & 290 drygridsigma(ix,jy) 291 endif 292 293 ! CONCENTRATION OR MIXING RATIO 294 do kz=1,numzgrid 295 do l=1,nclassunc 296 auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage) 297 end do 298 call mean(auxgrid,grid(ix,jy,kz), & 299 gridsigma(ix,jy,kz),nclassunc) 300 ! Multiply by number of classes to get total concentration 301 grid(ix,jy,kz)= & 302 grid(ix,jy,kz)*nclassunc 303 gridtotal=gridtotal+grid(ix,jy,kz) 304 ! Calculate standard deviation of the mean 305 gridsigma(ix,jy,kz)= & 306 gridsigma(ix,jy,kz)* & 307 sqrt(real(nclassunc)) 308 gridsigmatotal=gridsigmatotal+ & 309 gridsigma(ix,jy,kz) 312 310 end do 313 314 315 !******************************************************************* 316 ! Generate output: may be in concentration (ng/m3) or in mixing 317 ! ratio (ppt) or both 318 ! Output the position and the values alternated multiplied by 319 ! 1 or -1, first line is number of values, number of positions 320 ! For backward simulations, the unit is seconds, stored in grid_time 321 !******************************************************************* 322 323 if (verbosity.eq.1) then 324 print*,'concoutput_surf 4 (output)' 325 CALL SYSTEM_CLOCK(count_clock) 326 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 327 endif 328 329 ! Concentration output 330 !********************* 331 332 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then 333 334 if (verbosity.eq.1) then 335 print*,'concoutput_surf (Wet deposition)' 336 CALL SYSTEM_CLOCK(count_clock) 337 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 338 endif 339 340 ! Wet deposition 341 sp_count_i=0 342 sp_count_r=0 343 sp_fact=-1. 344 sp_zer=.true. 345 if ((ldirect.eq.1).and.(WETDEP)) then 346 do jy=0,numygrid-1 347 do ix=0,numxgrid-1 348 ! concentraion greater zero 349 if (wetgrid(ix,jy).gt.smallnum) then 350 if (sp_zer.eqv..true.) then ! first non zero value 311 end do 312 end do 313 314 315 !******************************************************************* 316 ! Generate output: may be in concentration (ng/m3) or in mixing 317 ! ratio (ppt) or both 318 ! Output the position and the values alternated multiplied by 319 ! 1 or -1, first line is number of values, number of positions 320 ! For backward simulations, the unit is seconds, stored in grid_time 321 !******************************************************************* 322 323 if (verbosity.eq.1) then 324 print*,'concoutput_surf 4 (output)' 325 CALL SYSTEM_CLOCK(count_clock) 326 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 327 endif 328 329 ! Concentration output 330 !********************* 331 332 if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then 333 334 if (verbosity.eq.1) then 335 print*,'concoutput_surf (Wet deposition)' 336 CALL SYSTEM_CLOCK(count_clock) 337 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 338 endif 339 340 ! Wet deposition 341 sp_count_i=0 342 sp_count_r=0 343 sp_fact=-1. 344 sp_zer=.true. 345 if ((ldirect.eq.1).and.(WETDEP)) then 346 do jy=0,numygrid-1 347 do ix=0,numxgrid-1 348 ! concentraion greater zero 349 if (wetgrid(ix,jy).gt.smallnum) then 350 if (sp_zer.eqv..true.) then ! first non zero value 351 351 sp_count_i=sp_count_i+1 352 352 sparse_dump_i(sp_count_i)=ix+jy*numxgrid 353 353 sp_zer=.false. 354 354 sp_fact=sp_fact*(-1.) 355 356 357 358 359 360 361 355 endif 356 sp_count_r=sp_count_r+1 357 sparse_dump_r(sp_count_r)= & 358 sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy) 359 sparse_dump_u(sp_count_r)= & 360 1.e12*wetgridsigma(ix,jy)/area(ix,jy) 361 else ! concentration is zero 362 362 sp_zer=.true. 363 364 365 366 363 endif 364 end do 365 end do 366 else 367 367 sp_count_i=0 368 368 sp_count_r=0 369 370 371 372 373 369 endif 370 write(unitoutgrid) sp_count_i 371 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) 372 write(unitoutgrid) sp_count_r 373 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) 374 374 ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r) 375 375 376 377 378 379 380 381 ! Dry deposition382 383 384 385 386 387 388 389 390 376 if (verbosity.eq.1) then 377 print*,'concoutput_surf (Dry deposition)' 378 CALL SYSTEM_CLOCK(count_clock) 379 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 380 endif 381 ! Dry deposition 382 sp_count_i=0 383 sp_count_r=0 384 sp_fact=-1. 385 sp_zer=.true. 386 if ((ldirect.eq.1).and.(DRYDEP)) then 387 do jy=0,numygrid-1 388 do ix=0,numxgrid-1 389 if (drygrid(ix,jy).gt.smallnum) then 390 if (sp_zer.eqv..true.) then ! first non zero value 391 391 sp_count_i=sp_count_i+1 392 392 sparse_dump_i(sp_count_i)=ix+jy*numxgrid 393 393 sp_zer=.false. 394 394 sp_fact=sp_fact*(-1.) 395 396 397 398 399 395 endif 396 sp_count_r=sp_count_r+1 397 sparse_dump_r(sp_count_r)= & 398 sp_fact* & 399 1.e12*drygrid(ix,jy)/area(ix,jy) 400 400 sparse_dump_u(sp_count_r)= & 401 402 401 1.e12*drygridsigma(ix,jy)/area(ix,jy) 402 else ! concentration is zero 403 403 sp_zer=.true. 404 405 406 407 404 endif 405 end do 406 end do 407 else 408 408 sp_count_i=0 409 409 sp_count_r=0 410 411 412 413 414 410 endif 411 write(unitoutgrid) sp_count_i 412 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) 413 write(unitoutgrid) sp_count_r 414 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) 415 415 ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r) 416 416 417 418 419 420 421 422 423 ! Concentrations424 425 ! surf_only write only 1st layer426 427 428 429 430 417 if (verbosity.eq.1) then 418 print*,'concoutput_surf (Concentrations)' 419 CALL SYSTEM_CLOCK(count_clock) 420 WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 421 endif 422 423 ! Concentrations 424 425 ! surf_only write only 1st layer 426 427 sp_count_i=0 428 sp_count_r=0 429 sp_fact=-1. 430 sp_zer=.true. 431 431 do kz=1,1 432 432 do jy=0,numygrid-1 … … 440 440 sp_fact=sp_fact*(-1.) 441 441 endif 442 sp_count_r=sp_count_r+1443 sparse_dump_r(sp_count_r)= &444 sp_fact* &445 grid(ix,jy,kz)* &446 factor3d(ix,jy,kz)/tot_mu(ks,kp)447 ! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)448 ! + write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp449 sparse_dump_u(sp_count_r)= &450 gridsigma(ix,jy,kz)* &451 factor3d(ix,jy,kz)/tot_mu(ks,kp)442 sp_count_r=sp_count_r+1 443 sparse_dump_r(sp_count_r)= & 444 sp_fact* & 445 grid(ix,jy,kz)* & 446 factor3d(ix,jy,kz)/tot_mu(ks,kp) 447 ! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0) 448 ! + write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp 449 sparse_dump_u(sp_count_r)= & 450 gridsigma(ix,jy,kz)* & 451 factor3d(ix,jy,kz)/tot_mu(ks,kp) 452 452 else ! concentration is zero 453 453 sp_zer=.true. 454 454 endif 455 456 457 458 459 460 461 455 end do 456 end do 457 end do 458 write(unitoutgrid) sp_count_i 459 write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) 460 write(unitoutgrid) sp_count_r 461 write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) 462 462 ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r) 463 463 464 465 466 ! Mixing ratio output467 !********************468 469 470 471 ! Wet deposition472 473 474 475 476 477 478 464 endif ! concentration output 465 466 ! Mixing ratio output 467 !******************** 468 469 if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio 470 471 ! Wet deposition 472 sp_count_i=0 473 sp_count_r=0 474 sp_fact=-1. 475 sp_zer=.true. 476 if ((ldirect.eq.1).and.(WETDEP)) then 477 do jy=0,numygrid-1 478 do ix=0,numxgrid-1 479 479 if (wetgrid(ix,jy).gt.smallnum) then 480 480 if (sp_zer.eqv..true.) then ! first non zero value … … 484 484 sp_zer=.false. 485 485 sp_fact=sp_fact*(-1.) 486 487 488 489 490 491 492 493 486 endif 487 sp_count_r=sp_count_r+1 488 sparse_dump_r(sp_count_r)= & 489 sp_fact* & 490 1.e12*wetgrid(ix,jy)/area(ix,jy) 491 sparse_dump_u(sp_count_r)= & 492 1.e12*wetgridsigma(ix,jy)/area(ix,jy) 493 else ! concentration is zero 494 494 sp_zer=.true. 495 496 497 498 499 500 501 502 503 504 505 495 endif 496 end do 497 end do 498 else 499 sp_count_i=0 500 sp_count_r=0 501 endif 502 write(unitoutgridppt) sp_count_i 503 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) 504 write(unitoutgridppt) sp_count_r 505 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) 506 506 ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r) 507 507 508 508 509 ! Dry deposition510 511 512 513 514 515 516 509 ! Dry deposition 510 sp_count_i=0 511 sp_count_r=0 512 sp_fact=-1. 513 sp_zer=.true. 514 if ((ldirect.eq.1).and.(DRYDEP)) then 515 do jy=0,numygrid-1 516 do ix=0,numxgrid-1 517 517 if (drygrid(ix,jy).gt.smallnum) then 518 518 if (sp_zer.eqv..true.) then ! first non zero value … … 522 522 sp_zer=.false. 523 523 sp_fact=sp_fact*(-1) 524 525 526 527 528 529 530 531 524 endif 525 sp_count_r=sp_count_r+1 526 sparse_dump_r(sp_count_r)= & 527 sp_fact* & 528 1.e12*drygrid(ix,jy)/area(ix,jy) 529 sparse_dump_u(sp_count_r)= & 530 1.e12*drygridsigma(ix,jy)/area(ix,jy) 531 else ! concentration is zero 532 532 sp_zer=.true. 533 534 535 536 537 538 539 540 541 542 543 533 endif 534 end do 535 end do 536 else 537 sp_count_i=0 538 sp_count_r=0 539 endif 540 write(unitoutgridppt) sp_count_i 541 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) 542 write(unitoutgridppt) sp_count_r 543 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) 544 544 ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r) 545 545 546 546 547 ! Mixing ratios548 549 ! surf_only write only 1st layer550 551 552 553 554 547 ! Mixing ratios 548 549 ! surf_only write only 1st layer 550 551 sp_count_i=0 552 sp_count_r=0 553 sp_fact=-1. 554 sp_zer=.true. 555 555 do kz=1,1 556 556 do jy=0,numygrid-1 … … 563 563 sp_zer=.false. 564 564 sp_fact=sp_fact*(-1.) 565 566 567 568 569 570 571 572 573 574 575 576 565 endif 566 sp_count_r=sp_count_r+1 567 sparse_dump_r(sp_count_r)= & 568 sp_fact* & 569 1.e12*grid(ix,jy,kz) & 570 /volume(ix,jy,kz)/outnum* & 571 weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz) 572 sparse_dump_u(sp_count_r)= & 573 1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ & 574 outnum*weightair/weightmolar(ks)/ & 575 densityoutgrid(ix,jy,kz) 576 else ! concentration is zero 577 577 sp_zer=.true. 578 578 endif 579 579 end do 580 580 end do 581 581 end do 582 583 584 585 582 write(unitoutgridppt) sp_count_i 583 write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) 584 write(unitoutgridppt) sp_count_r 585 write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) 586 586 ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r) 587 587 588 589 590 591 588 endif ! output for ppt 589 590 end do 591 end do 592 592 593 593 close(unitoutgridppt) … … 602 602 drygridtotal 603 603 604 ! Dump of receptor concentrations605 606 if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then607 write(unitoutreceptppt) itime608 do ks=1,nspec609 write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &610 weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)611 end do612 endif613 614 ! Dump of receptor concentrations615 616 if (numreceptor.gt.0) then617 write(unitoutrecept) itime618 do ks=1,nspec619 write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &620 i=1,numreceptor)621 end do622 endif623 624 625 626 ! Reinitialization of grid627 !*************************604 ! Dump of receptor concentrations 605 606 if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then 607 write(unitoutreceptppt) itime 608 do ks=1,nspec 609 write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* & 610 weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor) 611 end do 612 endif 613 614 ! Dump of receptor concentrations 615 616 if (numreceptor.gt.0) then 617 write(unitoutrecept) itime 618 do ks=1,nspec 619 write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, & 620 i=1,numreceptor) 621 end do 622 endif 623 624 625 626 ! Reinitialization of grid 627 !************************* 628 628 629 629 do ks=1,nspec 630 do kp=1,maxpointspec_act 631 do i=1,numreceptor 632 creceptor(i,ks)=0. 633 end do 634 do jy=0,numygrid-1 635 do ix=0,numxgrid-1 636 do l=1,nclassunc 637 do nage=1,nageclass 638 do kz=1,numzgrid 639 gridunc(ix,jy,kz,ks,kp,l,nage)=0. 640 end do 630 do kp=1,maxpointspec_act 631 do i=1,numreceptor 632 creceptor(i,ks)=0. 633 end do 634 do jy=0,numygrid-1 635 do ix=0,numxgrid-1 636 do l=1,nclassunc 637 do nage=1,nageclass 638 do kz=1,numzgrid 639 gridunc(ix,jy,kz,ks,kp,l,nage)=0. 641 640 end do 642 641 end do … … 645 644 end do 646 645 end do 646 end do 647 647 648 648
Note: See TracChangeset
for help on using the changeset viewer.
