Changeset 6892
- Timestamp:
- 2020-10-08T11:15:45+02:00 (4 years ago)
- Location:
- branches/publications/ORCHIDEE-PEAT_r5488
- Files:
-
- 2 edited
-
src_driver/forcesoil.f90 (modified) (29 diffs)
-
src_stomate/lpj_cover.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/publications/ORCHIDEE-PEAT_r5488/src_driver/forcesoil.f90
r6890 r6892 41 41 USE netcdf 42 42 !- 43 !USE grid44 43 USE utils 45 44 USE defprec … … 49 48 USE constantes_soil 50 49 USE pft_parameters 51 USE control52 50 USE stomate_data 53 51 USE ioipsl_para … … 58 56 USE stomate 59 57 USE stomate_io_carbon_permafrost 60 USE xios_orchidee61 USE pft_parameters_var62 USE vertical_soil63 USE vertical_soil_var64 65 58 #ifdef CPP_PARA 66 59 USE mpi 67 60 #endif 68 69 61 !- 70 62 IMPLICIT NONE … … 103 95 104 96 105 INTEGER :: i, j,m,iatt,iv,iyear!! counters (unitless)97 INTEGER :: i,m,iatt,iv,iyear !! counters (unitless) 106 98 !!!qcj++ test 107 99 ! INTEGER :: pft,pool … … 138 130 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: clay_g !! clay fraction (nbpglo) (unitless) 139 131 !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 140 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: bulk_dens_g !! bulk_dens (nbpglo) (unitless)141 !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$)142 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: soil_ph_g !! soil_ph (nbpglo) (unitless)143 !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$)144 REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: poor_soils_g !! poor_soils (nbpglo) (unitless)145 !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$)146 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: veget_max_g147 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:) :: soilcarbon_input_DOC_g148 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:) :: floodcarbon_input_g149 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:) :: litter_above_g150 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:,:) :: litter_below_g151 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: lignin_struc_above_g152 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: lignin_struc_below_g153 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: runoff_per_soil_g154 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: runoff2peat_g155 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: drainage_per_soil_g156 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: wat_flux_g157 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: soil_mc_32l_g158 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: soil_mc_g159 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_topsoil_g160 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: precip2ground_g161 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:) :: interception_storage_g162 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:,:) :: biomass_g163 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: fastr_g164 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: precip2canopy_g165 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: canopy2ground_g166 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: DOC_to_subsoil_g167 ! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:) :: flood_frac_g168 169 132 REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE :: control_temp_g !! Temperature control (nbp_glo,above/below,time) on OM decomposition 170 133 !! (unitless) … … 172 135 !! ?? Should be defined per PFT as well (unitless) 173 136 REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE :: carbon_g !! Soil carbon stocks (nbp_glo,ncarb,nvm) (\f$gC m^{-2}\f$) 174 REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE :: carbon_32l_g 175 REAL(r_std),DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: DOC_g 137 176 138 REAL(r_std),ALLOCATABLE :: clay(:) !! clay fraction (nbp_loc) (unitless) 177 REAL(r_std),ALLOCATABLE :: bulk_dens(:) !! bulk_dens (nbp_loc) (unitless)178 REAL(r_std),ALLOCATABLE :: soil_ph(:) !! soil_ph (nbp_loc) (unitless)179 REAL(r_std),ALLOCATABLE :: poor_soils(:) !! poor_soils (nbp_loc) (unitless)180 139 REAL(r_std),ALLOCATABLE :: soilcarbon_input(:,:,:,:) !! soil carbon input (nbp_loc,ncarb,nvm,time) 181 140 !! (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 182 ! REAL(r_std),ALLOCATABLE :: veget_max(:,:,:)183 REAL(r_std),ALLOCATABLE :: soilcarbon_input_DOC(:,:,:,:,:,:)184 REAL(r_std),ALLOCATABLE :: floodcarbon_input(:,:,:,:,:)185 REAL(r_std),ALLOCATABLE :: litter_above(:,:,:,:,:)186 REAL(r_std),ALLOCATABLE :: litter_below(:,:,:,:,:,:)187 REAL(r_std),ALLOCATABLE :: lignin_struc_above(:,:,:)188 REAL(r_std),ALLOCATABLE :: lignin_struc_below(:,:,:,:)189 REAL(r_std),ALLOCATABLE :: runoff_per_soil(:,:,:)190 REAL(r_std),ALLOCATABLE :: runoff2peat(:,:,:)191 REAL(r_std),ALLOCATABLE :: drainage_per_soil(:,:,:)192 REAL(r_std),ALLOCATABLE :: wat_flux(:,:,:,:)193 REAL(r_std),ALLOCATABLE :: soil_mc_32l(:,:,:,:)194 REAL(r_std),ALLOCATABLE :: soil_mc(:,:,:,:)195 REAL(r_std),ALLOCATABLE :: DOC_to_topsoil(:,:,:)196 REAL(r_std),ALLOCATABLE :: precip2ground(:,:,:)197 REAL(r_std),ALLOCATABLE :: interception_storage(:,:,:,:)198 REAL(r_std),ALLOCATABLE :: biomass(:,:,:,:,:)199 REAL(r_std),ALLOCATABLE :: fastr(:,:)200 REAL(r_std),ALLOCATABLE :: precip2canopy(:,:,:)201 REAL(r_std),ALLOCATABLE :: canopy2ground(:,:,:)202 REAL(r_std),ALLOCATABLE :: DOC_to_subsoil(:,:,:)203 REAL(r_std),ALLOCATABLE :: flood_frac(:,:)204 205 141 REAL(r_std),ALLOCATABLE :: control_temp(:,:,:) !! Temperature control (nbp_loc,above/below,time) on OM decomposition 206 142 !! (unitless) … … 208 144 !! ?? Should be defined per PFT as well (unitless) 209 145 REAL(r_std),ALLOCATABLE :: carbon(:,:,:) !! Soil carbon stocks (nbp_loc,ncarb,nvm) (\f$gC m^{-2}\f$) 210 REAL(r_std),DIMENSION(:,:,:,:),ALLOCATABLE :: carbon_32l211 REAL(r_std),DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: DOC212 146 REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: resp_hetero_soil !! Heterotrophic respiration (\f$gC m^{-2} dt_forcesoil^{-1}\f$) 213 147 !! (requested by soilcarbon routine but not used here) 214 REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: resp_flood_soil215 REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE :: dry_dep_canopy216 REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE :: DOC_precip2ground217 REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE :: DOC_precip2canopy218 REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE :: DOC_canopy2ground219 REAL(r_std),DIMENSION(:,:,:,:,:),ALLOCATABLE :: DOC_EXP220 221 148 222 149 INTEGER(i_std) :: printlev_loc !! Local write level … … 286 213 REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE :: carbon_surf_g 287 214 REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE :: carbon_surf !! vertically-integrated (diagnostic) soil carbon pool: active, slow, or passive, (gC/(m**2 of ground)) 288 REAL(R_STD), DIMENSION(:,:), ALLOCATABLE:: fixed_cryoturbation_depth !! depth to hold cryoturbation to for fixed runs215 REAL(R_STD), ALLOCATABLE, DIMENSION(:,:) :: fixed_cryoturbation_depth !! depth to hold cryoturbation to for fixed runs 289 216 LOGICAL, SAVE :: satsoil = .FALSE. 290 217 LOGICAL :: reset_soilc = .false. 291 LOGICAL :: force_soil = .TRUE. 218 292 219 INTEGER(i_std) :: start_2d(2), count_2d(2) 293 220 INTEGER(i_std) :: start_4d(4), count_4d(4), start_3d(3), count_3d(3) 294 INTEGER(i_std) :: start_5d(5), count_5d(5), start_6d(6), count_6d(6)295 221 !_ ================================================================================================================================= 296 222 … … 308 234 CALL getin_p('OK_PC',ok_pc) 309 235 310 ok_leak=.FALSE.311 CALL getin_p('OK_LEAK',ok_leak)312 236 !!!qcj++ peatland 313 237 ok_peat=.FALSE. … … 317 241 CALL getin_p('PERMA_PEAT', perma_peat) 318 242 319 !>BG Ok_leak 320 ok_leak=.FALSE. 321 CALL getin_p('OK_LEAK',ok_leak) 322 243 244 ! 1. Read the number of PFTs 245 ! 246 !Config Key = NVM 247 !Config Desc = number of PFTs 248 !Config If = OK_SECHIBA or OK_STOMATE 249 !Config Def = 13 250 !Config Help = The number of vegetation types define by the user 251 !Config Units = [-] 252 CALL getin_p('NVM',nvm) 253 254 ! 2. Allocation 255 ALLOCATE(pft_to_mtc(nvm),stat=ier) 256 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'pft_to_mtc : error in memory allocation', '', '') 257 258 ! 3. Initialisation of the correspondance table 259 pft_to_mtc(:) = undef_int 260 261 ! 4.Reading of the conrrespondance table in the .def file 262 ! 263 !Config Key = PFT_TO_MTC 264 !Config Desc = correspondance array linking a PFT to MTC 265 !Config if = OK_SECHIBA or OK_STOMATE 266 !Config Def = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 267 !Config Help = 268 !Config Units = [-] 269 CALL getin_p('PFT_TO_MTC',pft_to_mtc) 270 271 272 ! 4.1 if nothing is found, we use the standard configuration 273 !!!qcj++ peatland 274 IF (ok_peat .OR. perma_peat) THEN 275 IF(nvm <= nvmc ) THEN 276 IF(pft_to_mtc(1) == undef_int) THEN 277 pft_to_mtc(:) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ,15/) 278 ENDIF 279 ENDIF 280 ELSE 281 IF(nvm <= nvmc ) THEN 282 IF(pft_to_mtc(1) == undef_int) THEN 283 WRITE(numout,*) 'Note to the user : we will use ORCHIDEE to its standard configuration' 284 pft_to_mtc(:) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /) 285 ENDIF 286 ELSE 287 IF(pft_to_mtc(1) == undef_int) THEN 288 WRITE(numout,*)' The array PFT_TO_MTC is empty : we stop' 289 ENDIF 290 ENDIF 291 ENDIF 292 293 294 ! 4.2 What happened if pft_to_mtc(j) > nvmc (if the mtc doesn't exist)? 295 DO i = 1, nvm 296 IF(pft_to_mtc(i) > nvmc) THEN 297 CALL ipslerr_p(3, 'forcesoil', 'the MTC you chose doesnt exist', 'we stop reading pft_to_mtc', '') 298 ENDIF 299 ENDDO 300 301 ! 4.3 Check if pft_to_mtc(1) = 1 302 IF(pft_to_mtc(1) /= 1) THEN 303 CALL ipslerr_p(3, 'forcesoil', 'the first pft has to be the bare soil', 'we stop reading next values of pft_to_mtc', '') 304 ENDIF 305 306 DO i = 2,nvm 307 IF(pft_to_mtc(i) == 1) THEN 308 CALL ipslerr_p(3, 'forcesoil', 'only pft_to_mtc(1) has to be the bare soil', 'we stop reading next values of pft_to_mtc', '') 309 ENDIF 310 ENDDO 311 312 ! 5. Allocate and initialize natural and is_c4 313 314 ! 5.1 Memory allocation 315 ALLOCATE(natural(nvm),stat=ier) 316 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'natural : error in memory allocation', '', '') 317 318 ALLOCATE(is_c4(nvm),stat=ier) 319 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'is_c4 : error in memory allocation', '', '') 320 321 ALLOCATE(permafrost_veg_exists(nvm),stat=ier) 322 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'permafrost_veg_exists : error in memory allocation', '', '') 323 324 !!!qcj++ peatland 325 ALLOCATE(is_peat(nvm),stat=ier) 326 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'is_peat : error in memory allocation', '', '') 327 DO i = 1, nvm 328 is_peat(i) = is_peat_mtc(pft_to_mtc(i)) 329 ENDDO 330 331 332 ! 5.2 Initialisation 333 DO i = 1, nvm 334 natural(i) = natural_mtc(pft_to_mtc(i)) 335 is_c4(i) = is_c4_mtc(pft_to_mtc(i)) 336 ENDDO 337 338 DO i = 1, nvm 339 permafrost_veg_exists(i) = permafrost_veg_exists_mtc(pft_to_mtc(i)) 340 ENDDO 323 341 !!- 324 342 !! 1. Initialisation stage … … 337 355 CALL getin ('STOMATE_RESTART_FILEOUT',sto_restname_out) 338 356 WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out) 339 !IF (ok_pc) CALL getin ('satsoil', satsoil) 340 CALL getin ('satsoil', satsoil) 357 IF (ok_pc) CALL getin ('satsoil', satsoil) 341 358 !- 342 359 ! Open the input file and Get some Dimension and Attributes ID's … … 348 365 CALL nccheck( NF90_GET_ATT (rest_id_sto, iv, 'calendar',thecalendar)) 349 366 CALL nccheck( NF90_CLOSE (rest_id_sto)) 350 351 367 i=INDEX(thecalendar,ACHAR(0)) 352 368 IF ( i > 0 ) THEN … … 380 396 CALL ioconf_startdate(date0) 381 397 ! 382 !IF (ok_pc) THEN383 !!- Permafrost variables (zz_deep and zz_coef_deep are constants)398 IF (ok_pc) THEN 399 !- Permafrost variables (zz_deep and zz_coef_deep are constants) 384 400 ALLOCATE (zz_deep(ndeep), stat=ier) 385 401 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'zz_deep : error in memory allocation', '', '') 386 402 ALLOCATE (zz_coef_deep(ndeep), stat=ier) 387 403 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'zz_coef_deep : error in memory allocation', '', '') 388 !ENDIF404 ENDIF 389 405 390 406 !- … … 409 425 ! and allocate variables. 410 426 !- 411 412 427 CALL nccheck( NF90_OPEN (TRIM(Cforcing_name),NF90_NOWRITE,Cforcing_id)) 413 428 !- … … 428 443 ALLOCATE (clay_g(nbp_glo), stat=ier) 429 444 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'clay_g : error in memory allocation', '', '') 430 ALLOCATE (bulk_dens_g(nbp_glo), stat=ier)431 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'bulk_dens_g : error in memory allocation', '', '')432 ALLOCATE (soil_ph_g(nbp_glo), stat=ier)433 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'soil_ph_g : error in memory allocation', '', '')434 ALLOCATE (poor_soils_g(nbp_glo), stat=ier)435 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'poor_soils_g : error in memory allocation', '', '')436 437 438 439 445 !- 440 446 ALLOCATE (x_indices_g(nbp_glo),stat=ier) … … 448 454 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'clay',v_id)) 449 455 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,clay_g)) 450 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'bulk_dens',v_id)) 451 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,bulk_dens_g)) 452 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'soil_ph',v_id)) 453 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,soil_ph_g)) 454 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'poor_soils',v_id)) 455 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,poor_soils_g)) 456 !- 457 !IF (ok_pc) THEN 456 !- 457 IF (ok_pc) THEN 458 458 !- Permafrost variables (zz_deep and zz_coef_deep are constants) 459 !ALLOCATE (zz_deep(ndeep))460 !ALLOCATE (zz_coef_deep(ndeep))459 ! ALLOCATE (zz_deep(ndeep)) 460 ! ALLOCATE (zz_coef_deep(ndeep)) 461 461 ALLOCATE (z_organic_g(nbp_glo), stat=ier) 462 462 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'z_organic_g : error in memory allocation', '', '') 463 463 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'zz_deep',v_id)) 464 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,zz_deep , start=(/1/) , count=(/ndeep/)))464 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,zz_deep)) 465 465 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'zz_coef_deep',v_id)) 466 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,zz_coef_deep, start=(/1/) , count=(/ndeep/))) 467 IF (ok_pc) THEN 466 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,zz_coef_deep)) 468 467 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'z_organic',v_id)) 469 468 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,z_organic_g)) … … 485 484 IF (.NOT. ok_peat) THEN 486 485 taboo_vars ='$lon$ $lat$ $lev$ $nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$ '// & 487 & '$day_counter$ $dt_days$ $date$ $carbon_32l_a$ $carbon_32l_s$ '// & 488 & '$carbon_32l_p$ $freedoc$ $adsdoc$ $altmax$ ' 486 & '$day_counter$ $dt_days$ $date$ $carbon$ ' 489 487 ENDIF 490 488 IF (ok_peat) THEN 491 489 taboo_vars = '$lon$ $lat$ $lev$ $nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$'// & 492 & '$day_counter$ $dt_days$ $date$ $carbon_32l_a$ $carbon_32l_s$ '// & 493 & '$carbon_32l_p$ $freedoc$ $adsdoc$ $carbon_acro$ $carbon_cato$ $height_acro$ '// & 494 & '$altmax$ $deepC_peat$' 490 & '$day_counter$ $dt_days$ $date$ $carbon$'// & 491 & '$carbon_acro$ $carbon_cato$ $height_acro$ ' 495 492 ENDIF 496 493 !- … … 630 627 CALL tlen2itau(time_str, dt_forcesoil*one_day, date0, itau_len) 631 628 write(numout,*) 'Number of time steps to do: ',itau_len 632 CALL control_initialize(dt_sechiba) 633 634 ! 1. Read the number of PFTs 635 ! 636 !Config Key = NVM 637 !Config Desc = number of PFTs 638 !Config If = OK_SECHIBA or OK_STOMATE 639 !Config Def = 13 640 !Config Help = The number of vegetation types define by the user 641 !Config Units = [-] 642 CALL getin_p('NVM',nvm) 643 644 645 ! 2. Allocation 646 ! ALLOCATE(pft_to_mtc(nvm),stat=ier) 647 ! IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'pft_to_mtc : error in memory allocation', '', '') 648 649 ! 3. Initialisation of the correspondance table 650 pft_to_mtc(:) = undef_int 651 652 ! 4.Reading of the conrrespondance table in the .def file 653 ! 654 !Config Key = PFT_TO_MTC 655 !Config Desc = correspondance array linking a PFT to MTC 656 !Config if = OK_SECHIBA or OK_STOMATE 657 !Config Def = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 658 !Config Help = 659 !Config Units = [-] 660 CALL getin_p('PFT_TO_MTC',pft_to_mtc) 661 662 663 ! 4.1 if nothing is found, we use the standard configuration 664 !!!qcj++ peatland 665 IF (ok_peat .OR. perma_peat) THEN 666 IF(nvm <= nvmc ) THEN 667 IF(pft_to_mtc(1) == undef_int) THEN 668 pft_to_mtc(:) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ,15/) 669 ENDIF 670 ENDIF 671 ELSE 672 IF(nvm <= nvmc ) THEN 673 IF(pft_to_mtc(1) == undef_int) THEN 674 WRITE(numout,*) 'Note to the user : we will use ORCHIDEE to its standard configuration' 675 pft_to_mtc(:) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /) 676 ENDIF 677 ELSE 678 IF(pft_to_mtc(1) == undef_int) THEN 679 WRITE(numout,*)' The array PFT_TO_MTC is empty : we stop' 680 ENDIF 681 ENDIF 682 ENDIF 683 684 685 ! 4.2 What happened if pft_to_mtc(j) > nvmc (if the mtc doesn't exist)? 686 DO i = 1, nvm 687 IF(pft_to_mtc(i) > nvmc) THEN 688 CALL ipslerr_p(3, 'forcesoil', 'the MTC you chose doesnt exist', 'we stop reading pft_to_mtc', '') 689 ENDIF 690 ENDDO 691 692 ! 4.3 Check if pft_to_mtc(1) = 1 693 IF(pft_to_mtc(1) /= 1) THEN 694 CALL ipslerr_p(3, 'forcesoil', 'the first pft has to be the bare soil', 'we stop reading next values of pft_to_mtc', '') 695 ENDIF 696 697 DO i = 2,nvm 698 IF(pft_to_mtc(i) == 1) THEN 699 CALL ipslerr_p(3, 'forcesoil', 'only pft_to_mtc(1) has to be the bare soil', 'we stop reading next values of pft_to_mtc', '') 700 ENDIF 701 ENDDO 702 703 ! 5. Allocate and initialize natural and is_c4 704 705 ! 5.1 Memory allocation 706 !ALLOCATE(natural(nvm),stat=ier) 707 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'natural : error in memory allocation', '', '') 708 709 !ALLOCATE(is_c4(nvm),stat=ier) 710 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'is_c4 : error in memory allocation', '', '') 711 712 !ALLOCATE(permafrost_veg_exists(nvm),stat=ier) 713 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'permafrost_veg_exists : error in memory allocation', '', '') 714 715 !!!qcj++ peatland 716 !ALLOCATE(is_peat(nvm),stat=ier) 717 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'is_peat : error in memory allocation', '', '') 718 DO i = 1, nvm 719 is_peat(i) = is_peat_mtc(pft_to_mtc(i)) 720 ENDDO 721 722 723 ! 5.2 Initialisation 724 DO i = 1, nvm 725 natural(i) = natural_mtc(pft_to_mtc(i)) 726 is_c4(i) = is_c4_mtc(pft_to_mtc(i)) 727 ENDDO 728 729 DO i = 1, nvm 730 permafrost_veg_exists(i) = permafrost_veg_exists_mtc(pft_to_mtc(i)) 731 ENDDO 629 732 630 733 631 ! read soil carbon stocks values stored in the input restart file 734 632 !- 735 633 IF (.NOT. ok_pc) THEN 736 ALLOCATE(carbon_32l_g(nbp_glo,ncarb,nvm,ndeep), stat=ier) 737 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'carbon_32l_g : error in memory allocation', '', '') 738 carbon_32l_g(:,:,:,:) = val_exp 739 var_name = 'carbon_32l_a' 740 CALL restget (rest_id_sto, var_name, nbp_glo, nvm, ndeep, itau_dep, & 741 & .TRUE., carbon_32l_g(:,iactive,:,:), 'gather', nbp_glo, indices_g) 742 743 var_name = 'carbon_32l_s' 744 CALL restget (rest_id_sto, var_name, nbp_glo, nvm, ndeep, itau_dep, & 745 & .TRUE., carbon_32l_g(:,islow,:,:), 'gather', nbp_glo, indices_g) 746 var_name = 'carbon_32l_p' 747 CALL restget (rest_id_sto, var_name, nbp_glo, nvm, ndeep, itau_dep, & 748 & .TRUE., carbon_32l_g(:,ipassive,:,:), 'gather', nbp_glo, indices_g) 749 IF (ALL(carbon_32l_g == val_exp)) carbon_32l_g = zero 750 751 752 ALLOCATE(DOC_g(nbp_glo,nvm,ndeep,ndoc,npool,nelements), stat=ier) 753 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'DOC_g : error in memory allocation', '', '') 754 DOC_g(:,:,:,:,:,:) = val_exp 755 var_name = 'freedoc' 756 CALL restget (rest_id_sto, var_name, nbp_glo, nvm, ndeep, npool, nelements, itau_dep, & 757 & .TRUE., DOC_g(:,:,:,ifree,:,:), 'gather', nbp_glo, indices_g) 758 IF (ALL(DOC_g(:,:,:,ifree,:,:)== val_exp))DOC_g(:,:,:,ifree,:,:) = zero 759 760 var_name = 'adsdoc' 761 CALL restget (rest_id_sto, var_name, nbp_glo, nvm ,ndeep, npool, nelements, itau_dep, & 762 & .TRUE., DOC_g(:,:,:,iadsorbed,:,:), 'gather', nbp_glo, indices_g) 763 IF (ALL(DOC_g(:,:,:,iadsorbed,:,:)== val_exp))DOC_g(:,:,:,iadsorbed,:,:) = zero 764 765 ALLOCATE(altmax_g(nbp_glo,nvm), stat=ier) 766 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'altmax_g : error in memory allocation', '', '') 767 var_name= 'altmax' 768 altmax_g(:,:) = val_exp 769 CALL restget (rest_id_sto, var_name, nbp_glo, nvm, 1, itau_dep, .TRUE., altmax_g, "gather", nbp_glo, indices_g) 770 IF ( ALL( altmax_g(:,:) .EQ. val_exp ) ) THEN 771 CALL ipslerr(3, 'forcesoil', 'altmax is not found in stomate restart file', '', '') 772 END IF 773 774 ! ALLOCATE(carbon_g(nbp_glo,ncarb,nvm), stat=ier) 775 ! IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'carbon_g : error in memory allocation', '', '') 776 ! carbon_g(:,:,:) = val_exp 777 ! CALL restget & 778 ! & (rest_id_sto, 'carbon', nbp_glo, ncarb , nvm, itau_dep, & 779 ! & .TRUE., carbon_g, 'gather', nbp_glo, indices_g) 780 ! IF (ALL(carbon_g == val_exp)) carbon_g = zero 634 ALLOCATE(carbon_g(nbp_glo,ncarb,nvm), stat=ier) 635 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'carbon_g : error in memory allocation', '', '') 636 carbon_g(:,:,:) = val_exp 637 CALL restget & 638 & (rest_id_sto, 'carbon', nbp_glo, ncarb , nvm, itau_dep, & 639 & .TRUE., carbon_g, 'gather', nbp_glo, indices_g) 640 IF (ALL(carbon_g == val_exp)) carbon_g = zero 781 641 ! WRITE(numout,*) "date0 : ",date0, itau_dep 782 642 … … 950 810 ALLOCATE(control_moist(kjpindex,nlevs,nparan*nbyear), stat=ier) 951 811 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'control_moist : error in memory allocation', '', '') 952 ALLOCATE(tprof(kjpindex,ndeep,nvm,nparan*nbyear), stat=ier)953 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'tprof : error in memory allocation', '', '')954 ALLOCATE(fbact(kjpindex,ndeep,nvm,nparan*nbyear), stat=ier)955 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'fbact : error in memory allocation', '', '')956 ALLOCATE(snowdz(kjpindex,nsnow,nparan*nbyear), stat=ier)957 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'snowdz_ : error in memory allocation', '', '')958 ALLOCATE(veget_max(kjpindex,nvm,nparan*nbyear), stat=ier)959 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'veget_max : error in memory allocation', '', '')960 812 ALLOCATE(soilcarbon_input(kjpindex,ncarb,nvm,nparan*nbyear), stat=ier) 961 813 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'soilcarbon_input : error in memory allocation', '', '') 962 ALLOCATE(soilcarbon_input_DOC(kjpindex,nvm,ndeep,npool,nelements,nparan*nbyear), stat=ier)963 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'soilcarbon_input_DOC : error in memory allocation', '', '')964 ALLOCATE(floodcarbon_input(kjpindex,nvm,npool,nelements,nparan*nbyear), stat=ier)965 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'floodcarbon_input : error in memory allocation', '', '')966 ALLOCATE(litter_above(kjpindex,nlitt,nvm,nelements,nparan*nbyear), stat=ier)967 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'litter_above : error in memory allocation', '', '')968 ALLOCATE(litter_below(kjpindex,nlitt,nvm,ndeep,nelements,nparan*nbyear), stat=ier)969 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'litter_below : error in memory allocation', '', '')970 ALLOCATE(lignin_struc_above(kjpindex,nvm,nparan*nbyear), stat=ier)971 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'lignin_struc_above : error in memory allocation', '', '')972 ALLOCATE(lignin_struc_below(kjpindex,nvm,ndeep,nparan*nbyear), stat=ier)973 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'lignin_struc_below : error in memory allocation', '', '')974 ALLOCATE(runoff_per_soil(kjpindex,nstm,nparan*nbyear), stat=ier)975 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'runoff_per_soil : error in memory allocation', '', '')976 ALLOCATE(runoff2peat(kjpindex,nstm,nparan*nbyear), stat=ier)977 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'runoff2peat : error in memory allocation', '', '')978 ALLOCATE(drainage_per_soil(kjpindex,nstm,nparan*nbyear), stat=ier)979 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'drainage_per_soil : error in memory allocation', '', '')980 ALLOCATE(wat_flux(kjpindex,nslm,nstm,nparan*nbyear), stat=ier)981 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'wat_flux : error in memory allocation', '', '')982 ALLOCATE(soil_mc_32l(kjpindex,ndeep,nstm,nparan*nbyear), stat=ier)983 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'soil_mc_32l : error in memory allocation', '', '')984 ALLOCATE(soil_mc(kjpindex,nslm,nstm,nparan*nbyear), stat=ier)985 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'soil_mc : error in memory allocation', '', '')986 ALLOCATE(DOC_to_topsoil(kjpindex,nflow,nparan*nbyear), stat=ier)987 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'DOC_to_topsoil : error in memory allocation', '', '')988 ALLOCATE(precip2ground(kjpindex,nvm,nparan*nbyear), stat=ier)989 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'precip2ground : error in memory allocation', '', '')990 ALLOCATE(interception_storage(kjpindex,nvm,nelements,nparan*nbyear), stat=ier)991 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'interception_storage : error in memory allocation', '', '')992 ALLOCATE(biomass(kjpindex,nvm,nparts,nelements,nparan*nbyear), stat=ier)993 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'biomass : error in memory allocation', '', '')994 ALLOCATE(fastr(kjpindex,nparan*nbyear), stat=ier)995 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'fastr : error in memory allocation', '', '')996 ALLOCATE(precip2canopy(kjpindex,nvm,nparan*nbyear), stat=ier)997 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'precip2canopy : error in memory allocation', '', '')998 ALLOCATE(canopy2ground(kjpindex,nvm,nparan*nbyear), stat=ier)999 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'canopy2ground : error in memory allocation', '', '')1000 ALLOCATE(DOC_to_subsoil(kjpindex,nflow,nparan*nbyear), stat=ier)1001 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'DOC_to_subsoil : error in memory allocation', '', '')1002 ALLOCATE(flood_frac(kjpindex,nparan*nbyear), stat=ier)1003 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'flood_frac : error in memory allocation', '', '')1004 ALLOCATE(lalo(kjpindex,2), stat=ier)1005 IF (ier /= 0) CALL ipslerr(3, 'forcesoil', 'lalo : error in memory allocation', '', '')1006 814 !- 1007 815 !!!qcj++ peatland … … 1016 824 ENDIF 1017 825 1018 start_2d=(/ nbp_mpi_para_begin(mpi_rank), 1 /)1019 count_2d=(/ nbp_mpi_para(mpi_rank), nparan*nbyear /)1020 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'fastr',v_id))1021 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,fastr, &1022 & start=start_2d, count=count_2d))1023 1024 start_2d=(/ nbp_mpi_para_begin(mpi_rank), 1 /)1025 count_2d=(/ nbp_mpi_para(mpi_rank), nparan*nbyear /)1026 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'flood_frac',v_id))1027 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,flood_frac, &1028 & start=start_2d, count=count_2d))1029 1030 start_2d=(/ nbp_mpi_para_begin(mpi_rank), 1 /)1031 count_2d=(/ nbp_mpi_para(mpi_rank), 2 /)1032 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'lalo',v_id))1033 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,lalo, &1034 & start=start_2d, count=count_2d))1035 1036 start_3d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1 /)1037 count_3d = (/ nbp_mpi_para(mpi_rank), nflow, nparan*nbyear /)1038 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'DOC_to_subsoil',v_id))1039 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,DOC_to_subsoil, &1040 & start = start_3d, count = count_3d))1041 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'DOC_to_topsoil',v_id))1042 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,DOC_to_topsoil, &1043 & start = start_3d, count = count_3d))1044 start_3d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1 /)1045 count_3d = (/ nbp_mpi_para(mpi_rank), nvm, nparan*nbyear /)1046 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'canopy2ground',v_id))1047 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,canopy2ground, &1048 & start = start_3d, count = count_3d))1049 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'precip2canopy',v_id))1050 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,precip2canopy, &1051 & start = start_3d, count = count_3d))1052 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'veget_max',v_id))1053 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,veget_max, &1054 & start = start_3d, count = count_3d))1055 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'precip2ground',v_id))1056 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,precip2ground, &1057 & start = start_3d, count = count_3d))1058 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'lignin_struc_above',v_id))1059 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,lignin_struc_above, &1060 & start = start_3d, count = count_3d))1061 start_3d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1 /)1062 count_3d = (/ nbp_mpi_para(mpi_rank), nstm, nparan*nbyear /)1063 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'drainage_per_soil',v_id))1064 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,drainage_per_soil, &1065 & start = start_3d, count = count_3d))1066 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'runoff2peat',v_id))1067 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,runoff2peat, &1068 & start = start_3d, count = count_3d))1069 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'runoff_per_soil',v_id))1070 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,runoff_per_soil, &1071 & start = start_3d, count = count_3d))1072 !1073 826 start_4d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1 /) 1074 count_4d = (/ nbp_mpi_para(mpi_rank), nslm, nstm, nparan*nbyear /) 1075 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'wat_flux',v_id)) 1076 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,wat_flux, & 1077 & start = start_4d, count = count_4d )) 1078 1079 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'soil_mc',v_id)) 1080 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,soil_mc, & 1081 & start = start_4d, count = count_4d )) 1082 1083 start_4d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1 /) 1084 count_4d = (/ nbp_mpi_para(mpi_rank), ndeep, nstm, nparan*nbyear /) 1085 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'soil_mc_32l',v_id)) 1086 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,soil_mc_32l, & 1087 & start = start_4d, count = count_4d )) 1088 1089 start_4d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1 /) 1090 count_4d = (/ nbp_mpi_para(mpi_rank), nvm, nelements, nparan*nbyear /) 1091 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'interception_storage',v_id)) 1092 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,interception_storage, & 1093 & start = start_4d, count = count_4d )) 1094 1095 start_4d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1 /) 1096 count_4d = (/ nbp_mpi_para(mpi_rank), nvm, ndeep, nparan*nbyear /) 1097 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'lignin_struc_below',v_id)) 1098 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,lignin_struc_below, & 827 count_4d = (/ nbp_mpi_para(mpi_rank), ncarb, nvm, nparan*nbyear /) 828 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'soilcarbon_input',v_id)) 829 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,soilcarbon_input, & 1099 830 & start = start_4d, count = count_4d )) 1100 831 ! 1101 start_5d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1, 1 /) 1102 count_5d = (/ nbp_mpi_para(mpi_rank), nvm, nparts, nelements, nparan*nbyear /) 1103 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'biomass',v_id)) 1104 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,biomass, & 1105 & start = start_5d, count = count_5d )) 1106 1107 start_5d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1, 1 /) 1108 count_5d = (/ nbp_mpi_para(mpi_rank), nlitt, nvm, nelements, nparan*nbyear /) 1109 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'litter_above',v_id)) 1110 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,litter_above, & 1111 & start = start_5d, count = count_5d )) 1112 1113 start_5d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1, 1 /) 1114 count_5d = (/ nbp_mpi_para(mpi_rank), nvm, npool, nelements, nparan*nbyear /) 1115 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'floodcarbon_input',v_id)) 1116 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,floodcarbon_input, & 1117 & start = start_5d, count = count_5d )) 1118 start_6d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1, 1, 1 /) 1119 count_6d = (/ nbp_mpi_para(mpi_rank), nvm, ndeep, npool, nelements, nparan*nbyear /) 1120 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'soilcarbon_input_DOC',v_id)) 1121 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,soilcarbon_input_DOC, & 1122 & start = start_6d, count = count_6d )) 1123 1124 start_6d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1, 1, 1, 1 /) 1125 count_6d = (/ nbp_mpi_para(mpi_rank), nlitt, nvm, ndeep, nelements, nparan*nbyear /) 1126 CALL nccheck( NF90_INQ_VARID (Cforcing_id,'litter_below',v_id)) 1127 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,litter_below, & 1128 & start = start_6d, count = count_6d )) 1129 ! start_3d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1 /) 1130 ! count_3d = (/ nbp_mpi_para(mpi_rank), nlevs, nparan*nbyear /) 1131 ! CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'control_moist',v_id)) 1132 ! CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,control_moist, & 1133 ! & start = start_3d, count = count_3d)) 1134 ! CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'control_temp',v_id)) 1135 ! CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,control_temp, & 1136 ! & start = start_3d, count = count_3d)) 832 start_3d = (/ nbp_mpi_para_begin(mpi_rank), 1, 1 /) 833 count_3d = (/ nbp_mpi_para(mpi_rank), nlevs, nparan*nbyear /) 834 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'control_moist',v_id)) 835 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,control_moist, & 836 & start = start_3d, count = count_3d)) 837 CALL nccheck( NF90_INQ_VARID (Cforcing_id, 'control_temp',v_id)) 838 CALL nccheck( NF90_GET_VAR (Cforcing_id,v_id,control_temp, & 839 & start = start_3d, count = count_3d)) 1137 840 !- Close Netcdf carbon permafrost file reference 1138 841 CALL nccheck( NF90_CLOSE (Cforcing_id)) … … 1196 899 ALLOCATE(clay(kjpindex), stat=ier) 1197 900 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'clay : error in memory allocation', '', '') 1198 ALLOCATE(bulk_dens(kjpindex), stat=ier)1199 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'bulk_dens : error in memory allocation', '', '')1200 ALLOCATE(soil_ph(kjpindex), stat=ier)1201 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'soil_ph : error in memory allocation', '', '')1202 ALLOCATE(poor_soils(kjpindex), stat=ier)1203 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'poor_soils : error in memory allocation', '', '')1204 901 ALLOCATE(carbon(kjpindex,ncarb,nvm), stat=ier) 1205 902 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'indices : error in memory allocation', '', '') 1206 ALLOCATE(carbon_32l(kjpindex,ncarb,nvm,ndeep), stat=ier)1207 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'indices : error in memory allocation', '', '')1208 ALLOCATE(DOC(kjpindex,nvm,ndeep,ndoc,npool,nelements), stat=ier)1209 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'indices : error in memory allocation', '', '')1210 1211 903 !- 1212 904 IF (.NOT. ok_pc) THEN … … 1215 907 ! ALLOCATE(control_moist(kjpindex,nlevs,nparan*nbyear), stat=ier) 1216 908 ! IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'control_moist : error in memory allocation', '', '') 1217 ALLOCATE(resp_flood_soil(kjpindex,nvm), stat=ier) 1218 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'resp_flood_soil : error in memory allocation', '', '') 1219 ALLOCATE(dry_dep_canopy(kjpindex,nvm,nelements), stat=ier) 1220 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'dry_dep_canopy : error in memory allocation', '', '') 1221 ALLOCATE(DOC_precip2ground(kjpindex,nvm,nelements), stat=ier) 1222 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'DOC_precip2ground : error in memory allocation', '', '') 1223 ALLOCATE(DOC_precip2canopy(kjpindex,nvm,nelements), stat=ier) 1224 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'DOC_precip2canopy : error in memory allocation', '', '') 1225 ALLOCATE(DOC_canopy2ground(kjpindex,nvm,nelements), stat=ier) 1226 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'DOC_canopy2ground : error in memory allocation', '', '') 1227 ALLOCATE(DOC_EXP(kjpindex,nvm,nexp,npool,nelements), stat=ier) 1228 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'DOC_EXP : error in memory allocation', '', '') 1229 ALLOCATE(altmax(kjpindex,nvm), stat=ier) 1230 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'altmax : error in memory allocation', '', '') 909 ALLOCATE(resp_hetero_soil(kjpindex,nvm), stat=ier) 910 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'resp_hetero_soil : error in memory allocation', '', '') 1231 911 ALLOCATE(matrixA(kjpindex,nvm,nbpools,nbpools), stat=ier) 1232 912 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'matrixA : error in memory allocation', '', '') 1233 IF (perma_peat) THEN1234 ALLOCATE(deepC_peat(kjpindex,ndeep,nvm), stat=ier)1235 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'deepC_peat : error in memory allocation', '', '')1236 ENDIF1237 !ALLOCATE(diaglev(nslm), stat=ier)1238 !IF (ier /= 0) CALL ipslerr_p(3,'forcesoil','Pb in allocation of diaglev','','')1239 !diaglev=znt(1:nslm)1240 1241 913 DO i = 1,nbpools 1242 914 matrixA(:,:,i,i) = un … … 1289 961 !- 1290 962 CALL Scatter(clay_g,clay) 1291 CALL Scatter(bulk_dens_g,bulk_dens) 1292 CALL Scatter(soil_ph_g,soil_ph) 1293 CALL Scatter(poor_soils_g,poor_soils) 1294 CALL Scatter(altmax_g,altmax) 1295 1296 DO i=1,nelements 1297 DO j= 1,npool 1298 CALL Scatter(DOC_g(:,:,:,:,j,i),DOC(:,:,:,:,j,i)) 1299 ENDDO 1300 ENDDO 1301 CALL Scatter(carbon_32l_g,carbon_32l) 1302 ! CALL Scatter(carbon_g,carbon) 963 CALL Scatter(carbon_g,carbon) 1303 964 !!!qcj peatland++ 1304 965 IF (ok_peat) THEN … … 1417 1078 !!- 1418 1079 1419 ALLOCATE(fixed_cryoturbation_depth(kjpindex,nvm), stat=ier) 1420 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', '2fixed_cryoturbation_depth : error in memory allocation', '', '') 1421 ALLOCATE(resp_hetero_soil(kjpindex, nvm), stat=ier) 1422 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'resp_hetero_soil : error in memory allocation', '', '') 1423 IF (ok_pc) THEN 1424 ALLOCATE(heat_Zimov(kjpindex,ndeep,nvm), stat=ier) 1425 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'heat_Zimov : error in memory allocation', '', '') 1426 ALLOCATE(sfluxCH4_deep(kjpindex), stat=ier) 1427 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'sfluxCH4_deep : error in memory allocation', '', '') 1428 ALLOCATE(sfluxCO2_deep(kjpindex), stat=ier) 1429 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'sfluxCO2_deep : error in memory allocation', '', '') 1430 ENDIF 1431 1432 IF (.NOT. ok_pc) THEN 1080 1081 IF (.NOT.ok_pc) THEN 1433 1082 iatt=0 1434 1083 iyear=1 … … 1436 1085 iatt = iatt+1 1437 1086 IF (iatt > nparan*nbyear) THEN 1438 IF (printlev>=3) WRITE(*,*) "iyear",iyear 1439 IF (printlev>=3) WRITE(*,*) "iatt",iatt 1440 IF (printlev>=3) WRITE(*,*) "nparan*nbyear",nparan*nbyear 1087 IF (printlev>=3) WRITE(numout,*) iyear 1441 1088 iatt = 1 1442 1089 iyear=iyear+1 1443 1090 ENDIF 1444 IF (ok_leak) THEN 1445 !WRITE(*,*) "altmax",altmax(:,:) 1446 !WRITE(*,*) "altmax_g",altmax_g(:,:) 1447 !WRITE(*,*) "zz_coef_deep",zz_coef_deep(:) 1448 !WRITE(*,*) "diaglev",diaglev(:) 1449 !WRITE(*,*) "lalo", lalo(:,:) 1450 !WRITE(*,*) "nslm",nslm 1451 !WRITE(*,*) "nstm",nstm 1452 !WRITE(*,*) "nvm",nvm 1453 !WRITE(*,*) " nparts",nparts 1454 !WRITE(*,*) " nelements",nelements 1455 !WRITE(*,*) " ndeep",ndeep 1456 CALL soilcarbon_leak (kjpindex, dt_forcesoil*one_day, zz_coef_deep, clay, force_soil, & 1457 soilcarbon_input(:,:,:,iatt), soilcarbon_input_DOC(:,:,:,:,:,iatt), floodcarbon_input(:,:,:,:,iatt), & 1458 carbon, carbon_32l, & 1459 resp_hetero_soil, resp_flood_soil, & 1460 !!Permafrost carbon variables added here: 1461 altmax, lalo, & 1462 iatt, zz_deep, & 1463 snowdz(:,:,iatt), fixed_cryoturbation_depth, & 1464 !!MICT END 1465 litter_above(:,:,:,:,iatt),litter_below(:,:,:,:,:,iatt),& 1466 DOC, DOC_EXP, & 1467 lignin_struc_above(:,:,iatt), lignin_struc_below(:,:,:,iatt), & 1468 runoff_per_soil(:,:,iatt), runoff2peat(:,:,iatt), drainage_per_soil(:,:,iatt), wat_flux(:,:,:,iatt), & 1469 bulk_dens, soil_ph, poor_soils, veget_max, fbact(:,:,:,iatt), tprof(:,:,:,iatt), & 1470 soil_mc_32l(:,:,:,iatt), soil_mc(:,:,:,iatt),& 1471 DOC_to_topsoil(:,:,iatt), DOC_to_subsoil(:,:,iatt), flood_frac(:,iatt), & 1472 precip2ground(:,:,iatt), precip2canopy(:,:,iatt), canopy2ground(:,:,iatt), & 1473 dry_dep_canopy, DOC_precip2ground, DOC_precip2canopy, DOC_canopy2ground, & 1474 interception_storage, biomass, fastr,& 1475 deepC_peat) 1476 ELSE 1477 1478 CALL soilcarbon & 1479 & (kjpindex, dt_forcesoil, clay, & 1480 & soilcarbon_input(:,:,:,iatt), & 1481 & control_temp(:,:,iatt), control_moist(:,:,iatt), & 1482 & carbon, resp_hetero_soil, & 1483 & matrixA, & 1484 !!!qcj++ peatland 1485 & height_acro,height_cato,carbon_acro,carbon_cato,tcarbon_acro,tcarbon_cato,resp_acro_oxic,& 1486 & resp_acro_anoxic,resp_cato,acro_to_cato,litter_to_acro, wtp_pt(:,iatt)) 1487 ENDIF 1091 CALL soilcarbon & 1092 & (kjpindex, dt_forcesoil, clay, & 1093 & soilcarbon_input(:,:,:,iatt), & 1094 & control_temp(:,:,iatt), control_moist(:,:,iatt), & 1095 & carbon, resp_hetero_soil, & 1096 & matrixA, & 1097 !!!qcj++ peatland 1098 & height_acro,height_cato,carbon_acro,carbon_cato,tcarbon_acro,tcarbon_cato,resp_acro_oxic,& 1099 & resp_acro_anoxic,resp_cato,acro_to_cato,litter_to_acro, wtp_pt(:,iatt)) 1100 1488 1101 ENDDO 1489 1102 WRITE(numout,*) "End of soilcarbon LOOP." … … 1492 1105 !these variables are only ouputs from deep_carbcycle (thus not necessary for 1493 1106 !Gather and Scatter) 1494 !ALLOCATE(heat_Zimov(kjpindex,ndeep,nvm), stat=ier)1495 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'heat_Zimov : error in memory allocation', '', '')1496 !ALLOCATE(sfluxCH4_deep(kjpindex), stat=ier)1497 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'sfluxCH4_deep : error in memory allocation', '', '')1498 !ALLOCATE(sfluxCO2_deep(kjpindex), stat=ier)1499 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'sfluxCO2_deep : error in memory allocation', '', '')1500 !ALLOCATE(fixed_cryoturbation_depth(kjpindex,nvm), stat=ier)1501 ! IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', '2fixed_cryoturbation_depth : error in memory allocation', '', '')1502 !ALLOCATE(resp_hetero_soil(kjpindex, nvm), stat=ier)1503 !IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'resp_hetero_soil : error in memory allocation', '', '')1107 ALLOCATE(heat_Zimov(kjpindex,ndeep,nvm), stat=ier) 1108 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'heat_Zimov : error in memory allocation', '', '') 1109 ALLOCATE(sfluxCH4_deep(kjpindex), stat=ier) 1110 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'sfluxCH4_deep : error in memory allocation', '', '') 1111 ALLOCATE(sfluxCO2_deep(kjpindex), stat=ier) 1112 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'sfluxCO2_deep : error in memory allocation', '', '') 1113 ALLOCATE(fixed_cryoturbation_depth(kjpindex,nvm), stat=ier) 1114 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'fixed_cryoturbation_depth : error in memory allocation', '', '') 1115 ALLOCATE(resp_hetero_soil(kjpindex, nvm), stat=ier) 1116 IF (ier /= 0) CALL ipslerr_p(3, 'forcesoil', 'resp_hetero_soil : error in memory allocation', '', '') 1504 1117 1505 1118 iatt = 0 … … 1528 1141 !! 3. write new carbon stocks into the ouput restart file 1529 1142 !!- 1530 ! CALL restput_p (rest_id_sto, 'carbon', nbp_glo, ncarb , nvm, itau_dep, & 1531 ! & carbon, 'scatter', nbp_glo, indices_g) 1532 1533 CALL restput_p (rest_id_sto, 'carbon_32l_a', nbp_glo, nvm, ndeep, itau_dep, & 1534 & carbon_32l(:,iactive,:,:), 'scatter', nbp_glo, indices_g) 1535 CALL restput_p (rest_id_sto, 'carbon_32l_s', nbp_glo, nvm, ndeep, itau_dep, & 1536 & carbon_32l(:,islow,:,:), 'scatter', nbp_glo, indices_g) 1537 CALL restput_p (rest_id_sto, 'carbon_32l_p', nbp_glo, nvm, ndeep, itau_dep, & 1538 & carbon_32l(:,ipassive,:,:), 'scatter', nbp_glo, indices_g) 1539 CALL restput_p (rest_id_sto, 'freedoc', nbp_glo, nvm , ndeep, npool, nelements, itau_dep, & 1540 & DOC(:,:,:,ifree,:,:), 'scatter', nbp_glo, indices_g) 1541 CALL restput_p (rest_id_sto, 'adsdoc', nbp_glo, nvm , ndeep, npool, nelements, itau_dep, & 1542 & DOC(:,:,:,iadsorbed,:,:), 'scatter', nbp_glo, indices_g) 1143 CALL restput_p (rest_id_sto, 'carbon', nbp_glo, ncarb , nvm, itau_dep, & 1144 & carbon, 'scatter', nbp_glo, indices_g) 1543 1145 1544 1146 !!!qcj++ peatland … … 1568 1170 & CH4_snow, 'scatter', nbp_glo, indices_g) 1569 1171 CALL restput_p (rest_id_sto, 'altmax', nbp_glo, nvm, 1, itau_dep, & 1570 & altmax, 'scatter', nbp_glo, indices_g) 1571 ENDIF 1572 1172 & altmax, 'scatter', nbp_glo, indices_g) 1573 1173 IF (perma_peat) THEN 1574 1174 CALL restput_p (rest_id_sto, 'deepC_peat', nbp_glo, ndeep, nvm, itau_dep, & 1575 1175 deepC_peat, 'scatter', nbp_glo, indices_g) 1576 1176 ENDIF 1577 1177 ENDIF 1578 1178 !- 1579 1179 IF (is_root_prc) THEN … … 1586 1186 CALL MPI_FINALIZE(ier) 1587 1187 #endif 1588 WRITE( *,*) "End of forcesoil."1188 WRITE(numout,*) "End of forcesoil." 1589 1189 !-------------------- 1590 1190 END PROGRAM forcesoil -
branches/publications/ORCHIDEE-PEAT_r5488/src_stomate/lpj_cover.f90
r6890 r6892 176 176 177 177 DO j = 2,nvm ! loop over PFTs 178 IF ( natural(j) .AND. .NOT. pasture(j) .AND. .NOT. is_peat(j)) THEN178 IF ( natural(j) .AND. .NOT. pasture(j) ) THEN 179 179 180 180 ! Summation of individual tree crown area to get total foliar projected coverage … … 198 198 199 199 DO j = 2,nvm ! loop over PFTs 200 IF( natural(j) .AND. .NOT. pasture(j) .AND. .NOT. is_peat(j)) THEN200 IF( natural(j) .AND. .NOT. pasture(j)) THEN 201 201 veget_max(i,j) = veget_max(i,j) * frac_nat(i) / sum_veget_natveg(i) 202 202 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
