Changeset 5451
- Timestamp:
- 2018-09-27T18:02:14+02:00 (6 years ago)
- File:
-
- 1 edited
-
tags/ORCHIDEE_2_0/ORCHIDEE/src_sechiba/hydrol.f90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
tags/ORCHIDEE_2_0/ORCHIDEE/src_sechiba/hydrol.f90
r5388 r5451 387 387 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_next !! Soil moisture from file at next time step in the file 388 388 !$OMP THREADPRIVATE(mc_read_next) 389 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_current !! For nudging, linear time interpolation bewteen mc_read_prev and mc_read_next 390 !$OMP THREADPRIVATE(mc_read_current) 389 391 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mask_mc_interp !! Mask of valid data in soil moisture nudging file 390 392 !$OMP THREADPRIVATE(mask_mc_interp) 393 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_aux !! Temporary variable needed for the calculation of diag nudgincsm for nudging 394 !$OMP THREADPRIVATE(tmc_aux) 391 395 REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowdz_read_prev !! snowdz read from file at previous timestep in the file 392 396 !$OMP THREADPRIVATE(snowdz_read_prev) … … 708 712 709 713 !! 2. Applay nudging for soil moisture and/or snow variables 710 IF (ok_nudge_mc .OR. ok_nudge_snow) THEN 711 CALL hydrol_nudge(kjit, kjpindex, mc, snowdz, snowrho, snowtemp, soiltile) 714 715 ! For soil moisture, here only read and interpolate the soil moisture from file to current time step. 716 ! The values will be applayed in hydrol_soil after the soil moisture has been updated. 717 IF (ok_nudge_mc) THEN 718 CALL hydrol_nudge_mc_read(kjit) 719 END IF 720 721 ! Read, interpolate and applay nudging of snow variables 722 IF ( ok_nudge_snow) THEN 723 CALL hydrol_nudge_snow(kjit, kjpindex, snowdz, snowrho, snowtemp ) 712 724 END IF 713 725 … … 1006 1018 CALL xios_orchidee_send_field("humtot_top_lut",humtot_top_lut) 1007 1019 CALL xios_orchidee_send_field("mrro_lut",mrro_lut) 1020 1021 ! Write diagnistic for soil moisture nudging 1022 IF (ok_nudge_mc) CALL hydrol_nudge_mc_diag(kjpindex, soiltile) 1008 1023 1009 1024 … … 1872 1887 ALLOCATE (mc_read_next(kjpindex,nslm,nstm),stat=ier) 1873 1888 IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_next','','') 1889 ALLOCATE (mc_read_current(kjpindex,nslm,nstm),stat=ier) 1890 IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_current','','') 1874 1891 ALLOCATE (mask_mc_interp(kjpindex,nslm,nstm),stat=ier) 1875 1892 IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_mc_interp','','') 1893 ALLOCATE (tmc_aux(kjpindex,nstm),stat=ier) 1894 IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_aux','','') 1876 1895 END IF 1877 1896 … … 4700 4719 ENDDO 4701 4720 4702 !! 3.4 Optional block to force saturation below zwt_force 4721 !! 3.4.1 Optional nudging for soil moisture 4722 IF (ok_nudge_mc) THEN 4723 CALL hydrol_nudge_mc(kjpindex, jst, mc) 4724 END IF 4725 4726 4727 !! 3.4.2 Optional block to force saturation below zwt_force 4703 4728 ! This block is not compatible with freezing; in this case, mcl must be corrected too 4704 4729 ! We test if zwt_force(1,jst) <= zmaxh, to avoid steps 1 and 2 if unnecessary … … 7309 7334 7310 7335 !! ================================================================================================================================ 7311 !! SUBROUTINE : hydrol_nudge 7312 !! 7313 !>\BRIEF Applay nudging of soil moisture and/or snow variables 7314 !! 7315 !! DESCRIPTION : Nudging of soil moisture and/or snow variables is done if OK_NUDGE_MC=y and/or OK_NUDGE_SNOW=y in run.def 7336 !! SUBROUTINE : hydrol_nudge_mc_read 7337 !! 7338 !>\BRIEF Read soil moisture from file and interpolate to the current time step 7339 !! 7340 !! DESCRIPTION : Nudging of soil moisture and/or snow variables is done if OK_NUDGE_MC=y and/or OK_NUDGE_SNOW=y in run.def. 7341 !! This subroutine reads and interpolates spatialy if necessary and temporary the soil moisture from file. 7342 !! The values for the soil moisture will be applaied later using hydrol_nudge_mc 7316 7343 !! 7317 7344 !! RECENT CHANGE(S) : None 7318 !!7319 !! MAIN IN-OUTPUT VARIABLE(S) : mc, snowdz, snowrho, snowtemp7320 !!7321 !! REFERENCE(S) :7322 7345 !! 7323 7346 !! \n 7324 7347 !_ ================================================================================================================================ 7325 7348 7326 SUBROUTINE hydrol_nudge(kjit, kjpindex, & 7327 mc_loc, snowdz, snowrho, snowtemp, soiltile) 7349 SUBROUTINE hydrol_nudge_mc_read(kjit) 7328 7350 7329 7351 !! 0.1 Input variables 7330 7352 INTEGER(i_std), INTENT(in) :: kjit !! Timestep number 7331 INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size7332 REAL(r_std), DIMENSION(kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)7333 7334 !! 0.2 Modified variables7335 REAL(r_std), DIMENSION(kjpindex,nslm,nstm), INTENT(inout) :: mc_loc !! Soil moisture7336 REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowdz !! Snow layer thickness7337 REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowrho !! Snow density7338 REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowtemp !! Snow temperature7339 7340 7341 7353 7342 7354 !! 0.3 Locals variables 7343 7355 REAL(r_std) :: tau !! Position between to values in nudge mc file 7344 REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_read_current !! mc from file interpolated to current timestep7345 REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowdz_read_current !! snowdz from file interpolated to current timestep7346 REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowrho_read_current !! snowrho from file interpolated to current timestep7347 REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowtemp_read_current !! snowtemp from file interpolated to current timestep7348 REAL(r_std), DIMENSION(kjpindex) :: nudgincsm !! Nudging increment of water in soil moisture7349 REAL(r_std), DIMENSION(kjpindex) :: nudgincswe !! Nudging increment of water in snow7350 REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_aux !! Temorary variable for calculation of nudgincsm7351 REAL(r_std), DIMENSION(kjpindex,nstm) :: tmc_aux !! Temorary variable for calculation of nudgincsm7352 7356 REAL(r_std), DIMENSION(iim_g,jjm_g,nslm,1) :: mc_read_glo2D_1 !! mc from file at global 2D(lat,lon) grid per soiltile 7353 7357 REAL(r_std), DIMENSION(iim_g,jjm_g,nslm,1) :: mc_read_glo2D_2 !! mc from file at global 2D(lat,lon) grid per soiltile 7354 7358 REAL(r_std), DIMENSION(iim_g,jjm_g,nslm,1) :: mc_read_glo2D_3 !! mc from file at global 2D(lat,lon) grid per soiltile 7355 REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowdz_read_glo2D !! snowdz from file at global 2D(lat,lon) grid7356 REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowrho_read_glo2D !! snowrho from file at global 2D(lat,lon) grid7357 REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowtemp_read_glo2D !! snowrho from file at global 2D(lat,lon) grid7358 7359 REAL(r_std), DIMENSION(nbp_glo,nslm,nstm) :: mc_read_glo1D !! mc_read_glo2D on land-only vector form, in global 7359 REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowdz_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global 7360 REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowrho_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global 7361 REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowtemp_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global 7362 INTEGER(i_std), SAVE :: istart_mc, istart_snow!! start index to read from input file 7360 INTEGER(i_std), SAVE :: istart_mc !! start index to read from input file 7363 7361 INTEGER(i_std) :: iend !! end index to read from input file 7364 7362 INTEGER(i_std) :: i, j, ji, jg, jst, jsl!! loop index 7365 7363 INTEGER(i_std) :: iim_file, jjm_file, llm_file !! Dimensions in input file 7366 INTEGER(i_std), SAVE :: ttm_mc , ttm_snow!! Time dimensions in input file7367 INTEGER(i_std), SAVE :: mc_id , snow_id!! index for netcdf files7364 INTEGER(i_std), SAVE :: ttm_mc !! Time dimensions in input file 7365 INTEGER(i_std), SAVE :: mc_id !! index for netcdf files 7368 7366 LOGICAL, SAVE :: firsttime_mc=.TRUE. 7369 LOGICAL, SAVE :: firsttime_snow=.TRUE.7370 7367 7371 7368 7372 7369 !! 1. Nudging of soil moisture 7373 IF (ok_nudge_mc) THEN7374 7370 7375 7371 !! 1.2 Read mc from file, once a day only … … 7452 7448 CALL xios_orchidee_send_field("mask_mc_interp_out", mask_mc_interp) 7453 7449 7450 7451 END SUBROUTINE hydrol_nudge_mc_read 7452 7453 !! ================================================================================================================================ 7454 !! SUBROUTINE : hydrol_nudge_mc 7455 !! 7456 !>\BRIEF Applay nuding for soil moisture 7457 !! 7458 !! DESCRIPTION : Applay nudging for soil moisture. The nuding values were previously read and interpolated using 7459 !! the subroutine hydrol_nudge_mc_read 7460 !! This subroutine is called from a loop over all soil tiles. 7461 !! 7462 !! RECENT CHANGE(S) : None 7463 !! 7464 !! \n 7465 !_ ================================================================================================================================ 7466 SUBROUTINE hydrol_nudge_mc(kjpindex, jst, mc_loc) 7467 7468 !! 0.1 Input variables 7469 INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size 7470 INTEGER(i_std), INTENT(in) :: jst !! Index for current soil tile 7454 7471 7455 !! 1.5 Applay nudging of soil moisture using alpha_nudge_mc at each model sechiba time step. 7456 !! alpha_mc_nudge calculated using the parameter for relaxation time NUDGE_TAU_MC set in module constantes. 7457 !! alpha_nudge_mc is between 0-1 7458 !! If alpha_nudge_mc=1, the new mc will be replaced by the one read from file 7459 mc_loc(:,:,:) = (1-alpha_nudge_mc)*mc_loc(:,:,:) + alpha_nudge_mc * mc_read_current(:,:,:) 7460 7461 7462 !! 1.6 Calculate diagnostic for nudging increment of water in soil moisture 7463 mc_aux(:,:,:) = alpha_nudge_mc * ( mc_read_current(:,:,:) - mc_loc(:,:,:)) 7464 DO jst=1,nstm 7465 DO ji=1,kjpindex 7466 tmc_aux(ji,jst) = dz(2) * ( trois*mc_aux(ji,1,jst) + mc_aux(ji,2,jst) )/huit 7467 DO jsl = 2,nslm-1 7468 tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(jsl) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl-1,jst))/huit & 7469 + dz(jsl+1) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl+1,jst))/huit 7470 ENDDO 7471 tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(nslm) * (trois*mc_aux(ji,nslm,jst) + mc_aux(ji,nslm-1,jst))/huit 7472 ENDDO 7473 ENDDO 7472 !! 0.2 Modified variables 7473 REAL(r_std), DIMENSION(kjpindex,nslm,nstm), INTENT(inout) :: mc_loc !! Soil moisture 7474 7475 !! 0.2 Locals variables 7476 REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_aux !! Temorary variable for calculation of nudgincsm 7477 INTEGER(i_std) :: ji, jsl !! loop index 7478 7479 7480 !! 1.5 Applay nudging of soil moisture using alpha_nudge_mc at each model sechiba time step. 7481 !! alpha_mc_nudge calculated using the parameter for relaxation time NUDGE_TAU_MC set in module constantes. 7482 !! alpha_nudge_mc is between 0-1 7483 !! If alpha_nudge_mc=1, the new mc will be replaced by the one read from file 7484 mc_loc(:,:,jst) = (1-alpha_nudge_mc)*mc_loc(:,:,jst) + alpha_nudge_mc * mc_read_current(:,:,jst) 7485 7486 7487 !! 1.6 Calculate diagnostic for nudging increment of water in soil moisture 7488 !! Here calculate tmc_aux for the current soil tile. Later in hydrol_nudge_mc_diag, this will be used to calculate nudgincsm 7489 mc_aux(:,:,jst) = alpha_nudge_mc * ( mc_read_current(:,:,jst) - mc_loc(:,:,jst)) 7490 DO ji=1,kjpindex 7491 tmc_aux(ji,jst) = dz(2) * ( trois*mc_aux(ji,1,jst) + mc_aux(ji,2,jst) )/huit 7492 DO jsl = 2,nslm-1 7493 tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(jsl) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl-1,jst))/huit & 7494 + dz(jsl+1) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl+1,jst))/huit 7495 ENDDO 7496 tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(nslm) * (trois*mc_aux(ji,nslm,jst) + mc_aux(ji,nslm-1,jst))/huit 7497 ENDDO 7474 7498 7475 ! Average over grid-cell 7476 nudgincsm(:) = zero 7477 DO jst=1,nstm 7478 DO ji=1,kjpindex 7479 nudgincsm(ji) = nudgincsm(ji) + vegtot(ji) * soiltile(ji,jst) * tmc_aux(ji,jst) 7480 ENDDO 7481 ENDDO 7482 7483 CALL xios_orchidee_send_field("nudgincsm", nudgincsm) 7484 7485 7486 END IF ! IF (ok_nudge_mc) 7487 7488 7499 7500 END SUBROUTINE hydrol_nudge_mc 7501 7502 7503 SUBROUTINE hydrol_nudge_mc_diag(kjpindex, soiltile) 7504 !! 0.1 Input variables 7505 INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size 7506 REAL(r_std), DIMENSION(kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless) 7507 7508 !! 0.2 Locals variables 7509 REAL(r_std), DIMENSION(kjpindex) :: nudgincsm !! Nudging increment of water in soil moisture 7510 INTEGER(i_std) :: ji, jst !! loop index 7511 7512 7513 ! Average over grid-cell 7514 nudgincsm(:) = zero 7515 DO jst=1,nstm 7516 DO ji=1,kjpindex 7517 nudgincsm(ji) = nudgincsm(ji) + vegtot(ji) * soiltile(ji,jst) * tmc_aux(ji,jst) 7518 ENDDO 7519 ENDDO 7520 7521 CALL xios_orchidee_send_field("nudgincsm", nudgincsm) 7522 7523 END SUBROUTINE hydrol_nudge_mc_diag 7524 7525 7526 !! ================================================================================================================================ 7527 !! SUBROUTINE : hydrol_nudge_snow 7528 !! 7529 !>\BRIEF Read, interpolate and applay nudging snow variables 7530 !! 7531 !! DESCRIPTION : Nudging of snow variables is done if OK_NUDGE_SNOW=y is set in run.def 7532 !! 7533 !! RECENT CHANGE(S) : None 7534 !! 7535 !! MAIN IN-OUTPUT VARIABLE(S) : snowdz, snowrho, snowtemp 7536 !! 7537 !! REFERENCE(S) : 7538 !! 7539 !! \n 7540 !_ ================================================================================================================================ 7541 7542 7543 SUBROUTINE hydrol_nudge_snow(kjit, kjpindex, snowdz, snowrho, snowtemp ) 7544 7545 !! 0.1 Input variables 7546 INTEGER(i_std), INTENT(in) :: kjit !! Timestep number 7547 INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size 7548 7549 !! 0.2 Modified variables 7550 REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowdz !! Snow layer thickness 7551 REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowrho !! Snow density 7552 REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowtemp !! Snow temperature 7553 7554 7555 7556 !! 0.3 Locals variables 7557 REAL(r_std) :: tau !! Position between to values in nudge mc file 7558 REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowdz_read_current !! snowdz from file interpolated to current timestep 7559 REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowrho_read_current !! snowrho from file interpolated to current timestep 7560 REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowtemp_read_current !! snowtemp from file interpolated to current timestep 7561 REAL(r_std), DIMENSION(kjpindex) :: nudgincswe !! Nudging increment of water in snow 7562 REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowdz_read_glo2D !! snowdz from file at global 2D(lat,lon) grid 7563 REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowrho_read_glo2D !! snowrho from file at global 2D(lat,lon) grid 7564 REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowtemp_read_glo2D !! snowrho from file at global 2D(lat,lon) grid 7565 REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowdz_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global 7566 REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowrho_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global 7567 REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowtemp_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global 7568 INTEGER(i_std), SAVE :: istart_snow!! start index to read from input file 7569 INTEGER(i_std) :: iend !! end index to read from input file 7570 INTEGER(i_std) :: i, j, ji, jg, jst, jsl!! loop index 7571 INTEGER(i_std) :: iim_file, jjm_file, llm_file !! Dimensions in input file 7572 INTEGER(i_std), SAVE :: ttm_snow !! Time dimensions in input file 7573 INTEGER(i_std), SAVE :: snow_id !! index for netcdf files 7574 LOGICAL, SAVE :: firsttime_snow=.TRUE. 7575 7576 7489 7577 !! 2. Nudging of snow variables 7490 7578 IF (ok_nudge_snow) THEN … … 7530 7618 7531 7619 ! Read snowdz, snowrho and snowtemp from file 7532 IF (printlev>= 3) WRITE(numout,*) &7533 "Read variables snowdz, snowrho and snowtemp from nudge_snow.nc at time step: ", istart_snow7620 IF (printlev>=2) WRITE(numout,*) & 7621 "Read variables snowdz, snowrho and snowtemp from nudge_snow.nc at time step: ", istart_snow,ttm_snow 7534 7622 CALL flinget (snow_id, 'snowdz', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowdz_read_glo2D) 7535 7623 CALL flinget (snow_id, 'snowrho', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowrho_read_glo2D) … … 7608 7696 END IF 7609 7697 7610 7611 END SUBROUTINE hydrol_nudge 7612 7698 END SUBROUTINE hydrol_nudge_snow 7699 7613 7700 END MODULE hydrol
Note: See TracChangeset
for help on using the changeset viewer.
