From d3c7f41b3e3e2940bc978ea4f1a237ce0a372da5 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sat, 14 Dec 2024 11:30:40 +0800 Subject: [PATCH 01/10] modify initialization of soil state. --- mkinidata/MOD_Initialize.F90 | 33 +++++++++++++++++++++++---------- share/MOD_Namelist.F90 | 18 ++++++++++++++++++ 2 files changed, 41 insertions(+), 10 deletions(-) diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index f3cb9b62..5b2ab22d 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -723,8 +723,15 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & IF (DEF_USE_SoilInit) THEN fsoildat = DEF_file_SoilInit + IF (p_is_master) THEN inquire (file=trim(fsoildat), exist=use_soilini) + IF (use_soilini) THEN + write(*,'(/,2A)') 'Use soil water content, soil temperature and water table depth ' & + // 'to initialize soil state from file ', trim(fsoildat) + ELSE + write(*,*) 'No initial data for soil state from ', trim(fsoildat) + ENDIF ENDIF #ifdef USEMPI CALL mpi_bcast (use_soilini, 1, MPI_LOGICAL, p_address_master, p_comm_glb, p_err) @@ -1081,19 +1088,25 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! for SOIL Water INIT by using water table depth - fwtd = trim(DEF_dir_runtime) // '/wtd.nc' - IF (p_is_master) THEN - inquire (file=trim(fwtd), exist=use_wtd) - IF (use_soilini) use_wtd = .false. - IF (use_wtd) THEN - write(*,'(/, 2A)') 'Use water table depth and derived equilibrium state ' & - // ' to initialize soil water content: ', trim(fwtd) - ENDIF - ENDIF + use_wtd = (.not. use_soilini) .and. DEF_USE_WaterTableInit + + IF (use_wtd) THEN + fwtd = DEF_file_WaterTable + + IF (p_is_master) THEN + inquire (file=trim(fwtd), exist=use_wtd) + IF (use_wtd) THEN + write(*,'(/, 2A)') 'Use water table depth and derived equilibrium state ' & + // ' to initialize soil water content from file ', trim(fwtd) + ELSE + write(*,*) 'No initial data for water table depth from ', trim(fwtd) + ENDIF + ENDIF #ifdef USEMPI - CALL mpi_bcast (use_wtd, 1, MPI_LOGICAL, p_address_master, p_comm_glb, p_err) + CALL mpi_bcast (use_wtd, 1, MPI_LOGICAL, p_address_master, p_comm_glb, p_err) #endif + ENDIF IF (use_wtd) THEN diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index edcb5d0c..77b6377c 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -203,6 +203,9 @@ MODULE MOD_Namelist logical :: DEF_USE_CN_INIT = .false. character(len=256) :: DEF_file_cn_init = 'null' + logical :: DEF_USE_WaterTableInit = .false. + character(len=256) :: DEF_file_WaterTable = 'null' + ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! ----- Part 9: LULCC related ------ ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -935,6 +938,9 @@ SUBROUTINE read_namelist (nlfile) DEF_USE_CN_INIT, & DEF_file_cn_init, & + DEF_USE_WaterTableInit, & + DEF_file_WaterTable, & + DEF_file_snowoptics, & DEF_file_snowaging , & @@ -1240,6 +1246,15 @@ SUBROUTINE read_namelist (nlfile) #endif #endif +! ----- Soil water and temperature Initialization ----- Namelist conflicts + + IF (DEF_USE_SoilInit .and. DEF_USE_WaterTableInit) THEN + write(*,*) ' ***** ' + write(*,*) 'If both DEF_USE_SoilInit and DEF_USE_WaterTableInit are .TRUE., ' + write(*,*) 'initial value of water table depth is read from DEF_file_SoilInit,' + write(*,*) 'instead of DEF_file_WaterTable (which is useless in this CASE). ' + ENDIF + ! ----- dynamic lake run ----- Macros&Namelist conflicts and dependency management #ifndef CATCHMENT @@ -1411,6 +1426,9 @@ SUBROUTINE read_namelist (nlfile) CALL mpi_bcast (DEF_USE_CN_INIT ,1 ,mpi_logical ,p_address_master ,p_comm_glb ,p_err) CALL mpi_bcast (DEF_file_cn_init ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_WaterTableInit ,1 ,mpi_logical ,p_address_master ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_file_WaterTable ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_SNICAR ,1 ,mpi_logical ,p_address_master ,p_comm_glb ,p_err) CALL mpi_bcast (DEF_file_snowoptics ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) CALL mpi_bcast (DEF_file_snowaging ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) From fc9e13e9537e99cf5743344f94455eda480911d2 Mon Sep 17 00:00:00 2001 From: Xianxiang Li Date: Fri, 13 Dec 2024 16:49:12 +0800 Subject: [PATCH 02/10] Update build_CoLM_gnu.yml to use ubuntu 24.04 and 22.04 docker images have been changed ubuntu-latest into ubuntu 24.04 LTS --- .github/workflows/build_CoLM_gnu.yml | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/.github/workflows/build_CoLM_gnu.yml b/.github/workflows/build_CoLM_gnu.yml index 7048d4fb..bf938243 100644 --- a/.github/workflows/build_CoLM_gnu.yml +++ b/.github/workflows/build_CoLM_gnu.yml @@ -22,9 +22,10 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-latest, ubuntu-20.04] + os: [ubuntu-latest, ubuntu-22.04] mpi: ['mpich', 'openmpi', 'intelmpi'] toolchain: + - {compiler: gcc, version: 14} - {compiler: gcc, version: 13} - {compiler: gcc, version: 12} - {compiler: gcc, version: 11} @@ -34,10 +35,17 @@ jobs: # - os: ubuntu-latest # toolchain: {compiler: gcc, version: 12} exclude: - - os: ubuntu-20.04 - toolchain: {compiler: gcc, version: 12} + - os: ubuntu-22.04 + toolchain: {compiler: gcc, version: 14} + - mpi: 'mpich' + toolchain: {compiler: gcc, version: 9} + # mpich compiling FCFLAG has --fallow-type-mismatch, and will cause gfortran 9 failing - os: ubuntu-latest toolchain: {compiler: gcc, version: 9} + - os: ubuntu-latest + toolchain: {compiler: gcc, version: 10} + - os: ubuntu-latest + toolchain: {compiler: gcc, version: 11} steps: - uses: actions/checkout@v4 @@ -49,9 +57,9 @@ jobs: with: compiler: ${{ matrix.toolchain.compiler }} version: ${{ matrix.toolchain.version }} - - name: Install netcdf-fortran library + - name: Install netcdf-fortran and blas library shell: bash -l {0} - run: sudo apt update && sudo apt install -y netcdf-bin libnetcdf-dev libnetcdff-dev + run: sudo apt update && sudo apt install -y netcdf-bin libnetcdf-dev libnetcdff-dev "liblapack*" "libblas*" - name: Test mpi #run: mpif90 -v run: which mpif90 From 816fdf6694d704601b54de967fae68758b6eb4ce Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Thu, 19 Dec 2024 10:08:39 +0800 Subject: [PATCH 03/10] Bug fixed in river lake flow. --- main/HYDRO/MOD_Catch_RiverLakeFlow.F90 | 21 +++++++++++---------- main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 | 3 +++ 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 index 57271987..cf4e61fc 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeFlow.F90 @@ -454,21 +454,22 @@ SUBROUTINE river_lake_flow (dt) momen_riv_ta(:) = momen_riv_ta(:) + momen_riv(:) * dt_this discharge (:) = discharge (:) + hflux_fc (:) * dt_this ENDIF + + DO i = 1, nbasin + IF (lake_id(i) > 0) THEN ! for lakes + hs = basin_hru%substt(i) + he = basin_hru%subend(i) + DO j = hs, he + wdsrf_hru(j) = max(wdsrf_bsn(i) - (lakes(i)%depth(1) - lakes(i)%depth0(j-hs+1)), 0.) + wdsrf_hru_ta(j) = wdsrf_hru_ta(j) + wdsrf_hru(j) * dt_this + ENDDO + ENDIF + ENDDO dt_res = dt_res - dt_this ENDDO - DO i = 1, nbasin - IF (lake_id(i) > 0) THEN ! for lakes - hs = basin_hru%substt(i) - he = basin_hru%subend(i) - DO j = hs, he - wdsrf_hru(j) = max(wdsrf_bsn(i) - (lakes(i)%depth(1) - lakes(i)%depth0(j-hs+1)), 0.) - ENDDO - ENDIF - ENDDO - wdsrf_bsn_prev(:) = wdsrf_bsn(:) IF (allocated(wdsrf_bsn_ds )) deallocate(wdsrf_bsn_ds ) diff --git a/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 b/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 index 88340e47..44cc33e1 100644 --- a/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 +++ b/main/HYDRO/MOD_Catch_RiverLakeNetwork.F90 @@ -682,6 +682,9 @@ SUBROUTINE river_lake_network_init () IF (inb <= 0) THEN outletwth(ibasin) = 0 + IF (riverdown(ibasin) > 0) THEN + outletwth(ibasin) = 90. + ENDIF ELSE outletwth(ibasin) = elementneighbour(ibasin)%lenbdr(inb) ENDIF From 5a5566aa78bc394f348b4505dd6119c1f7d3d266 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Thu, 19 Dec 2024 18:46:25 +0800 Subject: [PATCH 04/10] Code optimization to CaMa. --- CaMa/src/MOD_CaMa_Vars.F90 | 2 +- CaMa/src/MOD_CaMa_colmCaMa.F90 | 30 +++++++++++++++++++++++++++--- CaMa/src/yos_cmf_input.F90 | 2 +- share/MOD_Namelist.F90 | 7 +++++++ 4 files changed, 36 insertions(+), 5 deletions(-) diff --git a/CaMa/src/MOD_CaMa_Vars.F90 b/CaMa/src/MOD_CaMa_Vars.F90 index 186ae616..371c3421 100644 --- a/CaMa/src/MOD_CaMa_Vars.F90 +++ b/CaMa/src/MOD_CaMa_Vars.F90 @@ -539,7 +539,7 @@ SUBROUTINE flux_map_and_write_2d_cama (is_hist, & IF (itime_in_file == 1) THEN CALL ncio_put_attr (file_hist, varname, 'long_name', longname) CALL ncio_put_attr (file_hist, varname, 'units', units) - CALL ncio_put_attr (file_hist, varname, 'missing_value',spval) + CALL ncio_put_attr (file_hist, varname, 'missing_value',real(real(spval,kind=JPRM),kind=8)) ENDIF END SUBROUTINE flux_map_and_write_2d_cama diff --git a/CaMa/src/MOD_CaMa_colmCaMa.F90 b/CaMa/src/MOD_CaMa_colmCaMa.F90 index 6883aba8..28ece200 100644 --- a/CaMa/src/MOD_CaMa_colmCaMa.F90 +++ b/CaMa/src/MOD_CaMa_colmCaMa.F90 @@ -28,7 +28,7 @@ MODULE MOD_CaMa_colmCaMa USE CMF_CTRL_OUTPUT_MOD, only: CMF_OUTPUT_INIT,CMF_OUTPUT_END,NVARSOUT,VAROUT USE YOS_CMF_INPUT, only: NXIN, NYIN, DT,DTIN,IFRQ_INP,LLEAPYR,NX,NY,RMIS,DMIS USE MOD_Precision, only: r8,r4 - USE YOS_CMF_INPUT , only: LROSPLIT,LWEVAP,LWINFILT + USE YOS_CMF_INPUT , only: LROSPLIT,LWEVAP,LWINFILT,CSETFILE USE YOS_CMF_MAP, only: D1LON, D1LAT USE YOS_CMF_INPUT, only: WEST,EAST,NORTH,SOUTH @@ -73,6 +73,11 @@ SUBROUTINE colm_CaMa_init #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif + + IF (p_is_master) THEN + + CSETFILE = DEF_CaMa_Namelist + !Namelist handling CALL CMF_DRV_INPUT !get the time information from colm namelist @@ -181,14 +186,33 @@ SUBROUTINE colm_CaMa_init END SELECT ENDDO + ENDIF + !Broadcast the variables to all the processors CALL mpi_bcast (NX , 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) ! number of grid points in x-direction of CaMa-Flood CALL mpi_bcast (NY , 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) ! number of grid points in y-direction of CaMa-Flood CALL mpi_bcast (IFRQ_INP , 1, MPI_INTEGER, p_address_master, p_comm_glb, p_err) ! input frequency of CaMa-Flood (hour) CALL mpi_bcast (LWEVAP , 1, MPI_LOGICAL, p_address_master, p_comm_glb, p_err) ! switch for inundation evaporation CALL mpi_bcast (LWINFILT , 1, MPI_LOGICAL, p_address_master, p_comm_glb, p_err) ! switch for inundation re-infiltration - CALL mpi_bcast (real(D1LAT,kind=8) , 1, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! - CALL mpi_bcast (real(D1LON,kind=8) , 1, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! + + IF (.not. allocated(D1LAT)) allocate (D1LAT(NY)) + IF (.not. allocated(D1LON)) allocate (D1LON(NX)) + +#ifdef SinglePrec_CMF + CALL mpi_bcast (D1LAT, NY, MPI_REAL4, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (D1LON, NX, MPI_REAL4, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (SOUTH, 1, MPI_REAL4, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (NORTH, 1, MPI_REAL4, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (WEST , 1, MPI_REAL4, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (EAST , 1, MPI_REAL4, p_address_master, p_comm_glb, p_err) ! +#else + CALL mpi_bcast (D1LAT, NY, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (D1LON, NX, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (SOUTH, 1, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (NORTH, 1, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (WEST , 1, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! + CALL mpi_bcast (EAST , 1, MPI_REAL8, p_address_master, p_comm_glb, p_err) ! +#endif !allocate the data structure for cama CALL gcama%define_by_center (D1LAT,D1LON,real(SOUTH,kind=8), real(NORTH,kind=8), real(WEST,kind=8), real(EAST,kind=8)) !define the grid for cama diff --git a/CaMa/src/yos_cmf_input.F90 b/CaMa/src/yos_cmf_input.F90 index 79681a0d..f2b24f1d 100644 --- a/CaMa/src/yos_cmf_input.F90 +++ b/CaMa/src/yos_cmf_input.F90 @@ -27,7 +27,7 @@ MODULE YOS_CMF_INPUT character(LEN=256) :: CSETFILE !! input namelist file name DATA LLOGOUT /.TRUE./ - DATA CLOGOUT /'../run/log_CaMa.txt'/ + DATA CLOGOUT /'./log_CaMa.txt'/ DATA CSETFILE /'../run/cama_flood.nml'/ !================================================ diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 0134d3ce..31f7bab9 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -304,6 +304,9 @@ MODULE MOD_Namelist !2: To allow monthly ndep data to be read in integer :: DEF_NDEP_FREQUENCY = 1 + ! ----- CaMa-Flood ----- + character(len=256) :: DEF_CaMa_Namelist = 'null' + ! ----- lateral flow related ----- logical :: DEF_USE_EstimatedRiverDepth = .true. character(len=256) :: DEF_ElementNeighbour_file = 'null' @@ -1002,6 +1005,8 @@ SUBROUTINE read_namelist (nlfile) DEF_file_snowoptics, & DEF_file_snowaging , & + DEF_CaMa_Namelist, & + DEF_ElementNeighbour_file, & DEF_DA_obsdir, & @@ -1499,6 +1504,8 @@ SUBROUTINE read_namelist (nlfile) CALL mpi_bcast (DEF_file_snowoptics ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) CALL mpi_bcast (DEF_file_snowaging ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_CaMa_Namelist ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_ElementNeighbour_file ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) CALL mpi_bcast (DEF_DA_obsdir ,256 ,mpi_character ,p_address_master ,p_comm_glb ,p_err) From 50702f2de378d26d1eda6a9bac2466b4ebc8c422 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sat, 21 Dec 2024 14:33:38 +0800 Subject: [PATCH 05/10] Add impedance factor to hydraulic conductivity in VSF. --- main/HYDRO/MOD_Catch_LateralFlow.F90 | 4 ++-- main/MOD_SoilSnowHydrology.F90 | 14 +++++++++++++- share/MOD_SPMD_Task.F90 | 3 ++- 3 files changed, 17 insertions(+), 4 deletions(-) diff --git a/main/HYDRO/MOD_Catch_LateralFlow.F90 b/main/HYDRO/MOD_Catch_LateralFlow.F90 index 65affa17..c3041a29 100644 --- a/main/HYDRO/MOD_Catch_LateralFlow.F90 +++ b/main/HYDRO/MOD_Catch_LateralFlow.F90 @@ -272,7 +272,7 @@ SUBROUTINE lateral_flow (deltime) CALL mpi_allreduce (MPI_IN_PLACE, toldis, 1, MPI_REAL8, MPI_SUM, p_comm_worker, p_err) #endif IF (p_iam_worker == 0) THEN - write(*,'(A,F10.5,A,ES10.3,A,ES10.3,A)') 'Total surface water error: ', dtolw, & + write(*,'(A,F10.2,A,ES10.3,A,ES10.3,A)') 'Total surface water error: ', dtolw, & '(m^3) in area ', landarea, '(m^2), discharge ', toldis, '(m^3)' ENDIF @@ -282,7 +282,7 @@ SUBROUTINE lateral_flow (deltime) CALL mpi_allreduce (MPI_IN_PLACE, dtolw, 1, MPI_REAL8, MPI_SUM, p_comm_worker, p_err) #endif IF (p_iam_worker == 0) THEN - write(*,'(A,F10.5,A,ES10.3,A)') 'Total ground water error: ', dtolw, & + write(*,'(A,F10.2,A,ES10.3,A)') 'Total ground water error: ', dtolw, & '(m^3) in area ', landarea, '(m^2)' ENDIF ENDIF diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 446bb2fb..313aa277 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -683,6 +683,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& type(cell_data_struct) :: cell real(r8) :: wliq_soisno_tmp(1:nl_soil) + real(r8), parameter :: e_ice=6.0 !soil ice impedance factor !======================================================================= ! [1] update the liquid water within snow layer and the water onto soil @@ -1020,6 +1021,16 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& ENDIF #endif + DO j = 1, nl_soil + IF(t_soisno(j) <= tfrz) THEN + ! consider impedance factor + vol_ice(j) = max(min(porsl(j), wice_soisno(j)/(dz_soisno(j)*denice)), 0.) + icefrac(j) = vol_ice(j)/porsl(j) + imped = 10.**(-e_ice*icefrac(j)) + hk(j) = imped * hk(j) + ENDIF + ENDDO + #ifndef CatchLateralFlow err_solver = (sum(wliq_soisno(1:))+sum(wice_soisno(1:))+wa+wdsrf) - w_sum & - (gwat-etr-rsur-rsubst)*deltim @@ -1044,7 +1055,8 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,is_dry_lake, lb, nl_soil, deltim ,& #if(defined CoLMDEBUG) IF(abs(err_solver) > 1.e-3)THEN - write(6,'(A,E20.5,I0)') 'Warning (WATER_VSF): water balance violation', err_solver,landpatch%eindex(ipatch) + write(6,'(A,E20.5,A,I0)') 'Warning (WATER_VSF): water balance violation', err_solver, & + ' in element ', landpatch%eindex(ipatch) ENDIF IF (any(wliq_soisno < -1.e-3)) THEN write(6,'(A,10E20.5)') 'Warning (WATER_VSF): negative soil water', wliq_soisno(1:nl_soil) diff --git a/share/MOD_SPMD_Task.F90 b/share/MOD_SPMD_Task.F90 index 3655ca8e..bd6a6d22 100644 --- a/share/MOD_SPMD_Task.F90 +++ b/share/MOD_SPMD_Task.F90 @@ -331,11 +331,12 @@ SUBROUTINE CoLM_stop (mesg) IMPLICIT NONE character(len=*), optional :: mesg + integer :: errorcode IF (present(mesg)) write(*,*) trim(mesg) #ifdef USEMPI - CALL mpi_abort (p_comm_glb, p_err) + CALL mpi_abort (p_comm_glb, errorcode, p_err) #else STOP #endif From cc1310fdc7642aad25025d57ddcb62b6079707f8 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Sat, 21 Dec 2024 17:04:13 +0800 Subject: [PATCH 06/10] constant ck0_igbp adjusted. --- main/MOD_Const_LC.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/MOD_Const_LC.F90 b/main/MOD_Const_LC.F90 index 0ec20e90..0591f7aa 100644 --- a/main/MOD_Const_LC.F90 +++ b/main/MOD_Const_LC.F90 @@ -596,7 +596,7 @@ MODULE MOD_Const_LC real(r8), parameter, dimension(N_land_classification) :: ck0_igbp & = (/3.95, 3.95, 3.95, 3.95, 3.95, 3.95, & 3.95, 3.95, 3.95, 3.95, 3.95, 3.95, & - 3.95, 3.95, 0., 0., 0. /) + 3.95, 3.95, 3.95, 3.95, 3.95 /) !end plant hydraulic parameters ! lambda for WUE stomata model From b6259957be05b6149715fed38ce1cfa015b6c5bb Mon Sep 17 00:00:00 2001 From: Xianxiang Li Date: Sat, 21 Dec 2024 16:19:15 +0800 Subject: [PATCH 07/10] Add compiling tests using intel compilers --- .github/workflows/build_CoLM_intel.yml | 125 +++++++++++++++++++++++++ include/Makeoptions.github.intel | 36 +++++++ 2 files changed, 161 insertions(+) create mode 100644 .github/workflows/build_CoLM_intel.yml create mode 100755 include/Makeoptions.github.intel diff --git a/.github/workflows/build_CoLM_intel.yml b/.github/workflows/build_CoLM_intel.yml new file mode 100644 index 00000000..f1956311 --- /dev/null +++ b/.github/workflows/build_CoLM_intel.yml @@ -0,0 +1,125 @@ +name: Build_CoLM202X_intel +on: + pull_request: + branches: + - master + paths-ignore: + - 'postprocess/**' + - 'preprocess/**' + - 'run/**' + - 'README.md' + - '.gitignore' + - '**/**.sh' + push: + branches: + - master + + workflow_dispatch: + +jobs: + Build-CoLM-intel: + runs-on: ${{ matrix.os }} + strategy: + fail-fast: false + matrix: + os: [ubuntu-latest, ubuntu-22.04] + mpi: ['mpich', 'openmpi', 'intelmpi'] + toolchain: + - {compiler: intel, version: '2024.2'} + - {compiler: intel-classic, version: '2021.12'} + # include: + # - os: ubuntu-latest + # toolchain: {compiler: gcc, version: 12} + # exclude: + # - os: ubuntu-22.04 + # toolchain: {compiler: gcc, version: 14} + # - mpi: 'mpich' + # toolchain: {compiler: gcc, version: 9} + # # mpich compiling FCFLAG has --fallow-type-mismatch, and will cause gfortran 9 failing + + steps: + - uses: actions/checkout@v4 + - uses: mpi4py/setup-mpi@v1 + with: + mpi: ${{ matrix.mpi }} + - uses: fortran-lang/setup-fortran@v1 + id: setup-fortran + with: + compiler: ${{ matrix.toolchain.compiler }} + version: ${{ matrix.toolchain.version }} + #- name: Install mkl + # shell: bash -l {0} + # run: | + # sudo apt-get update & sudo apt-get install -y intel-oneapi-mkl + # # source /opt/intel/oneapi/setvars.sh + - name: Install hdf5 + run: | + mkdir -p /opt/src + cd /opt/src + wget https://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-1.10.10/src/hdf5-1.10.10.tar.gz + tar -xzf hdf5-1.10.10.tar.gz + cd hdf5-1.10.10 + ./configure --prefix=/opt/hdf5 --enable-parallel --enable-fortran + make -j 4 install 2>&1 | tee build.log + export HDF5=/opt/hdf5 + export PATH=${HDF5}/bin:${PATH}' + export LD_LIBRARY_PATH=${HDF5}/lib:${LD_LIBRARY_PATH} + - name: Install netcdf-c library + shell: bash -l {0} + run: | + cd /opt/src + wget https://downloads.unidata.ucar.edu/netcdf-c/4.9.2/netcdf-c-4.9.2.tar.gz + tar -xzf netcdf-c-4.9.2.tar.gz + cd netcdf-c-4.9.2 + export CPPFLAGS="-I${HDF5}/include" + export LDFLAGS="-L${HDF5}/lib" + ./configure --prefix=/opt/netcdf --disable-dap-remote-tests --enable-mmap --enable-netcdf4 + make -j 4 install + export NETCDF=/opt/netcdf + export PATH=${NETCDF}/bin:${PATH} + export LD_LIBRARY_PATH=${NETCDF}/lib:${LD_LIBRARY_PATH} + - name: Install netcdf-fortran library + shell: bash -l {0} + run: | + cd /opt/src + wget https://downloads.unidata.ucar.edu/netcdf-fortran/4.5.3/netcdf-fortran-4.5.3.tar.gz + tar -xzf netcdf-fortran-4.5.3.tar.gz + cd netcdf-fortran-4.5.3 + export CPPFLAGS="-I${HDF5}/include" + export LDFLAGS="-L${HDF5}/lib" + ./configure --prefix=/opt/netcdf + make install + - name: Test mpi and netcdf + #run: mpif90 -v + run: which mpif90 + - name: Test netcdf + run: nc-config --all + - name: Build CoLM202X + # run: make clean && make all + run: | + cd ${{ github.workspace }} + ln -sf include/Makeoptions.github.intel include/Makeoptions + TestList=./.github/workflows/TestCaseLists + for CaseName in `awk '{print $1}' $TestList` + do + echo "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + echo "Create test cases" + echo $CaseName + echo "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + + echo defineh `cat $TestList |grep $CaseName |awk '{print $2,$3,$4,$5,$6,$7,$8}'` + ./.github/workflows/create_defineh.bash `cat $TestList |grep $CaseName |awk '{print $2,$3,$4,$5,$6,$7,$8}'` + + echo "Create test case $CaseName Complete!" + cat ./include/define.h + + echo "...................................................................." + echo "Start Compilation $CaseName" + echo "...................................................................." + + make clean && make all + done + + echo "----------------------------------------------------------------------" + echo "All test cases are compiled successfully! " + echo "----------------------------------------------------------------------" diff --git a/include/Makeoptions.github.intel b/include/Makeoptions.github.intel new file mode 100755 index 00000000..b7a84713 --- /dev/null +++ b/include/Makeoptions.github.intel @@ -0,0 +1,36 @@ +# ======================================================= +# mpif90 - ifort +# + + FF = mpif90 + + NETCDF_LIB = /opt/netcdf/lib + NETCDF_INC = /opt/netcdf/include + + MOD_CMD = -module + + FOPTS = -qopenmp -O2 -traceback -r8 -free -check uninit -check bounds + + LDFLAGS = -L${NETCDF_LIB} -lnetcdff -llapack -lblas + +#============================================================ +# CaMa-Flood Mkinclude (for Linux, Intel fortran) + +RM = /bin/rm -f +CP = /bin/cp +#---- +# Pre-Prosessing options +# DMPI=-DUseMPI: activate when MPI parallelization is used +# DCDF=-DUseCDF: activate when using netCDF, comment out when not needed +# DATM=-DNoAtom: activate when OMP ATOMIC calculation should be avoided (bit identical simulation) +#---- +#DMPI=-DUseMPI +DCDF=-DUseCDF +#DATM=-DNoAtom +CFLAGS=$(DMPI) $(DCDF) $(DATM) +#---- +# FCMP: main program (src/), FC: pre/post process (map/ etc/) +FCMP = ifort -qopenmp +FC = ifort +LFLAGS = +FFLAGS = -O3 -warn all -fpp -free -assume byterecl -heap-arrays -nogen-interface -lpthread -static-intel From 8cbedd07c84cc896f0e6cb99f3fb47679292cabb Mon Sep 17 00:00:00 2001 From: Zhongwang Wei Date: Mon, 23 Dec 2024 00:50:36 +0800 Subject: [PATCH 08/10] Update CRUJRA.nml correct the offset --- run/forcing/CRUJRA.nml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/run/forcing/CRUJRA.nml b/run/forcing/CRUJRA.nml index 4384390d..874b701f 100644 --- a/run/forcing/CRUJRA.nml +++ b/run/forcing/CRUJRA.nml @@ -18,7 +18,7 @@ DEF_forcing%endyr = 2022 ! end year of forcing data DEF_forcing%endmo = 12 ! end month of forcing data DEF_forcing%dtime = 21600 21600 21600 21600 21600 21600 21600 21600 - DEF_forcing%offset = 0 0 0 10800 0 0 0 10800 + DEF_forcing%offset = 10800 10800 10800 10800 10800 10800 0 10800 DEF_forcing%nlands = 1 ! land grid number in 1d DEF_forcing%leapyear = .false. ! leapyear calendar From 39081f4ffcddb40c74dfac4c230c7cf95c03bd23 Mon Sep 17 00:00:00 2001 From: zhangsp8 <21294631@qq.com> Date: Mon, 23 Dec 2024 12:51:18 +0800 Subject: [PATCH 09/10] Parameter ck_p adjusted. --- main/MOD_Const_PFT.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/MOD_Const_PFT.F90 b/main/MOD_Const_PFT.F90 index c0a0518b..cfe76f01 100644 --- a/main/MOD_Const_PFT.F90 +++ b/main/MOD_Const_PFT.F90 @@ -1604,7 +1604,7 @@ MODULE MOD_Const_PFT ! shape-fitting parameter for vulnerability curve (-) real(r8), parameter :: ck_p(0:N_PFT+N_CFT-1) & - = (/ 0., 3.95, 3.95, 3.95, 3.95, 3.95, 3.95, 3.95& + = (/3.95, 3.95, 3.95, 3.95, 3.95, 3.95, 3.95, 3.95& ,3.95, 3.95, 3.95, 3.95, 3.95, 3.95, 3.95, 3.95& #ifdef CROP ,3.95, 3.95, 3.95, 3.95, 3.95, 3.95, 3.95, 3.95& From 1f408ac3847cc4eb06e516f8d2422f942a958939 Mon Sep 17 00:00:00 2001 From: Xianxiang Li Date: Mon, 23 Dec 2024 22:14:39 +0800 Subject: [PATCH 10/10] Remove build tests using intel compilers --- .github/workflows/build_CoLM_intel.yml | 125 ------------------------- include/Makeoptions.github.intel | 36 ------- 2 files changed, 161 deletions(-) delete mode 100644 .github/workflows/build_CoLM_intel.yml delete mode 100755 include/Makeoptions.github.intel diff --git a/.github/workflows/build_CoLM_intel.yml b/.github/workflows/build_CoLM_intel.yml deleted file mode 100644 index f1956311..00000000 --- a/.github/workflows/build_CoLM_intel.yml +++ /dev/null @@ -1,125 +0,0 @@ -name: Build_CoLM202X_intel -on: - pull_request: - branches: - - master - paths-ignore: - - 'postprocess/**' - - 'preprocess/**' - - 'run/**' - - 'README.md' - - '.gitignore' - - '**/**.sh' - push: - branches: - - master - - workflow_dispatch: - -jobs: - Build-CoLM-intel: - runs-on: ${{ matrix.os }} - strategy: - fail-fast: false - matrix: - os: [ubuntu-latest, ubuntu-22.04] - mpi: ['mpich', 'openmpi', 'intelmpi'] - toolchain: - - {compiler: intel, version: '2024.2'} - - {compiler: intel-classic, version: '2021.12'} - # include: - # - os: ubuntu-latest - # toolchain: {compiler: gcc, version: 12} - # exclude: - # - os: ubuntu-22.04 - # toolchain: {compiler: gcc, version: 14} - # - mpi: 'mpich' - # toolchain: {compiler: gcc, version: 9} - # # mpich compiling FCFLAG has --fallow-type-mismatch, and will cause gfortran 9 failing - - steps: - - uses: actions/checkout@v4 - - uses: mpi4py/setup-mpi@v1 - with: - mpi: ${{ matrix.mpi }} - - uses: fortran-lang/setup-fortran@v1 - id: setup-fortran - with: - compiler: ${{ matrix.toolchain.compiler }} - version: ${{ matrix.toolchain.version }} - #- name: Install mkl - # shell: bash -l {0} - # run: | - # sudo apt-get update & sudo apt-get install -y intel-oneapi-mkl - # # source /opt/intel/oneapi/setvars.sh - - name: Install hdf5 - run: | - mkdir -p /opt/src - cd /opt/src - wget https://support.hdfgroup.org/ftp/HDF5/releases/hdf5-1.10/hdf5-1.10.10/src/hdf5-1.10.10.tar.gz - tar -xzf hdf5-1.10.10.tar.gz - cd hdf5-1.10.10 - ./configure --prefix=/opt/hdf5 --enable-parallel --enable-fortran - make -j 4 install 2>&1 | tee build.log - export HDF5=/opt/hdf5 - export PATH=${HDF5}/bin:${PATH}' - export LD_LIBRARY_PATH=${HDF5}/lib:${LD_LIBRARY_PATH} - - name: Install netcdf-c library - shell: bash -l {0} - run: | - cd /opt/src - wget https://downloads.unidata.ucar.edu/netcdf-c/4.9.2/netcdf-c-4.9.2.tar.gz - tar -xzf netcdf-c-4.9.2.tar.gz - cd netcdf-c-4.9.2 - export CPPFLAGS="-I${HDF5}/include" - export LDFLAGS="-L${HDF5}/lib" - ./configure --prefix=/opt/netcdf --disable-dap-remote-tests --enable-mmap --enable-netcdf4 - make -j 4 install - export NETCDF=/opt/netcdf - export PATH=${NETCDF}/bin:${PATH} - export LD_LIBRARY_PATH=${NETCDF}/lib:${LD_LIBRARY_PATH} - - name: Install netcdf-fortran library - shell: bash -l {0} - run: | - cd /opt/src - wget https://downloads.unidata.ucar.edu/netcdf-fortran/4.5.3/netcdf-fortran-4.5.3.tar.gz - tar -xzf netcdf-fortran-4.5.3.tar.gz - cd netcdf-fortran-4.5.3 - export CPPFLAGS="-I${HDF5}/include" - export LDFLAGS="-L${HDF5}/lib" - ./configure --prefix=/opt/netcdf - make install - - name: Test mpi and netcdf - #run: mpif90 -v - run: which mpif90 - - name: Test netcdf - run: nc-config --all - - name: Build CoLM202X - # run: make clean && make all - run: | - cd ${{ github.workspace }} - ln -sf include/Makeoptions.github.intel include/Makeoptions - TestList=./.github/workflows/TestCaseLists - for CaseName in `awk '{print $1}' $TestList` - do - echo "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" - echo "Create test cases" - echo $CaseName - echo "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" - - echo defineh `cat $TestList |grep $CaseName |awk '{print $2,$3,$4,$5,$6,$7,$8}'` - ./.github/workflows/create_defineh.bash `cat $TestList |grep $CaseName |awk '{print $2,$3,$4,$5,$6,$7,$8}'` - - echo "Create test case $CaseName Complete!" - cat ./include/define.h - - echo "...................................................................." - echo "Start Compilation $CaseName" - echo "...................................................................." - - make clean && make all - done - - echo "----------------------------------------------------------------------" - echo "All test cases are compiled successfully! " - echo "----------------------------------------------------------------------" diff --git a/include/Makeoptions.github.intel b/include/Makeoptions.github.intel deleted file mode 100755 index b7a84713..00000000 --- a/include/Makeoptions.github.intel +++ /dev/null @@ -1,36 +0,0 @@ -# ======================================================= -# mpif90 - ifort -# - - FF = mpif90 - - NETCDF_LIB = /opt/netcdf/lib - NETCDF_INC = /opt/netcdf/include - - MOD_CMD = -module - - FOPTS = -qopenmp -O2 -traceback -r8 -free -check uninit -check bounds - - LDFLAGS = -L${NETCDF_LIB} -lnetcdff -llapack -lblas - -#============================================================ -# CaMa-Flood Mkinclude (for Linux, Intel fortran) - -RM = /bin/rm -f -CP = /bin/cp -#---- -# Pre-Prosessing options -# DMPI=-DUseMPI: activate when MPI parallelization is used -# DCDF=-DUseCDF: activate when using netCDF, comment out when not needed -# DATM=-DNoAtom: activate when OMP ATOMIC calculation should be avoided (bit identical simulation) -#---- -#DMPI=-DUseMPI -DCDF=-DUseCDF -#DATM=-DNoAtom -CFLAGS=$(DMPI) $(DCDF) $(DATM) -#---- -# FCMP: main program (src/), FC: pre/post process (map/ etc/) -FCMP = ifort -qopenmp -FC = ifort -LFLAGS = -FFLAGS = -O3 -warn all -fpp -free -assume byterecl -heap-arrays -nogen-interface -lpthread -static-intel