Ignore:
Timestamp:
Apr 7, 2016 12:01:39 PM (5 years ago)
Author:
maronga
Message:

further modularization of radiation model and plant canopy model

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/header.f90

    r1823 r1826  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Moved radiation model header output to the respective module.
     22! Moved canopy model header output to the respective module.
    2223!
    2324! Former revisions:
     
    289290
    290291    USE plant_canopy_model_mod,                                                &
    291         ONLY:  alpha_lad, beta_lad, calc_beta_lad_profile, canopy_drag_coeff,  &
    292                canopy_mode, cthf, lad, lad_surface, lad_vertical_gradient,     &
    293                lad_vertical_gradient_level, lad_vertical_gradient_level_ind,   &
    294                lai_beta, leaf_scalar_exch_coeff, leaf_surface_conc, pch_index, &
    295                plant_canopy
     292        ONLY:  pcm_header, plant_canopy
    296293
    297294    USE pmc_handle_communicator,                                               &
     
    302299
    303300    USE radiation_model_mod,                                                   &
    304         ONLY:  albedo, albedo_type, albedo_type_name, constant_albedo,         &
    305                day_init, dt_radiation, lambda, lw_radiation, net_radiation,    &
    306                radiation, radiation_scheme, sw_radiation, time_utc_init
     301        ONLY:  radiation, radiation_header
    307302   
    308303    USE spectrum,                                                              &
     
    339334    CHARACTER (LEN=70) ::  run_classification  !<
    340335   
    341     CHARACTER (LEN=85) ::  roben               !<
    342     CHARACTER (LEN=85) ::  runten              !<
     336    CHARACTER (LEN=85) ::  r_upper             !<
     337    CHARACTER (LEN=85) ::  r_lower             !<
    343338   
    344339    CHARACTER (LEN=86) ::  coordinates         !<
    345340    CHARACTER (LEN=86) ::  gradients           !<
    346     CHARACTER (LEN=86) ::  leaf_area_density   !<
    347     CHARACTER (LEN=86) ::  roots               !<
    348341    CHARACTER (LEN=86) ::  slices              !<
    349342    CHARACTER (LEN=86) ::  temperatures        !<
     
    383376    INTEGER(iwp) ::  npe_total      !<
    384377   
    385     REAL(wp) ::  canopy_height                    !< canopy height (in m)
     378
    386379    REAL(wp) ::  cpuseconds_per_simulated_second  !<
    387380    REAL(wp) ::  lower_left_coord_x               !< x-coordinate of nest domain
     
    903896    ENDIF
    904897
    905     IF ( plant_canopy )  THEN
    906    
    907        canopy_height = pch_index * dz
    908 
    909        WRITE ( io, 280 )  canopy_mode, canopy_height, pch_index,               &
    910                           canopy_drag_coeff
    911        IF ( passive_scalar )  THEN
    912           WRITE ( io, 281 )  leaf_scalar_exch_coeff,                           &
    913                              leaf_surface_conc
    914        ENDIF
    915 
    916 !
    917 !--    Heat flux at the top of vegetation
    918        WRITE ( io, 282 )  cthf
    919 
    920 !
    921 !--    Leaf area density profile, calculated either from given vertical
    922 !--    gradients or from beta probability density function.
    923        IF (  .NOT.  calc_beta_lad_profile )  THEN
    924 
    925 !--       Building output strings, starting with surface value
    926           WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
    927           gradients = '------'
    928           slices = '     0'
    929           coordinates = '   0.0'
    930           i = 1
    931           DO  WHILE ( i < 11  .AND.  lad_vertical_gradient_level_ind(i) /= -9999 )
    932 
    933              WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
    934              leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
    935  
    936              WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
    937              gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
    938 
    939              WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
    940              slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
    941 
    942              WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
    943              coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
    944 
    945              i = i + 1
    946           ENDDO
    947 
    948           WRITE ( io, 283 )  TRIM( coordinates ), TRIM( leaf_area_density ),              &
    949                              TRIM( gradients ), TRIM( slices )
    950 
    951        ELSE
    952        
    953           WRITE ( leaf_area_density, '(F7.4)' )  lad_surface
    954           coordinates = '   0.0'
    955          
    956           DO  k = 1, pch_index
    957 
    958              WRITE (coor_chr,'(F7.2)')  lad(k)
    959              leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
    960  
    961              WRITE (coor_chr,'(F7.1)')  zu(k)
    962              coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
    963 
    964           ENDDO       
    965 
    966           WRITE ( io, 284 ) TRIM( coordinates ), TRIM( leaf_area_density ), alpha_lad,    &
    967                             beta_lad, lai_beta
    968 
    969        ENDIF 
    970 
    971     ENDIF
     898    IF ( plant_canopy )  CALL pcm_header ( io )
    972899
    973900    IF ( land_surface )  CALL lsm_header ( io )
    974901
    975     IF ( radiation )  THEN
    976 !
    977 !--    Write radiation model header
    978        WRITE( io, 444 )
    979 
    980        IF ( radiation_scheme == "constant" )  THEN
    981           WRITE( io, 445 ) net_radiation
    982        ELSEIF ( radiation_scheme == "clear-sky" )  THEN
    983           WRITE( io, 446 )
    984        ELSEIF ( radiation_scheme == "rrtmg" )  THEN
    985           WRITE( io, 447 )
    986           IF ( .NOT. lw_radiation )  WRITE( io, 458 )
    987           IF ( .NOT. sw_radiation )  WRITE( io, 459 )
    988        ENDIF
    989 
    990        IF ( albedo_type == 0 )  THEN
    991           WRITE( io, 448 ) albedo
    992        ELSE
    993           WRITE( io, 456 ) TRIM( albedo_type_name(albedo_type) )
    994        ENDIF
    995        IF ( constant_albedo )  THEN
    996           WRITE( io, 457 )
    997        ENDIF
    998        WRITE( io, 449 ) dt_radiation
    999     ENDIF
    1000 
     902    IF ( radiation )  CALL radiation_header ( io )
    1001903
    1002904!
    1003905!-- Boundary conditions
    1004906    IF ( ibc_p_b == 0 )  THEN
    1005        runten = 'p(0)     = 0      |'
     907       r_lower = 'p(0)     = 0      |'
    1006908    ELSEIF ( ibc_p_b == 1 )  THEN
    1007        runten = 'p(0)     = p(1)   |'
     909       r_lower = 'p(0)     = p(1)   |'
    1008910    ENDIF
    1009911    IF ( ibc_p_t == 0 )  THEN
    1010        roben  = 'p(nzt+1) = 0      |'
     912       r_upper  = 'p(nzt+1) = 0      |'
    1011913    ELSE
    1012        roben  = 'p(nzt+1) = p(nzt) |'
     914       r_upper  = 'p(nzt+1) = p(nzt) |'
    1013915    ENDIF
    1014916
    1015917    IF ( ibc_uv_b == 0 )  THEN
    1016        runten = TRIM( runten ) // ' uv(0)     = -uv(1)                |'
     918       r_lower = TRIM( r_lower ) // ' uv(0)     = -uv(1)                |'
    1017919    ELSE
    1018        runten = TRIM( runten ) // ' uv(0)     = uv(1)                 |'
     920       r_lower = TRIM( r_lower ) // ' uv(0)     = uv(1)                 |'
    1019921    ENDIF
    1020922    IF ( TRIM( bc_uv_t ) == 'dirichlet_0' )  THEN
    1021        roben  = TRIM( roben  ) // ' uv(nzt+1) = 0                     |'
     923       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = 0                     |'
    1022924    ELSEIF ( ibc_uv_t == 0 )  THEN
    1023        roben  = TRIM( roben  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
     925       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1)  |'
    1024926    ELSE
    1025        roben  = TRIM( roben  ) // ' uv(nzt+1) = uv(nzt)               |'
     927       r_upper  = TRIM( r_upper  ) // ' uv(nzt+1) = uv(nzt)               |'
    1026928    ENDIF
    1027929
    1028930    IF ( ibc_pt_b == 0 )  THEN
    1029931       IF ( land_surface )  THEN
    1030           runten = TRIM( runten ) // ' pt(0)     = from soil model'
    1031        ELSE
    1032           runten = TRIM( runten ) // ' pt(0)     = pt_surface'
     932          r_lower = TRIM( r_lower ) // ' pt(0)     = from soil model'
     933       ELSE
     934          r_lower = TRIM( r_lower ) // ' pt(0)     = pt_surface'
    1033935       ENDIF
    1034936    ELSEIF ( ibc_pt_b == 1 )  THEN
    1035        runten = TRIM( runten ) // ' pt(0)     = pt(1)'
     937       r_lower = TRIM( r_lower ) // ' pt(0)     = pt(1)'
    1036938    ELSEIF ( ibc_pt_b == 2 )  THEN
    1037        runten = TRIM( runten ) // ' pt(0)     = from coupled model'
     939       r_lower = TRIM( r_lower ) // ' pt(0)     = from coupled model'
    1038940    ENDIF
    1039941    IF ( ibc_pt_t == 0 )  THEN
    1040        roben  = TRIM( roben  ) // ' pt(nzt+1) = pt_top'
     942       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt_top'
    1041943    ELSEIF( ibc_pt_t == 1 )  THEN
    1042        roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt)'
     944       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt)'
    1043945    ELSEIF( ibc_pt_t == 2 )  THEN
    1044        roben  = TRIM( roben  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
    1045 
    1046     ENDIF
    1047 
    1048     WRITE ( io, 300 )  runten, roben
     946       r_upper  = TRIM( r_upper  ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
     947
     948    ENDIF
     949
     950    WRITE ( io, 300 )  r_lower, r_upper
    1049951
    1050952    IF ( .NOT. constant_diffusion )  THEN
    1051953       IF ( ibc_e_b == 1 )  THEN
    1052           runten = 'e(0)     = e(1)'
    1053        ELSE
    1054           runten = 'e(0)     = e(1) = (u*/0.1)**2'
    1055        ENDIF
    1056        roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
    1057 
    1058        WRITE ( io, 301 )  'e', runten, roben       
     954          r_lower = 'e(0)     = e(1)'
     955       ELSE
     956          r_lower = 'e(0)     = e(1) = (u*/0.1)**2'
     957       ENDIF
     958       r_upper = 'e(nzt+1) = e(nzt) = e(nzt-1)'
     959
     960       WRITE ( io, 301 )  'e', r_lower, r_upper       
    1059961
    1060962    ENDIF
    1061963
    1062964    IF ( ocean )  THEN
    1063        runten = 'sa(0)    = sa(1)'
     965       r_lower = 'sa(0)    = sa(1)'
    1064966       IF ( ibc_sa_t == 0 )  THEN
    1065           roben =  'sa(nzt+1) = sa_surface'
    1066        ELSE
    1067           roben =  'sa(nzt+1) = sa(nzt)'
    1068        ENDIF
    1069        WRITE ( io, 301 ) 'sa', runten, roben
     967          r_upper =  'sa(nzt+1) = sa_surface'
     968       ELSE
     969          r_upper =  'sa(nzt+1) = sa(nzt)'
     970       ENDIF
     971       WRITE ( io, 301 ) 'sa', r_lower, r_upper
    1070972    ENDIF
    1071973
     
    1073975       IF ( ibc_q_b == 0 )  THEN
    1074976          IF ( land_surface )  THEN
    1075              runten = 'q(0)     = from soil model'
     977             r_lower = 'q(0)     = from soil model'
    1076978          ELSE
    1077              runten = 'q(0)     = q_surface'
    1078           ENDIF
    1079 
    1080        ELSE
    1081           runten = 'q(0)     = q(1)'
     979             r_lower = 'q(0)     = q_surface'
     980          ENDIF
     981
     982       ELSE
     983          r_lower = 'q(0)     = q(1)'
    1082984       ENDIF
    1083985       IF ( ibc_q_t == 0 )  THEN
    1084           roben =  'q(nzt)   = q_top'
    1085        ELSE
    1086           roben =  'q(nzt)   = q(nzt-1) + dq/dz'
    1087        ENDIF
    1088        WRITE ( io, 301 ) 'q', runten, roben
     986          r_upper =  'q(nzt)   = q_top'
     987       ELSE
     988          r_upper =  'q(nzt)   = q(nzt-1) + dq/dz'
     989       ENDIF
     990       WRITE ( io, 301 ) 'q', r_lower, r_upper
    1089991    ENDIF
    1090992
    1091993    IF ( passive_scalar )  THEN
    1092994       IF ( ibc_q_b == 0 )  THEN
    1093           runten = 's(0)     = s_surface'
    1094        ELSE
    1095           runten = 's(0)     = s(1)'
     995          r_lower = 's(0)     = s_surface'
     996       ELSE
     997          r_lower = 's(0)     = s(1)'
    1096998       ENDIF
    1097999       IF ( ibc_q_t == 0 )  THEN
    1098           roben =  's(nzt)   = s_top'
    1099        ELSE
    1100           roben =  's(nzt)   = s(nzt-1) + ds/dz'
    1101        ENDIF
    1102        WRITE ( io, 301 ) 's', runten, roben
     1000          r_upper =  's(nzt)   = s_top'
     1001       ELSE
     1002          r_upper =  's(nzt)   = s(nzt-1) + ds/dz'
     1003       ENDIF
     1004       WRITE ( io, 301 ) 's', r_lower, r_upper
    11031005    ENDIF
    11041006
     
    17471649!
    17481650!-- Geostrophic parameters
    1749     IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
    1750        WRITE ( io, 417 )  lambda
    1751     ENDIF
    17521651    WRITE ( io, 410 )  phi, omega, f, fs
    17531652
     
    17551654!-- Other quantities
    17561655    WRITE ( io, 411 )  g
    1757     IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN
    1758        WRITE ( io, 418 )  day_init, time_utc_init
    1759     ENDIF
    17601656
    17611657    WRITE ( io, 412 )  TRIM( reference_state )
     
    20601956279 FORMAT (' Topography grid definition convention:'/ &
    20611957            ' cell center (scalar grid points)' /)
    2062 280 FORMAT (//' Vegetation canopy (drag) model:'/ &
    2063               ' ------------------------------'// &
    2064               ' Canopy mode: ', A / &
    2065               ' Canopy height: ',F6.2,'m (',I4,' grid points)' / &
    2066               ' Leaf drag coefficient: ',F6.2 /)
    2067 281 FORMAT (/ ' Scalar exchange coefficient: ',F6.2 / &
    2068               ' Scalar concentration at leaf surfaces in kg/m**3: ',F6.2 /)
    2069 282 FORMAT (' Predefined constant heatflux at the top of the vegetation: ',F6.2,' K m/s')
    2070 283 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
    2071               ' Height:              ',A,'  m'/ &
    2072               ' Leaf area density:   ',A,'  m**2/m**3'/ &
    2073               ' Gradient:            ',A,'  m**2/m**4'/ &
    2074               ' Gridpoint:           ',A)
    2075 284 FORMAT (//' Characteristic levels of the leaf area density and coefficients:'// &
    2076               ' Height:              ',A,'  m'/ &
    2077               ' Leaf area density:   ',A,'  m**2/m**3'/ &
    2078               ' Coefficient alpha: ',F6.2 / &
    2079               ' Coefficient beta: ',F6.2 / &
    2080               ' Leaf area index: ',F6.2,'  m**2/m**2' /)
    2081                
    20821958300 FORMAT (//' Boundary conditions:'/ &
    20831959             ' -------------------'// &
     
    23002176                       '[0,1000] cm**2/s**3')
    23012177437 FORMAT ('    Droplet collision is switched off')
    2302 444 FORMAT (//' Radiation model information:'/                                 &
    2303               ' ----------------------------'/)
    2304 445 FORMAT (' --> Using constant net radiation: net_radiation = ', F6.2, '  W/m**2')
    2305 446 FORMAT (' --> Simple radiation scheme for clear sky is used (no clouds,',  &
    2306                    ' default)')
    2307 447 FORMAT (' --> RRTMG scheme is used')
    2308 448 FORMAT (/'     User-specific surface albedo: albedo =', F6.3)
    2309 449 FORMAT  ('     Timestep: dt_radiation = ', F5.2, '  s')
    2310 
    23112178450 FORMAT (//' LES / Turbulence quantities:'/ &
    23122179              ' ---------------------------'/)
     
    23162183454 FORMAT ('    TKE is not allowed to fall below ',E9.2,' (m/s)**2')
    23172184455 FORMAT ('    initial TKE is prescribed as ',E9.2,' (m/s)**2')
    2318 456 FORMAT (/'    Albedo is set for land surface type: ', A)
    2319 457 FORMAT (/'    --> Albedo is fixed during the run')
    2320 458 FORMAT (/'    --> Longwave radiation is disabled')
    2321 459 FORMAT (/'    --> Shortwave radiation is disabled.')
    23222185470 FORMAT (//' Actions during the simulation:'/ &
    23232186              ' -----------------------------'/)
Note: See TracChangeset for help on using the changeset viewer.