[2687] | 1 | !> @file uv_exposure_model_mod.f90 |
---|
[2696] | 2 | !------------------------------------------------------------------------------! |
---|
| 3 | ! This file is part of the PALM model system. |
---|
[2687] | 4 | ! |
---|
[2696] | 5 | ! PALM is free software: you can redistribute it and/or modify it under the |
---|
| 6 | ! terms of the GNU General Public License as published by the Free Software |
---|
| 7 | ! Foundation, either version 3 of the License, or (at your option) any later |
---|
[2687] | 8 | ! version. |
---|
| 9 | ! |
---|
[2696] | 10 | ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY |
---|
| 11 | ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
---|
| 12 | ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
---|
[2687] | 13 | ! |
---|
| 14 | ! You should have received a copy of the GNU General Public License along with |
---|
| 15 | ! PALM. If not, see <http://www.gnu.org/licenses/>. |
---|
| 16 | ! |
---|
[2718] | 17 | ! Copyright 2017-2018 Leibniz Universitaet Hannover |
---|
[2687] | 18 | !------------------------------------------------------------------------------! |
---|
| 19 | ! |
---|
| 20 | ! Current revisions: |
---|
| 21 | ! ----------------- |
---|
[2696] | 22 | ! |
---|
| 23 | ! |
---|
[2687] | 24 | ! Former revisions: |
---|
| 25 | ! ----------------- |
---|
| 26 | ! $Id: uv_exposure_model_mod.f90 3274 2018-09-24 15:42:55Z gronemeier $ |
---|
[3274] | 27 | ! Modularization of all bulk cloud physics code components |
---|
| 28 | ! |
---|
| 29 | ! 3248 2018-09-14 09:42:06Z sward |
---|
[3248] | 30 | ! Minor formating changes |
---|
| 31 | ! |
---|
| 32 | ! 3246 2018-09-13 15:14:50Z sward |
---|
[3246] | 33 | ! Added error handling for input namelist via parin_fail_message and small |
---|
| 34 | ! typo bugfix |
---|
| 35 | ! |
---|
| 36 | ! 3241 2018-09-12 15:02:00Z raasch |
---|
[3241] | 37 | ! unused variables removed |
---|
| 38 | ! |
---|
| 39 | ! 3014 2018-05-09 08:42:38Z maronga |
---|
[3014] | 40 | ! Bugfix: domain bounds of local_pf corrected |
---|
| 41 | ! |
---|
| 42 | ! 3004 2018-04-27 12:33:25Z Giersch |
---|
[3004] | 43 | ! Further allocation checks implemented (averaged data will be assigned to fill |
---|
| 44 | ! values if no allocation happened so far) |
---|
| 45 | ! |
---|
| 46 | ! 2932 2018-03-26 09:39:22Z maronga |
---|
[2932] | 47 | ! renamed uvexposure_par to biometeorology_parameters |
---|
| 48 | ! |
---|
| 49 | ! 2894 2018-03-15 09:17:58Z Giersch |
---|
[2894] | 50 | ! Routine for skipping global restart data has been removed, uvem_last_actions |
---|
| 51 | ! has been renamed to uvem_wrd_global and uvem_read_restart_data has been |
---|
| 52 | ! renamed to uvem_rrd_global, variable named found has been introduced for |
---|
| 53 | ! checking if restart data was found, reading of restart strings has been moved |
---|
| 54 | ! completely to read_restart_data_mod, marker *** end new module *** has been |
---|
| 55 | ! removed, strings and their respective lengths are written out and read now |
---|
| 56 | ! in case of restart runs to get rid of prescribed character lengths, CASE |
---|
| 57 | ! DEFAULT was added if restart data is read |
---|
| 58 | ! |
---|
| 59 | ! 2848 2018-03-05 10:11:18Z Giersch |
---|
[2696] | 60 | ! Initial revision |
---|
[2687] | 61 | ! |
---|
[2696] | 62 | ! |
---|
| 63 | ! |
---|
[2687] | 64 | ! Authors: |
---|
| 65 | ! -------- |
---|
| 66 | ! @author Michael Schrempf |
---|
| 67 | ! |
---|
| 68 | ! |
---|
| 69 | ! Description: |
---|
| 70 | ! ------------ |
---|
| 71 | !> Calculation of vitamin-D weighted UV exposure |
---|
| 72 | !> |
---|
| 73 | !> |
---|
| 74 | !> @todo uv_vitd3dose-->new output type necessary (cumulative) |
---|
| 75 | !> @todo consider upwelling radiation |
---|
| 76 | !> |
---|
| 77 | !> @note <Enter notes on the module> |
---|
| 78 | !> |
---|
| 79 | !> @bug <Enter known bugs here> |
---|
| 80 | !------------------------------------------------------------------------------! |
---|
| 81 | MODULE uv_exposure_model_mod |
---|
| 82 | |
---|
[3274] | 83 | |
---|
| 84 | USE basic_constants_and_equations_mod, & |
---|
| 85 | ONLY: pi |
---|
| 86 | |
---|
[2687] | 87 | USE kinds |
---|
| 88 | |
---|
| 89 | ! |
---|
| 90 | !-- Load required variables from existing modules |
---|
| 91 | !-- USE modulename, & |
---|
| 92 | !-- ONLY: ... |
---|
| 93 | |
---|
| 94 | |
---|
| 95 | IMPLICIT NONE |
---|
| 96 | |
---|
| 97 | |
---|
| 98 | ! |
---|
| 99 | !-- Declare all global variables within the module (alphabetical order) |
---|
| 100 | INTEGER(iwp) :: ai = 0 !< running index |
---|
| 101 | INTEGER(iwp) :: clothing = 3 !< clothing (0=unclothed, 1=Arms,Hands Face free, 3=Hand, Face free) |
---|
| 102 | INTEGER(iwp) :: consider_obstructions = 1 !< 0 = unobstructed scenario, |
---|
| 103 | !< 1 = scenario where obstrcutions are considered |
---|
| 104 | INTEGER(iwp) :: orientation_angle = 0 !< orientation of front/face of the human model |
---|
| 105 | INTEGER(iwp) :: saa_in_south = 1 !< 0 = sun always in south direction, 1 = actual sun position |
---|
| 106 | INTEGER(iwp) :: obstruction_direct_beam = 0 !< Obstruction information for direct beam |
---|
| 107 | INTEGER(iwp) :: turn_to_sun = 1 !< 0 = orientation of human as in orientation_angle, |
---|
| 108 | !< 1 = human is always orientated towards the sun |
---|
| 109 | INTEGER(iwp) :: zi = 0 !< running index |
---|
| 110 | |
---|
| 111 | INTEGER(iwp), DIMENSION(0:44) :: obstruction_temp1 = 0 !< temporary obstruction information |
---|
| 112 | !< stored with ibset as logical information |
---|
| 113 | INTEGER(iwp), DIMENSION(0:359) :: obstruction_temp2 = 0 !< temporary obstruction information restored values |
---|
| 114 | !< from logical information, which where stored by ibset |
---|
| 115 | |
---|
| 116 | INTEGER(iwp), DIMENSION(0:35,0:9) :: obstruction = 0 !< final obstruction information array for all |
---|
| 117 | !< hemispherical directions |
---|
| 118 | |
---|
| 119 | INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: obstruction_lookup_table !< lookup table of obstruction |
---|
| 120 | !< information of entire domain |
---|
| 121 | |
---|
| 122 | REAL(wp) :: diffuse_exposure = 0.0_wp !< calculated exposure by diffuse radiation |
---|
| 123 | REAL(wp) :: direct_exposure = 0.0_wp !< calculated exposure by direct beam |
---|
| 124 | REAL(wp) :: projection_area_direct_beam = 0.0_wp !< projection area for by direct beam |
---|
| 125 | REAL(wp) :: saa = 180.0_wp !< solar azimuth angle |
---|
| 126 | REAL(wp) :: startpos_human = 0.0_wp !< start position in azimuth direction for the |
---|
| 127 | !< interpolation of the projection area |
---|
| 128 | REAL(wp) :: startpos_saa_float = 0.0_wp !< start position in azimuth direction for the |
---|
| 129 | !< interpolation of the radiance field |
---|
| 130 | REAL(wp) :: sza = 20.0_wp !< solar zenith angle |
---|
| 131 | REAL(wp) :: xfactor = 0.0_wp !< relative x-position used for interpolation |
---|
| 132 | REAL(wp) :: yfactor = 0.0_wp !< relative y-position used for interpolation |
---|
| 133 | |
---|
| 134 | REAL(wp), DIMENSION(0:2) :: irradiance = 0.0_wp !< iradiance values extracted from irradiance lookup table |
---|
| 135 | |
---|
| 136 | REAL(wp), DIMENSION(0:2,0:90) :: irradiance_lookup_table = 0.0_wp !< irradiance lookup table contains values |
---|
| 137 | !< for direct, diffuse and global component |
---|
| 138 | REAL(wp), DIMENSION(0:35,0:9) :: integration_array = 0.0_wp |
---|
| 139 | REAL(wp), DIMENSION(0:35,0:9) :: projection_area = 0.0_wp |
---|
| 140 | REAL(wp), DIMENSION(0:35,0:9) :: projection_area_lookup_table = 0.0_wp |
---|
| 141 | REAL(wp), DIMENSION(0:71,0:9) :: projection_area_temp = 0.0_wp |
---|
| 142 | REAL(wp), DIMENSION(0:35,0:9) :: radiance_array = 0.0_wp |
---|
| 143 | REAL(wp), DIMENSION(0:71,0:9) :: radiance_array_temp = 0.0_wp |
---|
| 144 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vitd3_exposure |
---|
| 145 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vitd3_exposure_av |
---|
| 146 | |
---|
| 147 | REAL(wp), DIMENSION(0:35,0:9,0:90) :: radiance_lookup_table = 0.0_wp |
---|
| 148 | |
---|
| 149 | |
---|
| 150 | SAVE |
---|
| 151 | |
---|
| 152 | PRIVATE |
---|
| 153 | |
---|
| 154 | |
---|
| 155 | ! |
---|
| 156 | !-- Add INTERFACES that must be available to other modules (alphabetical order) |
---|
| 157 | PUBLIC uvem_3d_data_averaging, uvem_calc_exposure, uvem_check_data_output, & |
---|
| 158 | uvem_data_output_2d, uvem_define_netcdf_grid, uvem_init, & |
---|
| 159 | uvem_init_arrays, uvem_parin |
---|
| 160 | |
---|
| 161 | ! |
---|
| 162 | !-- Add VARIABLES that must be available to other modules (alphabetical order) |
---|
| 163 | ! PUBLIC |
---|
| 164 | |
---|
| 165 | ! |
---|
| 166 | !-- Add PROGNOSTIC QUANTITIES that must be available to other modules (alphabetical order) |
---|
| 167 | !-- PUBLIC ... |
---|
| 168 | |
---|
| 169 | |
---|
| 170 | ! |
---|
| 171 | !-- Default procedures for all new modules (not all are necessarily required, |
---|
| 172 | !-- alphabetical order is not essential) |
---|
| 173 | |
---|
| 174 | ! |
---|
| 175 | !-- PALM interfaces: |
---|
| 176 | !-- Data output checks for 2D/3D data to be done in check_parameters |
---|
| 177 | INTERFACE uvem_check_data_output |
---|
| 178 | MODULE PROCEDURE uvem_check_data_output |
---|
| 179 | END INTERFACE uvem_check_data_output |
---|
| 180 | |
---|
| 181 | ! ! |
---|
| 182 | ! !-- Data output checks for profile data to be done in check_parameters |
---|
| 183 | ! INTERFACE uvem_check_data_output_pr |
---|
| 184 | ! MODULE PROCEDURE uvem_check_data_output_pr |
---|
| 185 | ! END INTERFACE uvem_check_data_output_pr |
---|
| 186 | ! |
---|
| 187 | ! ! |
---|
| 188 | ! !-- Input parameter checks to be done in check_parameters |
---|
| 189 | ! INTERFACE uvem_check_parameters |
---|
| 190 | ! MODULE PROCEDURE uvem_check_parameters |
---|
| 191 | ! END INTERFACE uvem_check_parameters |
---|
| 192 | ! |
---|
| 193 | ! |
---|
| 194 | !-- Averaging of 3D data for output |
---|
| 195 | INTERFACE uvem_3d_data_averaging |
---|
| 196 | MODULE PROCEDURE uvem_3d_data_averaging |
---|
| 197 | END INTERFACE uvem_3d_data_averaging |
---|
| 198 | ! |
---|
| 199 | ! ! |
---|
| 200 | !-- Data output of 2D quantities |
---|
| 201 | INTERFACE uvem_data_output_2d |
---|
| 202 | MODULE PROCEDURE uvem_data_output_2d |
---|
| 203 | END INTERFACE uvem_data_output_2d |
---|
| 204 | ! |
---|
| 205 | ! ! |
---|
| 206 | ! !-- Data output of 3D data |
---|
| 207 | ! INTERFACE uvem_data_output_3d |
---|
| 208 | ! MODULE PROCEDURE uvem_data_output_3d |
---|
| 209 | ! END INTERFACE uvem_data_output_3d |
---|
| 210 | ! |
---|
| 211 | ! ! |
---|
| 212 | ! !-- Definition of data output quantities |
---|
| 213 | INTERFACE uvem_define_netcdf_grid |
---|
| 214 | MODULE PROCEDURE uvem_define_netcdf_grid |
---|
| 215 | END INTERFACE uvem_define_netcdf_grid |
---|
| 216 | ! |
---|
| 217 | ! ! |
---|
| 218 | ! !-- Output of information to the header file |
---|
| 219 | ! INTERFACE uvem_header |
---|
| 220 | ! MODULE PROCEDURE uvem_header |
---|
| 221 | ! END INTERFACE uvem_header |
---|
| 222 | |
---|
| 223 | ! |
---|
| 224 | !-- Initialization actions |
---|
| 225 | INTERFACE uvem_init |
---|
| 226 | MODULE PROCEDURE uvem_init |
---|
| 227 | END INTERFACE uvem_init |
---|
| 228 | |
---|
| 229 | ! |
---|
| 230 | !-- Initialization of arrays |
---|
| 231 | INTERFACE uvem_init_arrays |
---|
| 232 | MODULE PROCEDURE uvem_init_arrays |
---|
| 233 | END INTERFACE uvem_init_arrays |
---|
| 234 | ! |
---|
| 235 | ! ! |
---|
| 236 | ! !-- Writing of binary output for restart runs !!! renaming?! |
---|
[2894] | 237 | ! INTERFACE uvem_wrd_global |
---|
| 238 | ! MODULE PROCEDURE uvem_wrd_global |
---|
| 239 | ! END INTERFACE uvem_wrd_global |
---|
[2687] | 240 | ! |
---|
| 241 | ! |
---|
| 242 | !-- Reading of NAMELIST parameters |
---|
| 243 | INTERFACE uvem_parin |
---|
| 244 | MODULE PROCEDURE uvem_parin |
---|
| 245 | END INTERFACE uvem_parin |
---|
| 246 | ! |
---|
| 247 | ! ! |
---|
| 248 | ! !-- Reading of parameters for restart runs |
---|
[2894] | 249 | ! INTERFACE uvem_rrd_global |
---|
| 250 | ! MODULE PROCEDURE uvem_rrd_global |
---|
| 251 | ! END INTERFACE uvem_rrd_global |
---|
[2687] | 252 | ! |
---|
| 253 | ! ! |
---|
| 254 | ! !-- Swapping of time levels (required for prognostic variables) |
---|
| 255 | ! INTERFACE uvem_swap_timelevel |
---|
| 256 | ! MODULE PROCEDURE uvem_swap_timelevel |
---|
| 257 | ! END INTERFACE uvem_swap_timelevel |
---|
| 258 | ! |
---|
| 259 | ! ! |
---|
| 260 | ! !-- New module-specific procedure(s) (alphabetical order): |
---|
| 261 | ! INTERFACE uvem_newprocedure |
---|
| 262 | ! MODULE PROCEDURE uvem_newprocedure |
---|
| 263 | ! END INTERFACE uvem_newprocedure |
---|
| 264 | |
---|
| 265 | CONTAINS |
---|
| 266 | |
---|
| 267 | !------------------------------------------------------------------------------! |
---|
| 268 | ! Description: |
---|
| 269 | ! ------------ |
---|
| 270 | !> Check data output for new module. |
---|
| 271 | !------------------------------------------------------------------------------! |
---|
| 272 | SUBROUTINE uvem_check_data_output( var, unit, i, ilen, k ) |
---|
| 273 | |
---|
| 274 | USE control_parameters, & |
---|
| 275 | ONLY: data_output, message_string, uv_exposure |
---|
| 276 | |
---|
| 277 | IMPLICIT NONE |
---|
| 278 | |
---|
| 279 | CHARACTER (LEN=*) :: unit !< string for unit of output quantity |
---|
| 280 | CHARACTER (LEN=*) :: var !< string for output quantity |
---|
| 281 | |
---|
| 282 | INTEGER(iwp) :: i !< |
---|
| 283 | INTEGER(iwp) :: ilen !< |
---|
| 284 | INTEGER(iwp) :: k !< |
---|
| 285 | |
---|
| 286 | SELECT CASE ( TRIM( var ) ) |
---|
| 287 | |
---|
| 288 | |
---|
| 289 | CASE ( 'uvem_vitd3*' ) |
---|
| 290 | IF ( .NOT. uv_exposure ) THEN |
---|
| 291 | message_string = 'output of "' // TRIM( var ) // '" requi' // & |
---|
| 292 | 'res a namelist &uvexposure_par' |
---|
| 293 | CALL message( 'uvem_check_data_output', 'UV0001', 1, 2, 0, 6, 0 ) |
---|
| 294 | ENDIF |
---|
| 295 | IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN |
---|
| 296 | message_string = 'illegal value for data_output: "' // & |
---|
| 297 | TRIM( var ) // '" & only 2d-horizontal ' // & |
---|
| 298 | 'cross sections are allowed for this value' |
---|
| 299 | CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 ) |
---|
| 300 | ENDIF |
---|
| 301 | unit = 'IU/s' |
---|
| 302 | |
---|
| 303 | CASE ( 'uvem_vitd3dose*' ) |
---|
| 304 | IF ( .NOT. uv_exposure ) THEN |
---|
| 305 | message_string = 'output of "' // TRIM( var ) // '" requi' // & |
---|
| 306 | 'res a namelist &uvexposure_par' |
---|
| 307 | CALL message( 'uvem_check_data_output', 'UV0001', 1, 2, 0, 6, 0 ) |
---|
| 308 | ENDIF |
---|
| 309 | IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN |
---|
| 310 | message_string = 'illegal value for data_output: "' // & |
---|
| 311 | TRIM( var ) // '" & only 2d-horizontal ' // & |
---|
| 312 | 'cross sections are allowed for this value' |
---|
| 313 | CALL message( 'check_parameters', 'PA0111', 1, 2, 0, 6, 0 ) |
---|
| 314 | ENDIF |
---|
| 315 | unit = 'IU/av-h' |
---|
| 316 | |
---|
| 317 | CASE DEFAULT |
---|
| 318 | unit = 'illegal' |
---|
| 319 | |
---|
| 320 | END SELECT |
---|
| 321 | |
---|
| 322 | END SUBROUTINE uvem_check_data_output |
---|
| 323 | |
---|
| 324 | |
---|
| 325 | !-----------------------------------------------------------------------------! |
---|
| 326 | ! |
---|
| 327 | ! Description: |
---|
| 328 | ! ------------ |
---|
| 329 | !> Subroutine defining 2D output variables |
---|
| 330 | !-----------------------------------------------------------------------------! |
---|
[3241] | 331 | SUBROUTINE uvem_data_output_2d( av, variable, found, grid, local_pf, two_d, & |
---|
| 332 | nzb_do, nzt_do ) |
---|
[2687] | 333 | |
---|
| 334 | USE indices |
---|
| 335 | |
---|
| 336 | USE kinds |
---|
| 337 | |
---|
| 338 | |
---|
| 339 | IMPLICIT NONE |
---|
| 340 | |
---|
| 341 | CHARACTER (LEN=*) :: grid !< |
---|
| 342 | CHARACTER (LEN=*) :: variable !< |
---|
| 343 | |
---|
| 344 | INTEGER(iwp) :: av !< |
---|
| 345 | INTEGER(iwp) :: i !< running index |
---|
| 346 | INTEGER(iwp) :: j !< running index |
---|
| 347 | INTEGER(iwp) :: nzb_do !< |
---|
| 348 | INTEGER(iwp) :: nzt_do !< |
---|
| 349 | |
---|
| 350 | LOGICAL :: found !< |
---|
| 351 | LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) |
---|
| 352 | |
---|
[3004] | 353 | REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute |
---|
| 354 | |
---|
[3014] | 355 | REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< |
---|
[2687] | 356 | |
---|
| 357 | |
---|
| 358 | found = .TRUE. |
---|
| 359 | |
---|
| 360 | SELECT CASE ( TRIM( variable ) ) |
---|
| 361 | ! |
---|
| 362 | !-- Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost points therein. |
---|
| 363 | !-- However, at this point this is only required for instantaneous arrays, time-averaged quantities are already exchanged. |
---|
| 364 | CASE ( 'uvem_vitd3*_xy' ) ! 2d-array |
---|
| 365 | IF ( av == 0 ) THEN |
---|
| 366 | DO i = nxl, nxr |
---|
| 367 | DO j = nys, nyn |
---|
| 368 | local_pf(i,j,nzb+1) = vitd3_exposure(j,i) |
---|
| 369 | ENDDO |
---|
| 370 | ENDDO |
---|
| 371 | ENDIF |
---|
| 372 | |
---|
| 373 | two_d = .TRUE. |
---|
| 374 | grid = 'zu1' |
---|
| 375 | |
---|
| 376 | CASE ( 'uvem_vitd3dose*_xy' ) ! 2d-array |
---|
[3004] | 377 | IF ( .NOT. ALLOCATED( vitd3_exposure_av ) ) THEN |
---|
| 378 | ALLOCATE( vitd3_exposure_av(nysg:nyng,nxlg:nxrg) ) |
---|
| 379 | vitd3_exposure_av = REAL( fill_value, KIND = wp ) |
---|
| 380 | ENDIF |
---|
[2687] | 381 | IF ( av == 1 ) THEN |
---|
| 382 | DO i = nxl, nxr |
---|
| 383 | DO j = nys, nyn |
---|
| 384 | local_pf(i,j,nzb+1) = vitd3_exposure_av(j,i) |
---|
| 385 | ENDDO |
---|
| 386 | ENDDO |
---|
| 387 | ENDIF |
---|
| 388 | |
---|
| 389 | two_d = .TRUE. |
---|
| 390 | grid = 'zu1' |
---|
| 391 | |
---|
| 392 | CASE DEFAULT |
---|
| 393 | found = .FALSE. |
---|
| 394 | grid = 'none' |
---|
| 395 | |
---|
| 396 | END SELECT |
---|
| 397 | |
---|
| 398 | END SUBROUTINE uvem_data_output_2d |
---|
| 399 | |
---|
| 400 | |
---|
| 401 | !------------------------------------------------------------------------------! |
---|
| 402 | ! |
---|
| 403 | ! Description: |
---|
| 404 | ! ------------ |
---|
| 405 | !> Subroutine defining appropriate grid for netcdf variables. |
---|
| 406 | !> It is called out from subroutine netcdf. |
---|
| 407 | !------------------------------------------------------------------------------! |
---|
| 408 | SUBROUTINE uvem_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) |
---|
| 409 | |
---|
| 410 | IMPLICIT NONE |
---|
| 411 | |
---|
| 412 | CHARACTER (LEN=*), INTENT(IN) :: var !< |
---|
| 413 | CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< |
---|
| 414 | CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< |
---|
| 415 | CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< |
---|
| 416 | |
---|
| 417 | LOGICAL, INTENT(OUT) :: found !< |
---|
| 418 | |
---|
| 419 | found = .TRUE. |
---|
| 420 | |
---|
| 421 | ! |
---|
| 422 | !-- Check for the grid |
---|
| 423 | SELECT CASE ( TRIM( var ) ) |
---|
| 424 | |
---|
| 425 | CASE ( 'uvem_vitd3*_xy', 'uvem_vitd3dose*_xy' ) |
---|
| 426 | grid_x = 'x' |
---|
| 427 | grid_y = 'y' |
---|
| 428 | grid_z = 'zu1' |
---|
| 429 | |
---|
| 430 | CASE DEFAULT |
---|
| 431 | found = .FALSE. |
---|
| 432 | grid_x = 'none' |
---|
| 433 | grid_y = 'none' |
---|
| 434 | grid_z = 'none' |
---|
| 435 | |
---|
| 436 | END SELECT |
---|
| 437 | |
---|
| 438 | END SUBROUTINE uvem_define_netcdf_grid |
---|
| 439 | |
---|
| 440 | |
---|
| 441 | !------------------------------------------------------------------------------! |
---|
| 442 | ! Description: |
---|
| 443 | ! ------------ |
---|
| 444 | !> Parin for &uvexposure_par for UV exposure model |
---|
| 445 | !------------------------------------------------------------------------------! |
---|
| 446 | SUBROUTINE uvem_parin |
---|
| 447 | |
---|
| 448 | USE control_parameters, & |
---|
| 449 | ONLY: uv_exposure |
---|
| 450 | |
---|
| 451 | |
---|
| 452 | IMPLICIT NONE |
---|
| 453 | |
---|
| 454 | CHARACTER (LEN=80) :: line !< dummy string for current line in parameter file |
---|
| 455 | |
---|
[2932] | 456 | NAMELIST /biometeorology_parameters/ clothing |
---|
[2687] | 457 | |
---|
| 458 | line = ' ' |
---|
| 459 | |
---|
| 460 | ! |
---|
| 461 | !-- Try to find uv exposure model namelist |
---|
| 462 | REWIND ( 11 ) |
---|
| 463 | line = ' ' |
---|
[3248] | 464 | DO WHILE ( INDEX( line, '&biometeorology_parameters' ) == 0 ) |
---|
[3246] | 465 | READ ( 11, '(A)', END=20 ) line |
---|
[2687] | 466 | ENDDO |
---|
| 467 | BACKSPACE ( 11 ) |
---|
| 468 | |
---|
| 469 | ! |
---|
| 470 | !-- Read user-defined namelist |
---|
[3246] | 471 | READ ( 11, biometeorology_parameters, ERR = 10, END = 20 ) |
---|
[2687] | 472 | |
---|
| 473 | ! |
---|
| 474 | !-- Set flag that indicates that the uv exposure model is switched on |
---|
| 475 | uv_exposure = .TRUE. |
---|
| 476 | |
---|
[3246] | 477 | 10 BACKSPACE( 11 ) |
---|
[3248] | 478 | READ( 11 , '(A)') line |
---|
| 479 | CALL parin_fail_message( 'biometeorology_parameters', line ) |
---|
[2687] | 480 | |
---|
[3246] | 481 | |
---|
| 482 | 20 CONTINUE |
---|
[2687] | 483 | |
---|
| 484 | |
---|
| 485 | END SUBROUTINE uvem_parin |
---|
| 486 | |
---|
| 487 | |
---|
| 488 | !------------------------------------------------------------------------------! |
---|
| 489 | ! |
---|
| 490 | ! Description: |
---|
| 491 | ! ------------ |
---|
| 492 | !> Subroutine for averaging 3D data |
---|
| 493 | !------------------------------------------------------------------------------! |
---|
| 494 | SUBROUTINE uvem_3d_data_averaging( mode, variable ) |
---|
| 495 | |
---|
| 496 | |
---|
| 497 | USE control_parameters |
---|
| 498 | |
---|
| 499 | USE indices |
---|
| 500 | |
---|
| 501 | USE kinds |
---|
| 502 | |
---|
| 503 | IMPLICIT NONE |
---|
| 504 | |
---|
| 505 | CHARACTER (LEN=*) :: mode !< |
---|
| 506 | CHARACTER (LEN=*) :: variable !< |
---|
| 507 | |
---|
| 508 | INTEGER(iwp) :: i !< |
---|
| 509 | INTEGER(iwp) :: j !< |
---|
| 510 | |
---|
| 511 | IF ( mode == 'allocate' ) THEN |
---|
| 512 | |
---|
| 513 | SELECT CASE ( TRIM( variable ) ) |
---|
| 514 | |
---|
| 515 | CASE ( 'uvem_vitd3dose*' ) |
---|
| 516 | IF ( .NOT. ALLOCATED( vitd3_exposure_av ) ) THEN |
---|
| 517 | ALLOCATE( vitd3_exposure_av(nysg:nyng,nxlg:nxrg) ) |
---|
| 518 | ENDIF |
---|
| 519 | vitd3_exposure_av = 0.0_wp |
---|
| 520 | |
---|
| 521 | |
---|
| 522 | CASE DEFAULT |
---|
| 523 | CONTINUE |
---|
| 524 | |
---|
| 525 | END SELECT |
---|
| 526 | |
---|
| 527 | ELSEIF ( mode == 'sum' ) THEN |
---|
| 528 | |
---|
| 529 | SELECT CASE ( TRIM( variable ) ) |
---|
| 530 | |
---|
| 531 | CASE ( 'uvem_vitd3dose*' ) |
---|
[3004] | 532 | IF ( ALLOCATED( vitd3_exposure_av ) ) THEN |
---|
| 533 | DO i = nxlg, nxrg |
---|
| 534 | DO j = nysg, nyng |
---|
| 535 | vitd3_exposure_av(j,i) = vitd3_exposure_av(j,i) + vitd3_exposure(j,i) |
---|
| 536 | ENDDO |
---|
[2687] | 537 | ENDDO |
---|
[3004] | 538 | ENDIF |
---|
[2687] | 539 | |
---|
| 540 | |
---|
| 541 | CASE DEFAULT |
---|
| 542 | CONTINUE |
---|
| 543 | |
---|
| 544 | END SELECT |
---|
| 545 | |
---|
| 546 | ! |
---|
| 547 | !-- No averaging since we are calculating a dose (only sum is calculated and saved to |
---|
| 548 | !-- av.nc file) |
---|
| 549 | ! ELSEIF ( mode == 'average' ) THEN |
---|
| 550 | |
---|
| 551 | ENDIF |
---|
| 552 | |
---|
| 553 | END SUBROUTINE uvem_3d_data_averaging |
---|
| 554 | |
---|
| 555 | |
---|
| 556 | |
---|
| 557 | |
---|
| 558 | !------------------------------------------------------------------------------! |
---|
| 559 | ! Description: |
---|
| 560 | ! ------------ |
---|
| 561 | !> Initialization of the new module |
---|
| 562 | !------------------------------------------------------------------------------! |
---|
| 563 | SUBROUTINE uvem_init |
---|
| 564 | |
---|
| 565 | |
---|
| 566 | USE control_parameters, & |
---|
| 567 | ONLY: initializing_actions |
---|
| 568 | |
---|
| 569 | IMPLICIT NONE |
---|
| 570 | |
---|
| 571 | ! |
---|
| 572 | !-- Actions for initial runs |
---|
| 573 | IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN |
---|
| 574 | OPEN(90, STATUS='old',FILE=& |
---|
| 575 | 'RADIANCE', FORM='UNFORMATTED') |
---|
| 576 | READ(90) radiance_lookup_table |
---|
| 577 | CLOSE(90) |
---|
| 578 | OPEN(90, STATUS='old',FILE=& |
---|
| 579 | 'IRRADIANCE', FORM='UNFORMATTED') |
---|
| 580 | READ(90) irradiance_lookup_table |
---|
| 581 | CLOSE(90) |
---|
| 582 | |
---|
| 583 | !________________________LOAD Obstruction information _______________________________ |
---|
| 584 | IF ( consider_obstructions == 1 ) THEN |
---|
| 585 | OPEN(90, STATUS='old',FILE=& |
---|
| 586 | 'OBSTRUCTION', FORM='UNFORMATTED') |
---|
| 587 | READ(90) obstruction_lookup_table |
---|
| 588 | CLOSE(90) |
---|
| 589 | ELSEIF( consider_obstructions == 0 ) THEN |
---|
| 590 | obstruction(:,:) = 1 |
---|
| 591 | ENDIF |
---|
| 592 | |
---|
| 593 | !________________________LOAD integration_array ________________________________________________________________________ |
---|
| 594 | OPEN(90, STATUS='old',FILE=& |
---|
| 595 | 'SOLIDANGLE', FORM='UNFORMATTED') |
---|
| 596 | READ(90) integration_array |
---|
| 597 | CLOSE(90) |
---|
| 598 | |
---|
| 599 | IF (clothing==1) THEN |
---|
| 600 | OPEN(90, STATUS='old',FILE='HUMAN', FORM='UNFORMATTED') |
---|
| 601 | ENDIF |
---|
| 602 | READ(90) projection_area_lookup_table |
---|
| 603 | CLOSE(90) |
---|
| 604 | |
---|
| 605 | ! |
---|
| 606 | !-- Actions for restart runs |
---|
| 607 | ELSE |
---|
| 608 | ! .... |
---|
| 609 | |
---|
| 610 | ENDIF |
---|
| 611 | |
---|
| 612 | END SUBROUTINE uvem_init |
---|
| 613 | |
---|
| 614 | |
---|
| 615 | !-----------------------------------------------------------------------------! |
---|
| 616 | ! Description: |
---|
| 617 | ! ------------ |
---|
| 618 | !> Allocate new module arrays and define pointers if required |
---|
| 619 | !-----------------------------------------------------------------------------! |
---|
| 620 | SUBROUTINE uvem_init_arrays |
---|
| 621 | |
---|
| 622 | USE indices, & |
---|
| 623 | ONLY: nxlg, nxrg, nyng, nysg |
---|
| 624 | |
---|
| 625 | |
---|
| 626 | IMPLICIT NONE |
---|
| 627 | |
---|
| 628 | ! |
---|
| 629 | !-- Allocate arrays |
---|
| 630 | ALLOCATE ( vitd3_exposure(nysg:nyng,nxlg:nxrg) ) |
---|
| 631 | ALLOCATE ( vitd3_exposure_av(nysg:nyng,nxlg:nxrg) ) |
---|
| 632 | ALLOCATE ( obstruction_lookup_table(nxlg:nxrg,nysg:nyng,0:44) ) |
---|
| 633 | |
---|
| 634 | ! |
---|
| 635 | !-- Initialize arrays |
---|
| 636 | vitd3_exposure = 0.0_wp |
---|
| 637 | vitd3_exposure_av = 0.0_wp |
---|
| 638 | obstruction_lookup_table = 0 |
---|
| 639 | |
---|
| 640 | |
---|
| 641 | END SUBROUTINE uvem_init_arrays |
---|
| 642 | |
---|
| 643 | !------------------------------------------------------------------------------! |
---|
| 644 | ! Description: |
---|
| 645 | ! ------------ |
---|
| 646 | !> Module-specific routine for new module |
---|
| 647 | !------------------------------------------------------------------------------! |
---|
[3274] | 648 | SUBROUTINE uvem_solar_position |
---|
[2687] | 649 | |
---|
| 650 | USE date_and_time_mod, & |
---|
| 651 | ONLY: calc_date_and_time, day_of_year, time_utc |
---|
| 652 | |
---|
| 653 | USE control_parameters, & |
---|
| 654 | ONLY: latitude, longitude |
---|
| 655 | |
---|
| 656 | IMPLICIT NONE |
---|
| 657 | |
---|
| 658 | |
---|
| 659 | REAL(wp) :: alpha = 0.0_wp !< solar azimuth angle in radiant |
---|
| 660 | REAL(wp) :: declination = 0.0_wp !< declination |
---|
| 661 | REAL(wp) :: dtor = 0.0_wp !< factor to convert degree to radiant |
---|
| 662 | REAL(wp) :: js = 0.0_wp !< parameter for solar position calculation |
---|
| 663 | REAL(wp) :: lat = 52.39_wp !< latitude |
---|
| 664 | REAL(wp) :: lon = 9.7_wp !< longitude |
---|
| 665 | REAL(wp) :: thetar = 0.0_wp !< angle for solar zenith angle calculation |
---|
| 666 | REAL(wp) :: thetasr = 0.0_wp !< angle for solar azimuth angle calculation |
---|
| 667 | REAL(wp) :: zgl = 0.0_wp !< calculated exposure by direct beam |
---|
| 668 | REAL(wp) :: woz = 0.0_wp !< calculated exposure by diffuse radiation |
---|
| 669 | REAL(wp) :: wsp = 0.0_wp !< calculated exposure by direct beam |
---|
| 670 | |
---|
| 671 | |
---|
| 672 | CALL calc_date_and_time |
---|
| 673 | |
---|
| 674 | dtor = pi / 180.0_wp |
---|
| 675 | lat = latitude |
---|
| 676 | lon = longitude |
---|
| 677 | ! |
---|
| 678 | !-- calculation of js : |
---|
| 679 | js= 72.0_wp * ( day_of_year + ( time_utc / 86400.0_wp ) ) / 73.0_wp |
---|
| 680 | ! |
---|
| 681 | !-- calculation of equation of time (zgl): |
---|
| 682 | zgl = 0.0066_wp + 7.3525_wp * cos( ( js + 85.9_wp ) * dtor ) + 9.9359_wp * & |
---|
| 683 | cos( ( 2.0_wp * js + 108.9_wp ) * dtor ) + 0.3387_wp * cos( ( 3 * js + 105.2_wp ) * dtor ) |
---|
| 684 | ! |
---|
| 685 | !-- calculation of apparent solar time woz: |
---|
| 686 | woz = ( ( time_utc / 3600.0_wp ) - ( 4.0_wp * ( 15.0_wp - lon ) ) / 60.0_wp ) + ( zgl / 60.0_wp ) |
---|
| 687 | ! |
---|
| 688 | !-- calculation of hour angle (wsp): |
---|
| 689 | wsp = ( woz - 12.0_wp ) * 15.0_wp |
---|
| 690 | ! |
---|
| 691 | !-- calculation of declination: |
---|
| 692 | declination = 0.3948_wp - 23.2559_wp * cos( ( js + 9.1_wp ) * dtor ) - & |
---|
| 693 | 0.3915_wp * cos( ( 2.0_wp * js + 5.4_wp ) * dtor ) - 0.1764_wp * cos( ( 3.0_wp * js + 26.0_wp ) * dtor ) |
---|
| 694 | ! |
---|
| 695 | !-- calculation of solar zenith angle |
---|
| 696 | thetar = acos( sin( lat * dtor) * sin( declination * dtor ) + cos( wsp * dtor ) * & |
---|
| 697 | cos( lat * dtor ) * cos( declination * dtor ) ) |
---|
| 698 | thetasr = asin( sin( lat * dtor) * sin( declination * dtor ) + cos( wsp * dtor ) * & |
---|
| 699 | cos( lat * dtor ) * cos( declination * dtor ) ) |
---|
| 700 | sza = thetar / dtor |
---|
| 701 | ! |
---|
| 702 | !-- calculation of solar azimuth angle |
---|
| 703 | IF (woz .LE. 12.0_wp) alpha = pi - acos( sin(thetasr) * sin(lat * dtor) - & |
---|
| 704 | sin( declination * dtor ) / ( cos(thetasr) * cos( lat * dtor ) ) ) |
---|
| 705 | IF (woz .GT. 12.0_wp) alpha = pi + acos( sin(thetasr) * sin(lat * dtor) - & |
---|
| 706 | sin( declination * dtor ) / ( cos(thetasr) * cos( lat * dtor ) ) ) |
---|
| 707 | saa = alpha / dtor |
---|
| 708 | |
---|
| 709 | END SUBROUTINE uvem_solar_position |
---|
| 710 | |
---|
| 711 | |
---|
| 712 | !------------------------------------------------------------------------------! |
---|
| 713 | ! Description: |
---|
| 714 | ! ------------ |
---|
| 715 | !> Module-specific routine for new module |
---|
| 716 | !------------------------------------------------------------------------------! |
---|
| 717 | SUBROUTINE uvem_calc_exposure |
---|
| 718 | |
---|
| 719 | USE indices, & |
---|
| 720 | ONLY: nxlg, nxrg, nyng, nysg |
---|
| 721 | |
---|
| 722 | |
---|
| 723 | IMPLICIT NONE |
---|
| 724 | |
---|
| 725 | INTEGER(iwp) :: i !< running index |
---|
| 726 | INTEGER(iwp) :: j !< running index |
---|
| 727 | |
---|
| 728 | |
---|
| 729 | CALL uvem_solar_position |
---|
| 730 | |
---|
| 731 | IF (sza .GE. 90) THEN |
---|
| 732 | vitd3_exposure(:,:) = 0.0_wp |
---|
| 733 | ELSE |
---|
| 734 | |
---|
| 735 | ! |
---|
| 736 | !-- rotate 3D-Model human to desired direction ----------------------------- |
---|
| 737 | projection_area_temp( 0:35,:) = projection_area_lookup_table |
---|
| 738 | projection_area_temp(36:71,:) = projection_area_lookup_table |
---|
| 739 | IF ( Turn_to_Sun .EQ. 0 ) startpos_human = orientation_angle / 10.0_wp |
---|
| 740 | IF ( Turn_to_Sun .EQ. 1 ) startpos_human = startpos_saa_float |
---|
| 741 | DO ai = 0, 35 |
---|
| 742 | xfactor = ( startpos_human ) - INT( startpos_human ) |
---|
| 743 | DO zi = 0, 9 |
---|
| 744 | projection_area(ai,zi) = ( projection_area_temp( ai + INT( startpos_human ), zi) * & |
---|
| 745 | (1.0_wp - xfactor ) ) & |
---|
| 746 | +( projection_area_temp( ai + 1 + INT( startpos_human ), zi) * & |
---|
| 747 | xfactor) |
---|
| 748 | ENDDO |
---|
| 749 | ENDDO |
---|
| 750 | ! |
---|
| 751 | !-- calculate Projectionarea for direct beam -----------------------------' |
---|
| 752 | projection_area_temp( 0:35,:) = projection_area |
---|
| 753 | projection_area_temp(36:71,:) = projection_area |
---|
| 754 | yfactor = ( sza / 10.0_wp ) - INT( sza / 10.0_wp ) |
---|
| 755 | xfactor = ( startpos_saa_float ) - INT( startpos_saa_float ) |
---|
| 756 | projection_area_direct_beam = ( projection_area_temp( INT(startpos_saa_float) ,INT( sza / 10.0_wp ) ) * & |
---|
| 757 | ( 1.0_wp - xfactor ) * ( 1.0_wp - yfactor ) ) + & |
---|
| 758 | ( projection_area_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)) *& |
---|
| 759 | ( xfactor ) * ( 1.0_wp - yfactor ) ) + & |
---|
| 760 | ( projection_area_temp( INT(startpos_saa_float) ,INT(sza/10.0_wp)+1)*& |
---|
| 761 | ( 1.0_wp - xfactor ) * ( yfactor ) ) + & |
---|
| 762 | ( projection_area_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)+1)*& |
---|
| 763 | ( xfactor ) * ( yfactor ) ) |
---|
| 764 | |
---|
| 765 | |
---|
| 766 | ! |
---|
| 767 | !-- interpolate to accurate Solar Zenith Angle ------------------ |
---|
| 768 | DO ai = 0, 35 |
---|
| 769 | xfactor = (sza)-INT(sza) |
---|
| 770 | DO zi = 0, 9 |
---|
| 771 | radiance_array(ai,zi) = ( radiance_lookup_table(ai, zi, INT(sza) ) * ( 1.0_wp - xfactor) ) +& |
---|
| 772 | ( radiance_lookup_table(ai,zi,INT(sza) + 1) * xfactor ) |
---|
| 773 | ENDDO |
---|
| 774 | ENDDO |
---|
| 775 | Do ai = 0, 2 |
---|
| 776 | irradiance(ai) = ( irradiance_lookup_table(ai, INT(sza) ) * ( 1.0_wp - xfactor)) + & |
---|
| 777 | (irradiance_lookup_table(ai, INT(sza) + 1) * xfactor ) |
---|
| 778 | ENDDO |
---|
| 779 | ! |
---|
| 780 | !-- interpolate to accurate Solar Azimuth Angle ------------------ |
---|
| 781 | IF ( saa_in_south .EQ. 0 ) THEN |
---|
| 782 | startpos_saa_float = 180.0_wp / 10.0_wp |
---|
| 783 | ELSE |
---|
| 784 | startpos_saa_float = saa / 10.0_wp |
---|
| 785 | ENDIF |
---|
| 786 | radiance_array_temp( 0:35,:) = radiance_array |
---|
| 787 | radiance_array_temp(36:71,:) = radiance_array |
---|
| 788 | xfactor = (startpos_saa_float) - INT(startpos_saa_float) |
---|
| 789 | DO ai = 0, 35 |
---|
| 790 | DO zi = 0, 9 |
---|
| 791 | radiance_array(ai,zi) = ( radiance_array_temp( ai + INT( startpos_saa_float ), zi ) * & |
---|
| 792 | (1.0_wp - xfactor)) & |
---|
| 793 | + ( radiance_array_temp( ai + 1 + INT( startpos_saa_float ), zi ) & |
---|
| 794 | * xfactor) |
---|
| 795 | ENDDO |
---|
| 796 | ENDDO |
---|
| 797 | |
---|
| 798 | |
---|
| 799 | |
---|
| 800 | |
---|
| 801 | DO i = nxlg, nxrg |
---|
| 802 | DO j = nysg, nyng |
---|
| 803 | ! |
---|
| 804 | !-- extract obstrcution from IBSET-Integer_Array ------------------' |
---|
| 805 | IF (consider_obstructions == 1) THEN |
---|
| 806 | obstruction_temp1 = obstruction_lookup_table(i,j,:) |
---|
| 807 | IF (obstruction_temp1(0) .NE. 9) THEN |
---|
| 808 | DO zi = 0, 44 |
---|
| 809 | DO ai = 0, 7 |
---|
| 810 | IF ( btest( obstruction_temp1(zi), ai ) .EQV. .TRUE.) THEN |
---|
| 811 | obstruction_temp2( ( zi * 8 ) + ai ) = 1 |
---|
| 812 | ELSE |
---|
| 813 | obstruction_temp2( ( zi * 8 ) + ai ) = 0 |
---|
| 814 | ENDIF |
---|
| 815 | ENDDO |
---|
| 816 | ENDDO |
---|
| 817 | DO zi = 0, 9 |
---|
| 818 | obstruction(:,zi) = obstruction_temp2( zi * 36 :( zi * 36) + 35 ) |
---|
| 819 | ENDDO |
---|
| 820 | ELSE |
---|
| 821 | obstruction(:,:) = 0 |
---|
| 822 | ENDIF |
---|
| 823 | ENDIF |
---|
| 824 | ! |
---|
| 825 | !-- calculated human exposure ------------------' |
---|
| 826 | diffuse_exposure = SUM( radiance_array * projection_area * integration_array * obstruction ) |
---|
| 827 | |
---|
| 828 | obstruction_direct_beam = obstruction( nint(startpos_saa_float), nint( sza / 10.0_wp ) ) |
---|
| 829 | IF (sza .GE. 89.99_wp) THEN |
---|
| 830 | sza = 89.99999_wp |
---|
| 831 | ENDIF |
---|
| 832 | ! |
---|
| 833 | !-- calculate direct normal irradiance (direct beam) ------------------' |
---|
| 834 | direct_exposure = ( irradiance(1) / cos( pi * sza / 180.0_wp ) ) * & |
---|
| 835 | projection_area_direct_beam * obstruction_direct_beam |
---|
| 836 | |
---|
| 837 | vitd3_exposure(j,i) = ( diffuse_exposure + direct_exposure ) / 1000.0_wp * 70.97_wp |
---|
| 838 | ! unit = international units vitamin D per second |
---|
| 839 | ENDDO |
---|
| 840 | ENDDO |
---|
| 841 | ENDIF |
---|
| 842 | |
---|
| 843 | END SUBROUTINE uvem_calc_exposure |
---|
| 844 | |
---|
| 845 | |
---|
| 846 | |
---|
| 847 | |
---|
| 848 | |
---|
| 849 | ! ------------------------------------------------------------------------------! |
---|
| 850 | ! Description: |
---|
| 851 | ! ------------ |
---|
| 852 | ! > Check parameters routine |
---|
| 853 | ! ------------------------------------------------------------------------------! |
---|
| 854 | ! SUBROUTINE uvem_check_parameters |
---|
| 855 | ! |
---|
| 856 | ! USE control_parameters, & |
---|
| 857 | ! ONLY: message_string |
---|
| 858 | ! |
---|
| 859 | ! |
---|
| 860 | ! IMPLICIT NONE |
---|
| 861 | ! |
---|
| 862 | ! |
---|
| 863 | ! -- Checks go here (cf. check_parameters.f90). |
---|
| 864 | ! |
---|
| 865 | ! END SUBROUTINE uvem_check_parameters |
---|
| 866 | |
---|
| 867 | |
---|
| 868 | |
---|
| 869 | ! !------------------------------------------------------------------------------! |
---|
| 870 | ! ! Description: |
---|
| 871 | ! ! ------------ |
---|
| 872 | ! !> Header output |
---|
| 873 | ! !------------------------------------------------------------------------------! |
---|
| 874 | ! SUBROUTINE uvem_header ( io ) |
---|
| 875 | ! |
---|
| 876 | ! |
---|
| 877 | ! IMPLICIT NONE |
---|
| 878 | ! |
---|
| 879 | ! |
---|
| 880 | ! INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file |
---|
| 881 | ! |
---|
| 882 | ! ! |
---|
| 883 | ! !-- Header output goes here |
---|
| 884 | ! !-- ... |
---|
| 885 | ! |
---|
| 886 | ! END SUBROUTINE uvem_header |
---|
| 887 | |
---|
| 888 | |
---|
| 889 | |
---|
| 890 | ! !------------------------------------------------------------------------------! |
---|
| 891 | ! ! Description: |
---|
| 892 | ! ! ------------ |
---|
[2894] | 893 | ! !> This routine reads the global restart data. |
---|
[2687] | 894 | ! !------------------------------------------------------------------------------! |
---|
[2894] | 895 | ! SUBROUTINE uvem_rrd_global |
---|
| 896 | ! |
---|
| 897 | ! |
---|
| 898 | ! USE control_parameters, & |
---|
| 899 | ! ONLY: length, restart_string |
---|
| 900 | ! |
---|
| 901 | ! |
---|
[2687] | 902 | ! IMPLICIT NONE |
---|
[2894] | 903 | ! |
---|
| 904 | ! LOGICAL, INTENT(OUT) :: found |
---|
| 905 | ! |
---|
| 906 | ! |
---|
| 907 | ! found = .TRUE. |
---|
[2687] | 908 | ! |
---|
| 909 | ! |
---|
[2894] | 910 | ! SELECT CASE ( restart_string(1:length) ) |
---|
| 911 | ! |
---|
| 912 | ! CASE ( 'param1' ) |
---|
| 913 | ! READ ( 13 ) param1 |
---|
| 914 | ! |
---|
| 915 | ! CASE DEFAULT |
---|
| 916 | ! |
---|
| 917 | ! found = .FALSE. |
---|
| 918 | ! |
---|
| 919 | ! END SELECT |
---|
[2687] | 920 | ! |
---|
[2894] | 921 | ! END SUBROUTINE uvem_rrd_global |
---|
[2687] | 922 | |
---|
| 923 | |
---|
| 924 | ! !------------------------------------------------------------------------------! |
---|
| 925 | ! ! Description: |
---|
| 926 | ! ! ------------ |
---|
[2894] | 927 | ! !> This routine writes the global restart data. |
---|
[2687] | 928 | ! !------------------------------------------------------------------------------! |
---|
[2894] | 929 | ! SUBROUTINE uvem_wrd_global |
---|
[2687] | 930 | ! |
---|
[2894] | 931 | ! |
---|
[2687] | 932 | ! IMPLICIT NONE |
---|
[2894] | 933 | ! |
---|
| 934 | ! |
---|
| 935 | ! CALL wrd_write_string( 'param1' ) |
---|
| 936 | ! WRITE ( 14 ) param1 |
---|
[2687] | 937 | ! |
---|
| 938 | ! |
---|
| 939 | ! |
---|
[2894] | 940 | ! END SUBROUTINE uvem_wrd_global |
---|
[2687] | 941 | |
---|
| 942 | |
---|
| 943 | END MODULE uv_exposure_model_mod |
---|