Changeset 3116 for palm/trunk/SOURCE
- Timestamp:
- Jul 10, 2018 2:31:58 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r3107 r3116 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Output of long/shortwave radiation at surface 31 ! 32 ! 3107 2018-07-06 15:55:51Z suehring 30 33 ! Bugfix, missing index for dz 31 34 ! … … 521 524 sun_dir_lon !< solar directional vector in longitudes 522 525 523 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rad_net_av !< average of rad_net 526 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rad_net_av !< average of net radiation (rad_net) at surface 527 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rad_lw_in_xy_av !< average of incoming longwave radiation at surface 528 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rad_lw_out_xy_av !< average of outgoing longwave radiation at surface 529 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rad_sw_in_xy_av !< average of incoming shortwave radiation at surface 530 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rad_sw_out_xy_av !< average of outgoing shortwave radiation at surface 524 531 ! 525 532 !-- Land surface albedos for solar zenith angle of 60° after Briegleb (1992) … … 1089 1096 1090 1097 CASE ( 'rad_net*', 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*', & 1091 'rrtm_asdir*' ) 1098 'rrtm_asdir*', 'rad_lw_in*', 'rad_lw_out*', 'rad_sw_in*', & 1099 'rad_sw_out*') 1092 1100 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 1093 1101 message_string = 'illegal value for data_output: "' // & … … 1110 1118 1111 1119 IF ( TRIM( var ) == 'rad_net*' ) unit = 'W/m2' 1120 IF ( TRIM( var ) == 'rad_lw_in*' ) unit = 'W/m2' 1121 IF ( TRIM( var ) == 'rad_lw_out*' ) unit = 'W/m2' 1122 IF ( TRIM( var ) == 'rad_sw_in*' ) unit = 'W/m2' 1123 IF ( TRIM( var ) == 'rad_sw_out*' ) unit = 'W/m2' 1112 1124 IF ( TRIM( var ) == 'rrtm_aldif*' ) unit = '' 1113 1125 IF ( TRIM( var ) == 'rrtm_aldir*' ) unit = '' … … 7362 7374 ENDIF 7363 7375 rad_net_av = 0.0_wp 7376 7377 CASE ( 'rad_lw_in*' ) 7378 IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) ) THEN 7379 ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) ) 7380 ENDIF 7381 rad_lw_in_xy_av = 0.0_wp 7382 7383 CASE ( 'rad_lw_out*' ) 7384 IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) ) THEN 7385 ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) ) 7386 ENDIF 7387 rad_lw_out_xy_av = 0.0_wp 7388 7389 CASE ( 'rad_sw_in*' ) 7390 IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) ) THEN 7391 ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) ) 7392 ENDIF 7393 rad_sw_in_xy_av = 0.0_wp 7394 7395 CASE ( 'rad_sw_out*' ) 7396 IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) ) THEN 7397 ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) ) 7398 ENDIF 7399 rad_sw_out_xy_av = 0.0_wp 7364 7400 7365 7401 CASE ( 'rad_lw_in' ) … … 7424 7460 DO i = nxl, nxr 7425 7461 DO j = nys, nyn 7426 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 7427 rad_net_av(j,i) = rad_net_av(j,i) + surf_lsm_h%rad_net(m) 7462 DO m = surf_lsm_h%start_index(j,i), & 7463 surf_lsm_h%end_index(j,i) 7464 rad_net_av(j,i) = rad_net_av(j,i) + & 7465 surf_lsm_h%rad_net(m) 7428 7466 ENDDO 7429 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 7430 rad_net_av(j,i) = rad_net_av(j,i) + surf_usm_h%rad_net(m) 7467 DO m = surf_usm_h%start_index(j,i), & 7468 surf_usm_h%end_index(j,i) 7469 rad_net_av(j,i) = rad_net_av(j,i) + & 7470 surf_usm_h%rad_net(m) 7431 7471 ENDDO 7432 7472 ENDDO … … 7434 7474 ENDIF 7435 7475 7476 CASE ( 'rad_lw_in*' ) 7477 IF ( ALLOCATED( rad_lw_in_xy_av ) ) THEN 7478 DO i = nxl, nxr 7479 DO j = nys, nyn 7480 DO m = surf_lsm_h%start_index(j,i), & 7481 surf_lsm_h%end_index(j,i) 7482 rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) + & 7483 surf_lsm_h%rad_lw_in(m) 7484 ENDDO 7485 DO m = surf_usm_h%start_index(j,i), & 7486 surf_usm_h%end_index(j,i) 7487 rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) + & 7488 surf_usm_h%rad_lw_in(m) 7489 ENDDO 7490 ENDDO 7491 ENDDO 7492 ENDIF 7493 7494 CASE ( 'rad_lw_out*' ) 7495 IF ( ALLOCATED( rad_lw_out_xy_av ) ) THEN 7496 DO i = nxl, nxr 7497 DO j = nys, nyn 7498 DO m = surf_lsm_h%start_index(j,i), & 7499 surf_lsm_h%end_index(j,i) 7500 rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) + & 7501 surf_lsm_h%rad_lw_out(m) 7502 ENDDO 7503 DO m = surf_usm_h%start_index(j,i), & 7504 surf_usm_h%end_index(j,i) 7505 rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) + & 7506 surf_usm_h%rad_lw_out(m) 7507 ENDDO 7508 ENDDO 7509 ENDDO 7510 ENDIF 7511 7512 CASE ( 'rad_sw_in*' ) 7513 IF ( ALLOCATED( rad_sw_in_xy_av ) ) THEN 7514 DO i = nxl, nxr 7515 DO j = nys, nyn 7516 DO m = surf_lsm_h%start_index(j,i), & 7517 surf_lsm_h%end_index(j,i) 7518 rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) + & 7519 surf_lsm_h%rad_sw_in(m) 7520 ENDDO 7521 DO m = surf_usm_h%start_index(j,i), & 7522 surf_usm_h%end_index(j,i) 7523 rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) + & 7524 surf_usm_h%rad_sw_in(m) 7525 ENDDO 7526 ENDDO 7527 ENDDO 7528 ENDIF 7529 7530 CASE ( 'rad_sw_out*' ) 7531 IF ( ALLOCATED( rad_sw_out_xy_av ) ) THEN 7532 DO i = nxl, nxr 7533 DO j = nys, nyn 7534 DO m = surf_lsm_h%start_index(j,i), & 7535 surf_lsm_h%end_index(j,i) 7536 rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) + & 7537 surf_lsm_h%rad_sw_out(m) 7538 ENDDO 7539 DO m = surf_usm_h%start_index(j,i), & 7540 surf_usm_h%end_index(j,i) 7541 rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) + & 7542 surf_usm_h%rad_sw_out(m) 7543 ENDDO 7544 ENDDO 7545 ENDDO 7546 ENDIF 7547 7436 7548 CASE ( 'rad_lw_in' ) 7437 7549 IF ( ALLOCATED( rad_lw_in_av ) ) THEN … … 7548 7660 ENDDO 7549 7661 ENDIF 7662 7663 CASE ( 'rad_lw_in*' ) 7664 IF ( ALLOCATED( rad_lw_in_xy_av ) ) THEN 7665 DO i = nxlg, nxrg 7666 DO j = nysg, nyng 7667 rad_lw_in_xy_av(j,i) = rad_lw_in_xy_av(j,i) & 7668 / REAL( average_count_3d, KIND=wp ) 7669 ENDDO 7670 ENDDO 7671 ENDIF 7672 7673 CASE ( 'rad_lw_out*' ) 7674 IF ( ALLOCATED( rad_lw_out_xy_av ) ) THEN 7675 DO i = nxlg, nxrg 7676 DO j = nysg, nyng 7677 rad_lw_out_xy_av(j,i) = rad_lw_out_xy_av(j,i) & 7678 / REAL( average_count_3d, KIND=wp ) 7679 ENDDO 7680 ENDDO 7681 ENDIF 7682 7683 CASE ( 'rad_sw_in*' ) 7684 IF ( ALLOCATED( rad_sw_in_xy_av ) ) THEN 7685 DO i = nxlg, nxrg 7686 DO j = nysg, nyng 7687 rad_sw_in_xy_av(j,i) = rad_sw_in_xy_av(j,i) & 7688 / REAL( average_count_3d, KIND=wp ) 7689 ENDDO 7690 ENDDO 7691 ENDIF 7692 7693 CASE ( 'rad_sw_out*' ) 7694 IF ( ALLOCATED( rad_sw_out_xy_av ) ) THEN 7695 DO i = nxlg, nxrg 7696 DO j = nysg, nyng 7697 rad_sw_out_xy_av(j,i) = rad_sw_out_xy_av(j,i) & 7698 / REAL( average_count_3d, KIND=wp ) 7699 ENDDO 7700 ENDDO 7701 ENDIF 7550 7702 7551 7703 CASE ( 'rad_lw_in' ) … … 7763 7915 ENDDO 7764 7916 ELSE 7765 IF ( .NOT. ALLOCATED( rad_net_av ) ) THEN7766 ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) )7767 rad_net_av = REAL( fill_value, KIND = wp )7768 ENDIF7917 IF ( .NOT. ALLOCATED( rad_net_av ) ) THEN 7918 ALLOCATE( rad_net_av(nysg:nyng,nxlg:nxrg) ) 7919 rad_net_av = REAL( fill_value, KIND = wp ) 7920 ENDIF 7769 7921 DO i = nxl, nxr 7770 7922 DO j = nys, nyn … … 7775 7927 two_d = .TRUE. 7776 7928 grid = 'zu1' 7777 7778 7929 7930 CASE ( 'rad_lw_in*_xy' ) ! 2d-array 7931 IF ( av == 0 ) THEN 7932 DO i = nxl, nxr 7933 DO j = nys, nyn 7934 ! 7935 !-- Obtain rad_net from its respective surface type 7936 !-- Natural-type surfaces 7937 DO m = surf_lsm_h%start_index(j,i), & 7938 surf_lsm_h%end_index(j,i) 7939 local_pf(i,j,nzb+1) = surf_lsm_h%rad_lw_in(m) 7940 ENDDO 7941 ! 7942 !-- Urban-type surfaces 7943 DO m = surf_usm_h%start_index(j,i), & 7944 surf_usm_h%end_index(j,i) 7945 local_pf(i,j,nzb+1) = surf_usm_h%rad_lw_in(m) 7946 ENDDO 7947 ENDDO 7948 ENDDO 7949 ELSE 7950 IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) ) THEN 7951 ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) ) 7952 rad_lw_in_xy_av = REAL( fill_value, KIND = wp ) 7953 ENDIF 7954 DO i = nxl, nxr 7955 DO j = nys, nyn 7956 local_pf(i,j,nzb+1) = rad_lw_in_xy_av(j,i) 7957 ENDDO 7958 ENDDO 7959 ENDIF 7960 two_d = .TRUE. 7961 grid = 'zu1' 7962 7963 CASE ( 'rad_lw_out*_xy' ) ! 2d-array 7964 IF ( av == 0 ) THEN 7965 DO i = nxl, nxr 7966 DO j = nys, nyn 7967 ! 7968 !-- Obtain rad_net from its respective surface type 7969 !-- Natural-type surfaces 7970 DO m = surf_lsm_h%start_index(j,i), & 7971 surf_lsm_h%end_index(j,i) 7972 local_pf(i,j,nzb+1) = surf_lsm_h%rad_lw_out(m) 7973 ENDDO 7974 ! 7975 !-- Urban-type surfaces 7976 DO m = surf_usm_h%start_index(j,i), & 7977 surf_usm_h%end_index(j,i) 7978 local_pf(i,j,nzb+1) = surf_usm_h%rad_lw_out(m) 7979 ENDDO 7980 ENDDO 7981 ENDDO 7982 ELSE 7983 IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) ) THEN 7984 ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) ) 7985 rad_lw_out_xy_av = REAL( fill_value, KIND = wp ) 7986 ENDIF 7987 DO i = nxl, nxr 7988 DO j = nys, nyn 7989 local_pf(i,j,nzb+1) = rad_lw_out_xy_av(j,i) 7990 ENDDO 7991 ENDDO 7992 ENDIF 7993 two_d = .TRUE. 7994 grid = 'zu1' 7995 7996 CASE ( 'rad_sw_in*_xy' ) ! 2d-array 7997 IF ( av == 0 ) THEN 7998 DO i = nxl, nxr 7999 DO j = nys, nyn 8000 ! 8001 !-- Obtain rad_net from its respective surface type 8002 !-- Natural-type surfaces 8003 DO m = surf_lsm_h%start_index(j,i), & 8004 surf_lsm_h%end_index(j,i) 8005 local_pf(i,j,nzb+1) = surf_lsm_h%rad_sw_in(m) 8006 ENDDO 8007 ! 8008 !-- Urban-type surfaces 8009 DO m = surf_usm_h%start_index(j,i), & 8010 surf_usm_h%end_index(j,i) 8011 local_pf(i,j,nzb+1) = surf_usm_h%rad_sw_in(m) 8012 ENDDO 8013 ENDDO 8014 ENDDO 8015 ELSE 8016 IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) ) THEN 8017 ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) ) 8018 rad_sw_in_xy_av = REAL( fill_value, KIND = wp ) 8019 ENDIF 8020 DO i = nxl, nxr 8021 DO j = nys, nyn 8022 local_pf(i,j,nzb+1) = rad_sw_in_xy_av(j,i) 8023 ENDDO 8024 ENDDO 8025 ENDIF 8026 two_d = .TRUE. 8027 grid = 'zu1' 8028 8029 CASE ( 'rad_sw_out*_xy' ) ! 2d-array 8030 IF ( av == 0 ) THEN 8031 DO i = nxl, nxr 8032 DO j = nys, nyn 8033 ! 8034 !-- Obtain rad_net from its respective surface type 8035 !-- Natural-type surfaces 8036 DO m = surf_lsm_h%start_index(j,i), & 8037 surf_lsm_h%end_index(j,i) 8038 local_pf(i,j,nzb+1) = surf_lsm_h%rad_sw_out(m) 8039 ENDDO 8040 ! 8041 !-- Urban-type surfaces 8042 DO m = surf_usm_h%start_index(j,i), & 8043 surf_usm_h%end_index(j,i) 8044 local_pf(i,j,nzb+1) = surf_usm_h%rad_sw_out(m) 8045 ENDDO 8046 ENDDO 8047 ENDDO 8048 ELSE 8049 IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) ) THEN 8050 ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) ) 8051 rad_sw_out_xy_av = REAL( fill_value, KIND = wp ) 8052 ENDIF 8053 DO i = nxl, nxr 8054 DO j = nys, nyn 8055 local_pf(i,j,nzb+1) = rad_sw_out_xy_av(j,i) 8056 ENDDO 8057 ENDDO 8058 ENDIF 8059 two_d = .TRUE. 8060 grid = 'zu1' 8061 7779 8062 CASE ( 'rad_lw_in_xy', 'rad_lw_in_xz', 'rad_lw_in_yz' ) 7780 8063 IF ( av == 0 ) THEN … … 8435 8718 WRITE ( 14 ) rad_net_av 8436 8719 ENDIF 8720 8721 IF ( ALLOCATED( rad_lw_in_xy_av ) ) THEN 8722 CALL wrd_write_string( 'rad_lw_in_xy_av' ) 8723 WRITE ( 14 ) rad_lw_in_xy_av 8724 ENDIF 8725 8726 IF ( ALLOCATED( rad_lw_out_xy_av ) ) THEN 8727 CALL wrd_write_string( 'rad_lw_out_xy_av' ) 8728 WRITE ( 14 ) rad_lw_out_xy_av 8729 ENDIF 8730 8731 IF ( ALLOCATED( rad_sw_in_xy_av ) ) THEN 8732 CALL wrd_write_string( 'rad_sw_in_xy_av' ) 8733 WRITE ( 14 ) rad_sw_in_xy_av 8734 ENDIF 8735 8736 IF ( ALLOCATED( rad_sw_out_xy_av ) ) THEN 8737 CALL wrd_write_string( 'rad_sw_out_xy_av' ) 8738 WRITE ( 14 ) rad_sw_out_xy_av 8739 ENDIF 8437 8740 8438 8741 IF ( ALLOCATED( rad_lw_in ) ) THEN … … 8576 8879 rad_net_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 8577 8880 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 8881 8882 CASE ( 'rad_lw_in_xy_av' ) 8883 IF ( .NOT. ALLOCATED( rad_lw_in_xy_av ) ) THEN 8884 ALLOCATE( rad_lw_in_xy_av(nysg:nyng,nxlg:nxrg) ) 8885 ENDIF 8886 IF ( k == 1 ) READ ( 13 ) tmp_2d 8887 rad_lw_in_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 8888 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 8889 8890 CASE ( 'rad_lw_out_xy_av' ) 8891 IF ( .NOT. ALLOCATED( rad_lw_out_xy_av ) ) THEN 8892 ALLOCATE( rad_lw_out_xy_av(nysg:nyng,nxlg:nxrg) ) 8893 ENDIF 8894 IF ( k == 1 ) READ ( 13 ) tmp_2d 8895 rad_lw_out_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 8896 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 8897 8898 CASE ( 'rad_sw_in_xy_av' ) 8899 IF ( .NOT. ALLOCATED( rad_sw_in_xy_av ) ) THEN 8900 ALLOCATE( rad_sw_in_xy_av(nysg:nyng,nxlg:nxrg) ) 8901 ENDIF 8902 IF ( k == 1 ) READ ( 13 ) tmp_2d 8903 rad_sw_in_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 8904 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 8905 8906 CASE ( 'rad_sw_out_xy_av' ) 8907 IF ( .NOT. ALLOCATED( rad_sw_out_xy_av ) ) THEN 8908 ALLOCATE( rad_sw_out_xy_av(nysg:nyng,nxlg:nxrg) ) 8909 ENDIF 8910 IF ( k == 1 ) READ ( 13 ) tmp_2d 8911 rad_sw_out_xy_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 8912 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 8913 8578 8914 CASE ( 'rad_lw_in' ) 8579 8915 IF ( .NOT. ALLOCATED( rad_lw_in ) ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
