Changeset 3004 for palm/trunk/SOURCE/land_surface_model_mod.f90
- Timestamp:
- Apr 27, 2018 12:33:25 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r2968 r3004 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Further allocation checks implemented (averaged data will be assigned to fill 28 ! values if no allocation happened so far) 29 ! 30 ! 2968 2018-04-13 11:52:24Z suehring 27 31 ! Bugfix in initialization in case of elevated model surface 28 32 ! … … 5322 5326 5323 5327 CASE ( 'c_liq*' ) 5324 DO m = 1, surf_lsm_h%ns 5325 i = surf_lsm_h%i(m) 5326 j = surf_lsm_h%j(m) 5327 c_liq_av(j,i) = c_liq_av(j,i) + surf_lsm_h%c_liq(m) 5328 ENDDO 5328 IF ( ALLOCATED( c_liq_av ) ) THEN 5329 DO m = 1, surf_lsm_h%ns 5330 i = surf_lsm_h%i(m) 5331 j = surf_lsm_h%j(m) 5332 c_liq_av(j,i) = c_liq_av(j,i) + surf_lsm_h%c_liq(m) 5333 ENDDO 5334 ENDIF 5329 5335 5330 5336 CASE ( 'c_soil*' ) 5331 DO m = 1, surf_lsm_h%ns 5332 i = surf_lsm_h%i(m) 5333 j = surf_lsm_h%j(m) 5334 c_soil_av(j,i) = c_soil_av(j,i) + (1.0 - surf_lsm_h%c_veg(m)) 5335 ENDDO 5337 IF ( ALLOCATED( c_soil_av ) ) THEN 5338 DO m = 1, surf_lsm_h%ns 5339 i = surf_lsm_h%i(m) 5340 j = surf_lsm_h%j(m) 5341 c_soil_av(j,i) = c_soil_av(j,i) + (1.0 - surf_lsm_h%c_veg(m)) 5342 ENDDO 5343 ENDIF 5336 5344 5337 5345 CASE ( 'c_veg*' ) 5338 DO m = 1, surf_lsm_h%ns 5339 i = surf_lsm_h%i(m) 5340 j = surf_lsm_h%j(m) 5341 c_veg_av(j,i) = c_veg_av(j,i) + surf_lsm_h%c_veg(m) 5342 ENDDO 5346 IF ( ALLOCATED( c_veg_av ) ) THEN 5347 DO m = 1, surf_lsm_h%ns 5348 i = surf_lsm_h%i(m) 5349 j = surf_lsm_h%j(m) 5350 c_veg_av(j,i) = c_veg_av(j,i) + surf_lsm_h%c_veg(m) 5351 ENDDO 5352 ENDIF 5343 5353 5344 5354 CASE ( 'lai*' ) 5345 DO m = 1, surf_lsm_h%ns 5346 i = surf_lsm_h%i(m) 5347 j = surf_lsm_h%j(m) 5348 lai_av(j,i) = lai_av(j,i) + surf_lsm_h%lai(m) 5349 ENDDO 5355 IF ( ALLOCATED( lai_av ) ) THEN 5356 DO m = 1, surf_lsm_h%ns 5357 i = surf_lsm_h%i(m) 5358 j = surf_lsm_h%j(m) 5359 lai_av(j,i) = lai_av(j,i) + surf_lsm_h%lai(m) 5360 ENDDO 5361 ENDIF 5350 5362 5351 5363 CASE ( 'm_liq*' ) 5352 DO m = 1, surf_lsm_h%ns 5353 i = surf_lsm_h%i(m) 5354 j = surf_lsm_h%j(m) 5355 m_liq_av(j,i) = m_liq_av(j,i) + m_liq_h%var_1d(m) 5356 ENDDO 5364 IF ( ALLOCATED( m_liq_av ) ) THEN 5365 DO m = 1, surf_lsm_h%ns 5366 i = surf_lsm_h%i(m) 5367 j = surf_lsm_h%j(m) 5368 m_liq_av(j,i) = m_liq_av(j,i) + m_liq_h%var_1d(m) 5369 ENDDO 5370 ENDIF 5357 5371 5358 5372 CASE ( 'm_soil' ) 5359 DO m = 1, surf_lsm_h%ns 5360 i = surf_lsm_h%i(m) 5361 j = surf_lsm_h%j(m) 5362 DO k = nzb_soil, nzt_soil 5363 m_soil_av(k,j,i) = m_soil_av(k,j,i) + m_soil_h%var_2d(k,m) 5373 IF ( ALLOCATED( m_soil_av ) ) THEN 5374 DO m = 1, surf_lsm_h%ns 5375 i = surf_lsm_h%i(m) 5376 j = surf_lsm_h%j(m) 5377 DO k = nzb_soil, nzt_soil 5378 m_soil_av(k,j,i) = m_soil_av(k,j,i) + m_soil_h%var_2d(k,m) 5379 ENDDO 5364 5380 ENDDO 5365 END DO5381 ENDIF 5366 5382 5367 5383 CASE ( 'qsws_liq*' ) 5368 DO m = 1, surf_lsm_h%ns 5369 i = surf_lsm_h%i(m) 5370 j = surf_lsm_h%j(m) 5371 qsws_liq_av(j,i) = qsws_liq_av(j,i) + & 5372 surf_lsm_h%qsws_liq(m) 5373 ENDDO 5384 IF ( ALLOCATED( qsws_liq_av ) ) THEN 5385 DO m = 1, surf_lsm_h%ns 5386 i = surf_lsm_h%i(m) 5387 j = surf_lsm_h%j(m) 5388 qsws_liq_av(j,i) = qsws_liq_av(j,i) + & 5389 surf_lsm_h%qsws_liq(m) 5390 ENDDO 5391 ENDIF 5374 5392 5375 5393 CASE ( 'qsws_soil*' ) 5376 DO m = 1, surf_lsm_h%ns 5377 i = surf_lsm_h%i(m) 5378 j = surf_lsm_h%j(m) 5379 qsws_soil_av(j,i) = qsws_soil_av(j,i) + & 5380 surf_lsm_h%qsws_soil(m) 5381 ENDDO 5394 IF ( ALLOCATED( qsws_soil_av ) ) THEN 5395 DO m = 1, surf_lsm_h%ns 5396 i = surf_lsm_h%i(m) 5397 j = surf_lsm_h%j(m) 5398 qsws_soil_av(j,i) = qsws_soil_av(j,i) + & 5399 surf_lsm_h%qsws_soil(m) 5400 ENDDO 5401 ENDIF 5382 5402 5383 5403 CASE ( 'qsws_veg*' ) 5384 DO m = 1, surf_lsm_h%ns 5385 i = surf_lsm_h%i(m) 5386 j = surf_lsm_h%j(m) 5387 qsws_veg_av(j,i) = qsws_veg_av(j,i) + & 5388 surf_lsm_h%qsws_veg(m) 5389 ENDDO 5404 IF ( ALLOCATED(qsws_veg_av ) ) THEN 5405 DO m = 1, surf_lsm_h%ns 5406 i = surf_lsm_h%i(m) 5407 j = surf_lsm_h%j(m) 5408 qsws_veg_av(j,i) = qsws_veg_av(j,i) + & 5409 surf_lsm_h%qsws_veg(m) 5410 ENDDO 5411 ENDIF 5390 5412 5391 5413 CASE ( 'r_s*' ) 5392 DO m = 1, surf_lsm_h%ns 5393 i = surf_lsm_h%i(m) 5394 j = surf_lsm_h%j(m) 5395 r_s_av(j,i) = r_s_av(j,i) + surf_lsm_h%r_s(m) 5396 ENDDO 5414 IF ( ALLOCATED( r_s_av) ) THEN 5415 DO m = 1, surf_lsm_h%ns 5416 i = surf_lsm_h%i(m) 5417 j = surf_lsm_h%j(m) 5418 r_s_av(j,i) = r_s_av(j,i) + surf_lsm_h%r_s(m) 5419 ENDDO 5420 ENDIF 5397 5421 5398 5422 CASE ( 't_soil' ) 5399 DO m = 1, surf_lsm_h%ns 5400 i = surf_lsm_h%i(m) 5401 j = surf_lsm_h%j(m) 5402 DO k = nzb_soil, nzt_soil 5403 t_soil_av(k,j,i) = t_soil_av(k,j,i) + t_soil_h%var_2d(k,m) 5423 IF ( ALLOCATED( t_soil_av ) ) THEN 5424 DO m = 1, surf_lsm_h%ns 5425 i = surf_lsm_h%i(m) 5426 j = surf_lsm_h%j(m) 5427 DO k = nzb_soil, nzt_soil 5428 t_soil_av(k,j,i) = t_soil_av(k,j,i) + t_soil_h%var_2d(k,m) 5429 ENDDO 5404 5430 ENDDO 5405 END DO5431 ENDIF 5406 5432 5407 5433 CASE DEFAULT … … 5415 5441 5416 5442 CASE ( 'c_liq*' ) 5417 DO i = nxl, nxr 5418 DO j = nys, nyn 5419 c_liq_av(j,i) = c_liq_av(j,i) & 5420 / REAL( average_count_3d, KIND=wp ) 5443 IF ( ALLOCATED( c_liq_av ) ) THEN 5444 DO i = nxl, nxr 5445 DO j = nys, nyn 5446 c_liq_av(j,i) = c_liq_av(j,i) & 5447 / REAL( average_count_3d, KIND=wp ) 5448 ENDDO 5421 5449 ENDDO 5422 END DO5450 ENDIF 5423 5451 5424 5452 CASE ( 'c_soil*' ) 5425 DO i = nxl, nxr 5426 DO j = nys, nyn 5427 c_soil_av(j,i) = c_soil_av(j,i) & 5453 IF ( ALLOCATED( c_soil_av ) ) THEN 5454 DO i = nxl, nxr 5455 DO j = nys, nyn 5456 c_soil_av(j,i) = c_soil_av(j,i) & 5457 / REAL( average_count_3d, KIND=wp ) 5458 ENDDO 5459 ENDDO 5460 ENDIF 5461 5462 CASE ( 'c_veg*' ) 5463 IF ( ALLOCATED( c_veg_av ) ) THEN 5464 DO i = nxl, nxr 5465 DO j = nys, nyn 5466 c_veg_av(j,i) = c_veg_av(j,i) & 5467 / REAL( average_count_3d, KIND=wp ) 5468 ENDDO 5469 ENDDO 5470 ENDIF 5471 5472 CASE ( 'lai*' ) 5473 IF ( ALLOCATED( lai_av ) ) THEN 5474 DO i = nxl, nxr 5475 DO j = nys, nyn 5476 lai_av(j,i) = lai_av(j,i) & 5428 5477 / REAL( average_count_3d, KIND=wp ) 5478 ENDDO 5429 5479 ENDDO 5430 ENDDO 5431 5432 CASE ( 'c_veg*' ) 5433 DO i = nxl, nxr 5434 DO j = nys, nyn 5435 c_veg_av(j,i) = c_veg_av(j,i) & 5436 / REAL( average_count_3d, KIND=wp ) 5480 ENDIF 5481 5482 CASE ( 'm_liq*' ) 5483 IF ( ALLOCATED( m_liq_av ) ) THEN 5484 DO i = nxl, nxr 5485 DO j = nys, nyn 5486 m_liq_av(j,i) = m_liq_av(j,i) & 5487 / REAL( average_count_3d, KIND=wp ) 5488 ENDDO 5437 5489 ENDDO 5438 ENDDO 5439 5440 CASE ( 'lai*' ) 5441 DO i = nxl, nxr 5442 DO j = nys, nyn 5443 lai_av(j,i) = lai_av(j,i) & 5444 / REAL( average_count_3d, KIND=wp ) 5490 ENDIF 5491 5492 CASE ( 'm_soil' ) 5493 IF ( ALLOCATED( m_soil_av ) ) THEN 5494 DO i = nxl, nxr 5495 DO j = nys, nyn 5496 DO k = nzb_soil, nzt_soil 5497 m_soil_av(k,j,i) = m_soil_av(k,j,i) & 5498 / REAL( average_count_3d, KIND=wp ) 5499 ENDDO 5500 ENDDO 5445 5501 ENDDO 5446 ENDDO 5447 5448 CASE ( 'm_liq*' ) 5449 DO i = nxl, nxr 5450 DO j = nys, nyn 5451 m_liq_av(j,i) = m_liq_av(j,i) & 5452 / REAL( average_count_3d, KIND=wp ) 5453 ENDDO 5454 ENDDO 5455 5456 CASE ( 'm_soil' ) 5457 DO i = nxl, nxr 5458 DO j = nys, nyn 5459 DO k = nzb_soil, nzt_soil 5460 m_soil_av(k,j,i) = m_soil_av(k,j,i) & 5502 ENDIF 5503 5504 CASE ( 'qsws_liq*' ) 5505 IF ( ALLOCATED( qsws_liq_av ) ) THEN 5506 DO i = nxl, nxr 5507 DO j = nys, nyn 5508 qsws_liq_av(j,i) = qsws_liq_av(j,i) & 5461 5509 / REAL( average_count_3d, KIND=wp ) 5462 5510 ENDDO 5463 5511 ENDDO 5464 ENDDO 5465 5466 CASE ( 'qsws_liq*' ) 5467 DO i = nxl, nxr 5468 DO j = nys, nyn 5469 qsws_liq_av(j,i) = qsws_liq_av(j,i) & 5470 / REAL( average_count_3d, KIND=wp ) 5512 ENDIF 5513 5514 CASE ( 'qsws_soil*' ) 5515 IF ( ALLOCATED( qsws_soil_av ) ) THEN 5516 DO i = nxl, nxr 5517 DO j = nys, nyn 5518 qsws_soil_av(j,i) = qsws_soil_av(j,i) & 5519 / REAL( average_count_3d, KIND=wp ) 5520 ENDDO 5471 5521 ENDDO 5472 ENDDO 5473 5474 CASE ( 'qsws_soil*' ) 5475 DO i = nxl, nxr 5476 DO j = nys, nyn 5477 qsws_soil_av(j,i) = qsws_soil_av(j,i) & 5478 / REAL( average_count_3d, KIND=wp ) 5479 ENDDO 5480 ENDDO 5522 ENDIF 5481 5523 5482 5524 CASE ( 'qsws_veg*' ) 5483 DO i = nxl, nxr 5484 DO j = nys, nyn 5485 qsws_veg_av(j,i) = qsws_veg_av(j,i) & 5486 / REAL( average_count_3d, KIND=wp ) 5487 ENDDO 5488 ENDDO 5489 5490 CASE ( 'r_s*' ) 5491 DO i = nxl, nxr 5492 DO j = nys, nyn 5493 r_s_av(j,i) = r_s_av(j,i) / REAL( average_count_3d, KIND=wp ) 5494 ENDDO 5495 ENDDO 5496 5497 CASE ( 't_soil' ) 5498 DO i = nxl, nxr 5499 DO j = nys, nyn 5500 DO k = nzb_soil, nzt_soil 5501 t_soil_av(k,j,i) = t_soil_av(k,j,i) & 5525 IF ( ALLOCATED( qsws_veg_av ) ) THEN 5526 DO i = nxl, nxr 5527 DO j = nys, nyn 5528 qsws_veg_av(j,i) = qsws_veg_av(j,i) & 5502 5529 / REAL( average_count_3d, KIND=wp ) 5503 5530 ENDDO 5504 5531 ENDDO 5505 ENDDO 5506 5532 ENDIF 5533 5534 CASE ( 'r_s*' ) 5535 IF ( ALLOCATED( r_s_av ) ) THEN 5536 DO i = nxl, nxr 5537 DO j = nys, nyn 5538 r_s_av(j,i) = r_s_av(j,i) & 5539 / REAL( average_count_3d, KIND=wp ) 5540 ENDDO 5541 ENDDO 5542 ENDIF 5543 5544 CASE ( 't_soil' ) 5545 IF ( ALLOCATED( t_soil_av ) ) THEN 5546 DO i = nxl, nxr 5547 DO j = nys, nyn 5548 DO k = nzb_soil, nzt_soil 5549 t_soil_av(k,j,i) = t_soil_av(k,j,i) & 5550 / REAL( average_count_3d, KIND=wp ) 5551 ENDDO 5552 ENDDO 5553 ENDDO 5554 ENDIF 5507 5555 ! 5508 5556 !-- … … 5581 5629 LOGICAL :: found !< 5582 5630 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 5631 5632 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 5583 5633 5584 5634 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) :: local_pf !< … … 5599 5649 ENDDO 5600 5650 ELSE 5651 IF ( .NOT. ALLOCATED( c_liq_av ) ) THEN 5652 ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) ) 5653 c_liq_av = REAL( fill_value, KIND = wp ) 5654 ENDIF 5601 5655 DO i = nxl, nxr 5602 5656 DO j = nys, nyn … … 5617 5671 ENDDO 5618 5672 ELSE 5673 IF ( .NOT. ALLOCATED( c_soil_av ) ) THEN 5674 ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) ) 5675 c_soil_av = REAL( fill_value, KIND = wp ) 5676 ENDIF 5619 5677 DO i = nxl, nxr 5620 5678 DO j = nys, nyn … … 5635 5693 ENDDO 5636 5694 ELSE 5695 IF ( .NOT. ALLOCATED( c_veg_av ) ) THEN 5696 ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) ) 5697 c_veg_av = REAL( fill_value, KIND = wp ) 5698 ENDIF 5637 5699 DO i = nxl, nxr 5638 5700 DO j = nys, nyn … … 5653 5715 ENDDO 5654 5716 ELSE 5717 IF ( .NOT. ALLOCATED( lai_av ) ) THEN 5718 ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) ) 5719 lai_av = REAL( fill_value, KIND = wp ) 5720 ENDIF 5655 5721 DO i = nxl, nxr 5656 5722 DO j = nys, nyn … … 5671 5737 ENDDO 5672 5738 ELSE 5739 IF ( .NOT. ALLOCATED( m_liq_av ) ) THEN 5740 ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) ) 5741 m_liq_av = REAL( fill_value, KIND = wp ) 5742 ENDIF 5673 5743 DO i = nxl, nxr 5674 5744 DO j = nys, nyn … … 5691 5761 ENDDO 5692 5762 ELSE 5763 IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN 5764 ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 5765 m_soil_av = REAL( fill_value, KIND = wp ) 5766 ENDIF 5693 5767 DO i = nxl, nxr 5694 5768 DO j = nys, nyn … … 5713 5787 ENDDO 5714 5788 ELSE 5789 IF ( .NOT. ALLOCATED( qsws_liq_av ) ) THEN 5790 ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) ) 5791 qsws_liq_av = REAL( fill_value, KIND = wp ) 5792 ENDIF 5715 5793 DO i = nxl, nxr 5716 5794 DO j = nys, nyn … … 5731 5809 ENDDO 5732 5810 ELSE 5811 IF ( .NOT. ALLOCATED( qsws_soil_av ) ) THEN 5812 ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) ) 5813 qsws_soil_av = REAL( fill_value, KIND = wp ) 5814 ENDIF 5733 5815 DO i = nxl, nxr 5734 5816 DO j = nys, nyn … … 5749 5831 ENDDO 5750 5832 ELSE 5833 IF ( .NOT. ALLOCATED( qsws_veg_av ) ) THEN 5834 ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) ) 5835 qsws_veg_av = REAL( fill_value, KIND = wp ) 5836 ENDIF 5751 5837 DO i = nxl, nxr 5752 5838 DO j = nys, nyn … … 5768 5854 ENDDO 5769 5855 ELSE 5856 IF ( .NOT. ALLOCATED( r_s_av ) ) THEN 5857 ALLOCATE( r_s_av(nysg:nyng,nxlg:nxrg) ) 5858 r_s_av = REAL( fill_value, KIND = wp ) 5859 ENDIF 5770 5860 DO i = nxl, nxr 5771 5861 DO j = nys, nyn … … 5788 5878 ENDDO 5789 5879 ELSE 5880 IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN 5881 ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 5882 t_soil_av = REAL( fill_value, KIND = wp ) 5883 ENDIF 5790 5884 DO i = nxl, nxr 5791 5885 DO j = nys, nyn … … 5834 5928 5835 5929 LOGICAL :: found !< 5930 5931 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 5836 5932 5837 5933 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_soil:nzt_soil) :: local_pf !< … … 5856 5952 ENDDO 5857 5953 ELSE 5954 IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN 5955 ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 5956 m_soil_av = REAL( fill_value, KIND = wp ) 5957 ENDIF 5858 5958 DO i = nxl, nxr 5859 5959 DO j = nys, nyn … … 5876 5976 ENDDO 5877 5977 ELSE 5978 IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN 5979 ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 5980 t_soil_av = REAL( fill_value, KIND = wp ) 5981 ENDIF 5878 5982 DO i = nxl, nxr 5879 5983 DO j = nys, nyn
Note: See TracChangeset
for help on using the changeset viewer.