Changeset 1826 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Apr 7, 2016 12:01:39 PM (8 years ago)
- File:
-
- 1 moved
-
palm/trunk/SOURCE/radiation_model_mod.f90 (moved) (moved from palm/trunk/SOURCE/radiation_model.f90) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r1818 r1826 1 !> @file radiation_model .f901 !> @file radiation_model_mod.f90 2 2 !--------------------------------------------------------------------------------! 3 3 ! This file is part of PALM. … … 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Further modularization. 22 22 ! 23 23 ! Former revisions: … … 80 80 ! ------------ 81 81 !> Radiation models and interfaces 82 !> @todo move variable definitions used in init_radiationonly to the subroutine82 !> @todo move variable definitions used in radiation_init only to the subroutine 83 83 !> as they are no longer required after initialization. 84 84 !> @todo Output of full column vertical profiles used in RRTMG … … 115 115 116 116 #if defined ( __rrtmg ) 117 118 ! USE netcdf_interface, &119 ! ONLY: nc_stat, netcdf_handle_error120 117 121 118 USE parrrsw, & … … 353 350 #endif 354 351 355 INTERFACE init_radiation 356 MODULE PROCEDURE init_radiation 357 END INTERFACE init_radiation 358 352 INTERFACE radiation_check_data_output 353 MODULE PROCEDURE radiation_check_data_output 354 END INTERFACE radiation_check_data_output 355 356 INTERFACE radiation_check_data_output_pr 357 MODULE PROCEDURE radiation_check_data_output_pr 358 END INTERFACE radiation_check_data_output_pr 359 360 INTERFACE radiation_check_parameters 361 MODULE PROCEDURE radiation_check_parameters 362 END INTERFACE radiation_check_parameters 363 359 364 INTERFACE radiation_clearsky 360 365 MODULE PROCEDURE radiation_clearsky 361 366 END INTERFACE radiation_clearsky 362 367 368 INTERFACE radiation_header 369 MODULE PROCEDURE radiation_header 370 END INTERFACE radiation_header 371 372 INTERFACE radiation_init 373 MODULE PROCEDURE radiation_init 374 END INTERFACE radiation_init 375 376 INTERFACE radiation_parin 377 MODULE PROCEDURE radiation_parin 378 END INTERFACE radiation_parin 379 363 380 INTERFACE radiation_rrtmg 364 381 MODULE PROCEDURE radiation_rrtmg … … 374 391 PRIVATE 375 392 376 PUBLIC albedo, albedo_type, albedo_type_name, albedo_lw_dif, albedo_lw_dir,& 377 albedo_sw_dif, albedo_sw_dir, constant_albedo, day_init, dots_rad, & 378 dt_radiation, emissivity, force_radiation_call, init_radiation, & 379 lambda, lw_radiation, net_radiation, rad_net, rad_net_av, radiation,& 380 radiation_clearsky, radiation_rrtmg, radiation_scheme, & 381 radiation_tendency, rad_lw_in, rad_lw_in_av, rad_lw_out, & 382 rad_lw_out_av, rad_lw_out_change_0, rad_lw_cs_hr, rad_lw_cs_hr_av, & 383 rad_lw_hr, rad_lw_hr_av, rad_sw_in, rad_sw_in_av, rad_sw_out, & 384 rad_sw_out_av, rad_sw_cs_hr, rad_sw_cs_hr_av, rad_sw_hr, & 385 rad_sw_hr_av, sigma_sb, skip_time_do_radiation, sw_radiation, & 386 time_radiation, time_utc_init, unscheduled_radiation_calls 393 ! 394 !-- Public functions 395 PUBLIC radiation_check_data_output, radiation_check_data_output_pr, & 396 radiation_check_parameters, radiation_clearsky, radiation_header, & 397 radiation_init, radiation_parin, radiation_rrtmg, radiation_tendency 398 399 ! 400 !-- Public variables and constants 401 PUBLIC dots_rad, dt_radiation, force_radiation_call, & 402 rad_net, rad_net_av, radiation, radiation_scheme, rad_lw_in, & 403 rad_lw_in_av, rad_lw_out, rad_lw_out_av, rad_lw_out_change_0, & 404 rad_lw_cs_hr, rad_lw_cs_hr_av, rad_lw_hr, rad_lw_hr_av, rad_sw_in, & 405 rad_sw_in_av, rad_sw_out, rad_sw_out_av, rad_sw_cs_hr, & 406 rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av, sigma_sb, & 407 skip_time_do_radiation, time_radiation, unscheduled_radiation_calls 387 408 388 409 … … 396 417 ! Description: 397 418 ! ------------ 419 !> Check data output for radiation model 420 !------------------------------------------------------------------------------! 421 SUBROUTINE radiation_check_data_output( var, unit, i, ilen, k ) 422 423 424 USE control_parameters, & 425 ONLY: data_output, message_string 426 427 IMPLICIT NONE 428 429 CHARACTER (LEN=*) :: unit !< 430 CHARACTER (LEN=*) :: var !< 431 432 INTEGER(iwp) :: i 433 INTEGER(iwp) :: ilen 434 INTEGER(iwp) :: k 435 436 SELECT CASE ( TRIM( var ) ) 437 438 CASE ( 'rad_lw_in', 'rad_lw_out', 'rad_lw_cs_hr', 'rad_lw_hr', & 439 'rad_sw_in', 'rad_sw_out', 'rad_sw_cs_hr', 'rad_sw_hr' ) 440 IF ( .NOT. radiation .OR. radiation_scheme /= 'rrtmg' ) THEN 441 message_string = '"output of "' // TRIM( var ) // '" requi' // & 442 'res radiation = .TRUE. and ' // & 443 'radiation_scheme = "rrtmg"' 444 CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 ) 445 ENDIF 446 unit = 'W/m2' 447 448 CASE ( 'rad_net*', 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*', & 449 'rrtm_asdir*' ) 450 IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN 451 message_string = 'illegal value for data_output: "' // & 452 TRIM( var ) // '" & only 2d-horizontal ' // & 453 'cross sections are allowed for this value' 454 CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 ) 455 ENDIF 456 IF ( .NOT. radiation .OR. radiation_scheme /= "rrtmg" ) THEN 457 IF ( TRIM( var ) == 'rrtm_aldif*' .OR. & 458 TRIM( var ) == 'rrtm_aldir*' .OR. & 459 TRIM( var ) == 'rrtm_asdif*' .OR. & 460 TRIM( var ) == 'rrtm_asdir*' ) & 461 THEN 462 message_string = 'output of "' // TRIM( var ) // '" require'& 463 // 's radiation = .TRUE. and radiation_sch'& 464 // 'eme = "rrtmg"' 465 CALL message( 'check_parameters', 'PA0409', 1, 2, 0, 6, 0 ) 466 ENDIF 467 ENDIF 468 469 IF ( TRIM( var ) == 'rad_net*' ) unit = 'W/m2' 470 IF ( TRIM( var ) == 'rrtm_aldif*' ) unit = '' 471 IF ( TRIM( var ) == 'rrtm_aldir*' ) unit = '' 472 IF ( TRIM( var ) == 'rrtm_asdif*' ) unit = '' 473 IF ( TRIM( var ) == 'rrtm_asdir*' ) unit = '' 474 475 CASE DEFAULT 476 unit = 'illegal' 477 478 END SELECT 479 480 481 END SUBROUTINE radiation_check_data_output 482 483 !------------------------------------------------------------------------------! 484 ! Description: 485 ! ------------ 486 !> Check data output of profiles for radiation model 487 !------------------------------------------------------------------------------! 488 SUBROUTINE radiation_check_data_output_pr( variable, var_count, unit, dopr_unit ) 489 490 USE arrays_3d, & 491 ONLY: zu 492 493 USE control_parameters, & 494 ONLY: data_output_pr, message_string 495 496 USE indices 497 498 USE profil_parameter 499 500 USE statistics 501 502 IMPLICIT NONE 503 504 CHARACTER (LEN=*) :: unit !< 505 CHARACTER (LEN=*) :: variable !< 506 CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit 507 508 INTEGER(iwp) :: user_pr_index !< 509 INTEGER(iwp) :: var_count !< 510 511 SELECT CASE ( TRIM( variable ) ) 512 513 CASE ( 'rad_net' ) 514 IF ( ( .NOT. radiation ) .OR. radiation_scheme == 'constant' )& 515 THEN 516 message_string = 'data_output_pr = ' // & 517 TRIM( data_output_pr(var_count) ) // ' is' // & 518 'not available for radiation = .FALSE. or ' //& 519 'radiation_scheme = "constant"' 520 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 ) 521 ELSE 522 dopr_index(var_count) = 101 523 dopr_unit = 'W/m2' 524 hom(:,2,101,:) = SPREAD( zw, 2, statistic_regions+1 ) 525 unit = dopr_unit 526 ENDIF 527 528 CASE ( 'rad_lw_in' ) 529 IF ( ( .NOT. radiation) .OR. radiation_scheme == 'constant' ) & 530 THEN 531 message_string = 'data_output_pr = ' // & 532 TRIM( data_output_pr(var_count) ) // ' is' // & 533 'not available for radiation = .FALSE. or ' //& 534 'radiation_scheme = "constant"' 535 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 ) 536 ELSE 537 dopr_index(var_count) = 102 538 dopr_unit = 'W/m2' 539 hom(:,2,102,:) = SPREAD( zw, 2, statistic_regions+1 ) 540 unit = dopr_unit 541 ENDIF 542 543 CASE ( 'rad_lw_out' ) 544 IF ( ( .NOT. radiation ) .OR. radiation_scheme == 'constant' ) & 545 THEN 546 message_string = 'data_output_pr = ' // & 547 TRIM( data_output_pr(var_count) ) // ' is' // & 548 'not available for radiation = .FALSE. or ' //& 549 'radiation_scheme = "constant"' 550 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 ) 551 ELSE 552 dopr_index(var_count) = 103 553 dopr_unit = 'W/m2' 554 hom(:,2,103,:) = SPREAD( zw, 2, statistic_regions+1 ) 555 unit = dopr_unit 556 ENDIF 557 558 CASE ( 'rad_sw_in' ) 559 IF ( ( .NOT. radiation ) .OR. radiation_scheme == 'constant' ) & 560 THEN 561 message_string = 'data_output_pr = ' // & 562 TRIM( data_output_pr(var_count) ) // ' is' // & 563 'not available for radiation = .FALSE. or ' //& 564 'radiation_scheme = "constant"' 565 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 ) 566 ELSE 567 dopr_index(var_count) = 104 568 dopr_unit = 'W/m2' 569 hom(:,2,104,:) = SPREAD( zw, 2, statistic_regions+1 ) 570 unit = dopr_unit 571 ENDIF 572 573 CASE ( 'rad_sw_out') 574 IF ( ( .NOT. radiation ) .OR. radiation_scheme == 'constant' )& 575 THEN 576 message_string = 'data_output_pr = ' // & 577 TRIM( data_output_pr(var_count) ) // ' is' // & 578 'not available for radiation = .FALSE. or ' //& 579 'radiation_scheme = "constant"' 580 CALL message( 'check_parameters', 'PA0408', 1, 2, 0, 6, 0 ) 581 ELSE 582 dopr_index(var_count) = 105 583 dopr_unit = 'W/m2' 584 hom(:,2,105,:) = SPREAD( zw, 2, statistic_regions+1 ) 585 unit = dopr_unit 586 ENDIF 587 588 CASE ( 'rad_lw_cs_hr' ) 589 IF ( ( .NOT. radiation ) .OR. radiation_scheme /= 'rrtmg' ) & 590 THEN 591 message_string = 'data_output_pr = ' // & 592 TRIM( data_output_pr(var_count) ) // ' is' // & 593 'not available for radiation = .FALSE. or ' //& 594 'radiation_scheme /= "rrtmg"' 595 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 ) 596 ELSE 597 dopr_index(var_count) = 106 598 dopr_unit = 'K/h' 599 hom(:,2,106,:) = SPREAD( zu, 2, statistic_regions+1 ) 600 unit = dopr_unit 601 ENDIF 602 603 CASE ( 'rad_lw_hr' ) 604 IF ( ( .NOT. radiation ) .OR. radiation_scheme /= 'rrtmg' ) & 605 THEN 606 message_string = 'data_output_pr = ' // & 607 TRIM( data_output_pr(var_count) ) // ' is' // & 608 'not available for radiation = .FALSE. or ' //& 609 'radiation_scheme /= "rrtmg"' 610 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 ) 611 ELSE 612 dopr_index(var_count) = 107 613 dopr_unit = 'K/h' 614 hom(:,2,107,:) = SPREAD( zu, 2, statistic_regions+1 ) 615 unit = dopr_unit 616 ENDIF 617 618 CASE ( 'rad_sw_cs_hr' ) 619 IF ( ( .NOT. radiation ) .OR. radiation_scheme /= 'rrtmg' ) & 620 THEN 621 message_string = 'data_output_pr = ' // & 622 TRIM( data_output_pr(var_count) ) // ' is' // & 623 'not available for radiation = .FALSE. or ' //& 624 'radiation_scheme /= "rrtmg"' 625 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 ) 626 ELSE 627 dopr_index(var_count) = 108 628 dopr_unit = 'K/h' 629 hom(:,2,108,:) = SPREAD( zu, 2, statistic_regions+1 ) 630 unit = dopr_unit 631 ENDIF 632 633 CASE ( 'rad_sw_hr' ) 634 IF ( ( .NOT. radiation ) .OR. radiation_scheme /= 'rrtmg' ) & 635 THEN 636 message_string = 'data_output_pr = ' // & 637 TRIM( data_output_pr(var_count) ) // ' is' // & 638 'not available for radiation = .FALSE. or ' //& 639 'radiation_scheme /= "rrtmg"' 640 CALL message( 'check_parameters', 'PA0413', 1, 2, 0, 6, 0 ) 641 ELSE 642 dopr_index(var_count) = 109 643 dopr_unit = 'K/h' 644 hom(:,2,109,:) = SPREAD( zu, 2, statistic_regions+1 ) 645 unit = dopr_unit 646 ENDIF 647 648 649 CASE DEFAULT 650 unit = 'illegal' 651 652 END SELECT 653 654 655 END SUBROUTINE radiation_check_data_output_pr 656 657 658 !------------------------------------------------------------------------------! 659 ! Description: 660 ! ------------ 661 !> Check parameters routine for radiation model 662 !------------------------------------------------------------------------------! 663 SUBROUTINE radiation_check_parameters 664 665 USE control_parameters, & 666 ONLY: message_string, topography 667 668 669 IMPLICIT NONE 670 671 IF ( radiation_scheme /= 'constant' .AND. & 672 radiation_scheme /= 'clear-sky' .AND. & 673 radiation_scheme /= 'rrtmg' ) THEN 674 message_string = 'unknown radiation_scheme = '// & 675 TRIM( radiation_scheme ) 676 CALL message( 'check_parameters', 'PA0405', 1, 2, 0, 6, 0 ) 677 ELSEIF ( radiation_scheme == 'rrtmg' ) THEN 678 #if ! defined ( __rrtmg ) 679 message_string = 'radiation_scheme = "rrtmg" requires ' // & 680 'compilation of PALM with pre-processor ' // & 681 'directive -D__rrtmg' 682 CALL message( 'check_parameters', 'PA0407', 1, 2, 0, 6, 0 ) 683 #endif 684 #if defined ( __rrtmg ) && ! defined( __netcdf ) 685 message_string = 'radiation_scheme = "rrtmg" requires ' // & 686 'the use of NetCDF (preprocessor directive ' // & 687 '-D__netcdf' 688 CALL message( 'check_parameters', 'PA0412', 1, 2, 0, 6, 0 ) 689 #endif 690 691 ENDIF 692 693 IF ( albedo_type == 0 .AND. albedo == 9999999.9_wp .AND. & 694 radiation_scheme == 'clear-sky') THEN 695 message_string = 'radiation_scheme = "clear-sky" in combination' // & 696 'with albedo_type = 0 requires setting of albedo'// & 697 ' /= 9999999.9' 698 CALL message( 'check_parameters', 'PA0410', 1, 2, 0, 6, 0 ) 699 ENDIF 700 701 IF ( albedo_type == 0 .AND. radiation_scheme == 'rrtmg' .AND. & 702 ( albedo_lw_dif == 9999999.9_wp .OR. albedo_lw_dir == 9999999.9_wp& 703 .OR. albedo_sw_dif == 9999999.9_wp .OR. albedo_sw_dir == 9999999.9_wp& 704 ) ) THEN 705 message_string = 'radiation_scheme = "rrtmg" in combination' // & 706 'with albedo_type = 0 requires setting of ' // & 707 'albedo_lw_dif /= 9999999.9' // & 708 'albedo_lw_dir /= 9999999.9' // & 709 'albedo_sw_dif /= 9999999.9 and' // & 710 'albedo_sw_dir /= 9999999.9' 711 CALL message( 'check_parameters', 'PA0411', 1, 2, 0, 6, 0 ) 712 ENDIF 713 714 IF ( topography /= 'flat' ) THEN 715 message_string = 'radiation scheme cannot be used ' // & 716 'in combination with topography /= "flat"' 717 CALL message( 'check_parameters', 'PA0414', 1, 2, 0, 6, 0 ) 718 ENDIF 719 720 END SUBROUTINE radiation_check_parameters 721 722 723 !------------------------------------------------------------------------------! 724 ! Description: 725 ! ------------ 398 726 !> Initialization of the radiation model 399 727 !------------------------------------------------------------------------------! 400 SUBROUTINE init_radiation728 SUBROUTINE radiation_init 401 729 402 730 IMPLICIT NONE … … 661 989 RETURN 662 990 663 END SUBROUTINE init_radiation991 END SUBROUTINE radiation_init 664 992 665 993 … … 719 1047 720 1048 END SUBROUTINE radiation_clearsky 1049 1050 1051 !------------------------------------------------------------------------------! 1052 ! Description: 1053 ! ------------ 1054 !> Header output for radiation model 1055 !------------------------------------------------------------------------------! 1056 SUBROUTINE radiation_header ( io ) 1057 1058 1059 IMPLICIT NONE 1060 1061 INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file 1062 1063 1064 1065 ! 1066 !-- Write radiation model header 1067 WRITE( io, 3 ) 1068 1069 IF ( radiation_scheme == "constant" ) THEN 1070 WRITE( io, 4 ) net_radiation 1071 ELSEIF ( radiation_scheme == "clear-sky" ) THEN 1072 WRITE( io, 5 ) 1073 ELSEIF ( radiation_scheme == "rrtmg" ) THEN 1074 WRITE( io, 6 ) 1075 IF ( .NOT. lw_radiation ) WRITE( io, 10 ) 1076 IF ( .NOT. sw_radiation ) WRITE( io, 11 ) 1077 ENDIF 1078 1079 IF ( albedo_type == 0 ) THEN 1080 WRITE( io, 7 ) albedo 1081 ELSE 1082 WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) ) 1083 ENDIF 1084 IF ( constant_albedo ) THEN 1085 WRITE( io, 9 ) 1086 ENDIF 1087 1088 IF ( radiation .AND. radiation_scheme /= 'constant' ) THEN 1089 WRITE ( io, 1 ) lambda 1090 WRITE ( io, 2 ) day_init, time_utc_init 1091 ENDIF 1092 1093 WRITE( io, 12 ) dt_radiation 1094 1095 1096 1 FORMAT (' Geograph. longitude : lambda = ',F4.1,' degr') 1097 2 FORMAT (' Day of the year at model start : day_init = ',I3 & 1098 /' UTC time at model start : time_utc_init = ',F7.1' s') 1099 3 FORMAT (//' Radiation model information:'/ & 1100 ' ----------------------------'/) 1101 4 FORMAT (' --> Using constant net radiation: net_radiation = ', F6.2, & 1102 // 'W/m**2') 1103 5 FORMAT (' --> Simple radiation scheme for clear sky is used (no clouds,', & 1104 ' default)') 1105 6 FORMAT (' --> RRTMG scheme is used') 1106 7 FORMAT (/' User-specific surface albedo: albedo =', F6.3) 1107 8 FORMAT (/' Albedo is set for land surface type: ', A) 1108 9 FORMAT (/' --> Albedo is fixed during the run') 1109 10 FORMAT (/' --> Longwave radiation is disabled') 1110 11 FORMAT (/' --> Shortwave radiation is disabled.') 1111 12 FORMAT (' Timestep: dt_radiation = ', F6.2, ' s') 1112 1113 1114 END SUBROUTINE radiation_header 1115 1116 1117 !------------------------------------------------------------------------------! 1118 ! Description: 1119 ! ------------ 1120 !> Parin for &radiation_par for radiation model 1121 !------------------------------------------------------------------------------! 1122 SUBROUTINE radiation_parin 1123 1124 1125 IMPLICIT NONE 1126 1127 CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file 1128 1129 NAMELIST /radiation_par/ albedo, albedo_type, albedo_lw_dir, & 1130 albedo_lw_dif, albedo_sw_dir, albedo_sw_dif, & 1131 constant_albedo, day_init, dt_radiation, & 1132 lambda, lw_radiation, net_radiation, & 1133 radiation_scheme, skip_time_do_radiation, & 1134 sw_radiation, time_utc_init, & 1135 unscheduled_radiation_calls 1136 1137 line = ' ' 1138 1139 ! 1140 !-- Try to find radiation model package 1141 REWIND ( 11 ) 1142 line = ' ' 1143 DO WHILE ( INDEX( line, '&radiation_par' ) == 0 ) 1144 READ ( 11, '(A)', END=10 ) line 1145 ENDDO 1146 BACKSPACE ( 11 ) 1147 1148 ! 1149 !-- Read user-defined namelist 1150 READ ( 11, radiation_par ) 1151 1152 ! 1153 !-- Set flag that indicates that the radiation model is switched on 1154 radiation = .TRUE. 1155 1156 10 CONTINUE 1157 1158 1159 END SUBROUTINE radiation_parin 721 1160 722 1161 … … 1608 2047 END SUBROUTINE read_trace_gas_data 1609 2048 2049 1610 2050 SUBROUTINE netcdf_handle_error_rad( routine_name, errno ) 1611 2051
Note: See TracChangeset
for help on using the changeset viewer.
