mksrfdata, mkinidata, share, main/HYDRO, main/DA, postprocess code mo…

…dification (r2)
CoLM-SYSU · Jan 26, 2024 · 05c8705 · 05c8705
1 parent 0d6da08
commit 05c8705
Show file tree

Hide file tree

Showing 28 changed files with 4,143 additions and 5,899 deletions.
diff --git a/main/DA/MOD_DataAssimilation.F90 b/main/DA/MOD_DataAssimilation.F90
@@ -23,8 +23,8 @@ SUBROUTINE do_DataAssimilation (idate, deltim)
 
    IMPLICIT NONE
 
-      integer,  intent(in) :: idate(3)
-      real(r8), intent(in) :: deltim
+   integer,  intent(in) :: idate(3)
+   real(r8), intent(in) :: deltim
 
       CALL do_DA_GRACE (idate, deltim)
 

diff --git a/main/HYDRO/MOD_ElementNeighbour.F90 b/main/HYDRO/MOD_ElementNeighbour.F90
@@ -45,10 +45,10 @@ MODULE MOD_ElementNeighbour
    type(neighbour_sendrecv_type), allocatable :: recvaddr(:)
    type(neighbour_sendrecv_type), allocatable :: sendaddr(:)
 
-   interface allocate_neighbour_data
+   INTERFACE allocate_neighbour_data
       MODULE procedure allocate_neighbour_data_real8
       MODULE procedure allocate_neighbour_data_logic
-   END interface allocate_neighbour_data
+   END INTERFACE allocate_neighbour_data
 
 CONTAINS
 

diff --git a/main/HYDRO/MOD_Hydro_IO.F90 b/main/HYDRO/MOD_Hydro_IO.F90
@@ -12,10 +12,10 @@ MODULE MOD_Hydro_IO
 
    PUBLIC :: vector_write_basin
 
-   interface vector_read_basin
+   INTERFACE vector_read_basin
       MODULE procedure vector_read_basin_real8
       MODULE procedure vector_read_basin_int32
-   END interface vector_read_basin
+   END INTERFACE vector_read_basin
 
 CONTAINS
 

diff --git a/main/HYDRO/MOD_Hydro_SoilWater.F90 b/main/HYDRO/MOD_Hydro_SoilWater.F90
@@ -1245,7 +1245,7 @@ SUBROUTINE initialize_sublevel_structure ( &
                   ENDIF
                ENDIF
             ELSE
-               select CASE (ubc_typ)
+               SELECTCASE (ubc_typ)
                CASE (bc_rainfall)
                   has_wf(lb) = (dp >= tol_z) .or. (wf(lb) >= tol_z)
 
@@ -1260,7 +1260,7 @@ SUBROUTINE initialize_sublevel_structure ( &
                   ENDIF
                CASE (bc_fix_flux)
                   has_wf(lb) = wf(lb) >= tol_z
-               END select
+               ENDSELECT
             ENDIF
 
             IF (ilev < ub) THEN
@@ -1276,7 +1276,7 @@ SUBROUTINE initialize_sublevel_structure ( &
                   ENDIF
                ENDIF
             ELSE
-               select CASE (lbc_typ)
+               SELECTCASE (lbc_typ)
                CASE (bc_drainage)
                   has_wt(ub) = (wt(ub) >= tol_z)
                CASE (bc_fix_head)
@@ -1287,7 +1287,7 @@ SUBROUTINE initialize_sublevel_structure ( &
                   ENDIF
                CASE (bc_fix_flux)
                   has_wt(ub) = (wt(ub) >= tol_z)
-               END select
+               ENDSELECT
             ENDIF
          ENDIF
 
@@ -1760,7 +1760,7 @@ SUBROUTINE flux_all ( &
 
                dz_this = (dz(lb)-wt(lb)-wf(lb)) * (sp_zc(lb)-sp_zi(lb-1))/dz(lb)
 
-               select CASE (ubc_typ)
+               SELECTCASE (ubc_typ)
                CASE (bc_fix_head)
 
                   IF (has_wf(lb)) THEN
@@ -1816,7 +1816,7 @@ SUBROUTINE flux_all ( &
                      ENDIF
                   ENDIF
 
-               END select
+               ENDSELECT
 
                IF ((has_wf(lb)) .and. (dz_this >= tol_z)) THEN
                   qq_wf(lb) = flux_inside_hm_soil ( &
@@ -1835,7 +1835,7 @@ SUBROUTINE flux_all ( &
 
                dz_this = (dz(ub) - wf(ub) - wt(ub)) * (sp_zi(ub) - sp_zc(ub))/ dz(ub)
 
-               select CASE (lbc_typ)
+               SELECTCASE (lbc_typ)
                CASE (bc_fix_head)
 
                   IF (has_wt(ub)) THEN
@@ -1896,7 +1896,7 @@ SUBROUTINE flux_all ( &
                      ENDIF
                   ENDIF
 
-               END select
+               ENDSELECT
 
                IF ((has_wt(ub)) .and. (dz_this >= tol_z))  THEN
                   qq_wt(ub) = flux_inside_hm_soil ( &
@@ -2258,7 +2258,7 @@ SUBROUTINE flux_sat_zone_all ( &
       ! Case 2
       IF (top_at_ground .and. btm_at_interface) THEN
 
-         select CASE (ubc_typ)
+         SELECTCASE (ubc_typ)
          CASE (bc_fix_head)
 
             CALL flux_btm_transitive_interface ( &
@@ -2294,14 +2294,14 @@ SUBROUTINE flux_sat_zone_all ( &
                   flux_top = infl_max)
             ENDIF
 
-         END select
+         ENDSELECT
 
       ENDIF
 
       ! Case 3
       IF (top_at_ground .and. btm_inside_level) THEN
 
-         select CASE (ubc_typ)
+         SELECTCASE (ubc_typ)
          CASE (bc_fix_head)
 
             CALL flux_sat_zone_fixed_bc (nlev_sat, dz_sat, psi_sat, &
@@ -2325,14 +2325,14 @@ SUBROUTINE flux_sat_zone_all ( &
                   flux_top = infl_max)
             ENDIF
 
-         END select
+         ENDSELECT
 
       ENDIF
 
       ! Case 4
       IF (top_at_interface .and. btm_at_bottom) THEN
 
-         select CASE (lbc_typ)
+         SELECTCASE (lbc_typ)
          CASE (bc_fix_head)
 
             CALL flux_top_transitive_interface ( &
@@ -2367,7 +2367,7 @@ SUBROUTINE flux_sat_zone_all ( &
                   flux_btm = 0.0)
             ENDIF
 
-         END select
+         ENDSELECT
 
       ENDIF
 
@@ -2398,7 +2398,7 @@ SUBROUTINE flux_sat_zone_all ( &
       ! Case 7
       IF (top_inside_level .and. btm_at_bottom) THEN
 
-         select CASE (lbc_typ)
+         SELECTCASE (lbc_typ)
          CASE (bc_fix_head)
 
             CALL flux_sat_zone_fixed_bc (nlev_sat, dz_sat, psi_sat, &
@@ -2421,7 +2421,7 @@ SUBROUTINE flux_sat_zone_all ( &
                   qlc, flux_btm = 0.0)
             ENDIF
 
-         END select
+         ENDSELECT
 
       ENDIF
 
@@ -2463,7 +2463,7 @@ SUBROUTINE flux_sat_zone_all ( &
 
       IF (top_at_ground) THEN
 
-         select CASE (ubc_typ)
+         SELECTCASE (ubc_typ)
          CASE (bc_fix_head)
             qq(lb-1) = qlc(lb)
             is_trans = .false.
@@ -2478,7 +2478,7 @@ SUBROUTINE flux_sat_zone_all ( &
                qq(lb-1) = qlc(lb)
                is_trans = .false.
             ENDIF
-         END select
+         ENDSELECT
 
          IF (is_update_sublevel) THEN
             IF (is_trans .and. is_sat(lb)) THEN
@@ -2720,7 +2720,7 @@ real(r8) FUNCTION flux_inside_hm_soil ( &
 
       grad_psi = (1.0_r8 - (psi_l - psi_u)/dz)
 
-      select CASE (effective_hk_type)
+      SELECTCASE (effective_hk_type)
 
       CASE (type_upstream_mean)
 
@@ -2757,7 +2757,7 @@ real(r8) FUNCTION flux_inside_hm_soil ( &
             flux_inside_hm_soil = hk_u + (psi_u - psi_l)/dz * hk_u**(1.0_r8-rr) * hk_l**rr
          ENDIF
 
-      END select
+      ENDSELECT
 
    END FUNCTION flux_inside_hm_soil
 

diff --git a/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90 b/main/HYDRO/MOD_Hydro_Vars_1DFluxes.F90
@@ -37,64 +37,64 @@ MODULE MOD_Hydro_Vars_1DFluxes
 
 CONTAINS 
 
-  SUBROUTINE allocate_1D_HydroFluxes
-
-  USE MOD_SPMD_Task
-  USE MOD_Vars_Global, only : spval
-  USE MOD_Mesh,      only : numelm
-  USE MOD_LandHRU,   only : numhru
-  USE MOD_LandPatch, only : numpatch
-  IMPLICIT NONE
-
-  integer :: numbasin
-
-     numbasin = numelm
-
-     IF (p_is_worker) THEN
-        IF (numpatch > 0) THEN
-           allocate (xsubs_pch (numpatch)) ; xsubs_pch (:) = spval
-           allocate (xwsur     (numpatch)) ; xwsur     (:) = spval
-           allocate (xwsub     (numpatch)) ; xwsub     (:) = spval
-        ENDIF
-        IF (numbasin > 0) THEN
-           allocate (xsubs_bsn    (numbasin)) ; xsubs_bsn    (:) = spval
-           allocate (wdsrf_bsn_ta (numbasin)) ; wdsrf_bsn_ta (:) = spval
-           allocate (momen_riv_ta (numbasin)) ; momen_riv_ta (:) = spval
-           allocate (veloc_riv_ta (numbasin)) ; veloc_riv_ta (:) = spval
-           allocate (discharge    (numbasin)) ; discharge    (:) = spval
-        ENDIF
-        IF (numhru > 0) THEN
-           allocate (xsubs_hru    (numhru)) ; xsubs_hru    (:) = spval
-           allocate (wdsrf_hru_ta (numhru)) ; wdsrf_hru_ta (:) = spval
-           allocate (momen_hru_ta (numhru)) ; momen_hru_ta (:) = spval
-           allocate (veloc_hru_ta (numhru)) ; veloc_hru_ta (:) = spval
-        ENDIF
-     ENDIF
-
-  END SUBROUTINE allocate_1D_HydroFluxes
-
-  SUBROUTINE deallocate_1D_HydroFluxes
+   SUBROUTINE allocate_1D_HydroFluxes
 
+   USE MOD_SPMD_Task
+   USE MOD_Vars_Global, only : spval
+   USE MOD_Mesh,      only : numelm
+   USE MOD_LandHRU,   only : numhru
+   USE MOD_LandPatch, only : numpatch
    IMPLICIT NONE
 
-     IF (allocated(xsubs_pch)) deallocate(xsubs_pch)
-     IF (allocated(xsubs_hru)) deallocate(xsubs_hru)
-     IF (allocated(xsubs_bsn)) deallocate(xsubs_bsn)
-
-     IF (allocated(wdsrf_bsn_ta)) deallocate(wdsrf_bsn_ta)
-     IF (allocated(momen_riv_ta)) deallocate(momen_riv_ta)
-     IF (allocated(veloc_riv_ta)) deallocate(veloc_riv_ta)
-
-     IF (allocated(wdsrf_hru_ta)) deallocate(wdsrf_hru_ta)
-     IF (allocated(momen_hru_ta)) deallocate(momen_hru_ta)
-     IF (allocated(veloc_hru_ta)) deallocate(veloc_hru_ta)
-
-     IF (allocated(xwsur)) deallocate(xwsur)
-     IF (allocated(xwsub)) deallocate(xwsub)
-
-     IF (allocated(discharge)) deallocate(discharge)
-
-  END SUBROUTINE deallocate_1D_HydroFluxes
+   integer :: numbasin
+
+      numbasin = numelm
+
+      IF (p_is_worker) THEN
+         IF (numpatch > 0) THEN
+            allocate (xsubs_pch (numpatch)) ; xsubs_pch (:) = spval
+            allocate (xwsur     (numpatch)) ; xwsur     (:) = spval
+            allocate (xwsub     (numpatch)) ; xwsub     (:) = spval
+         ENDIF
+         IF (numbasin > 0) THEN
+            allocate (xsubs_bsn    (numbasin)) ; xsubs_bsn    (:) = spval
+            allocate (wdsrf_bsn_ta (numbasin)) ; wdsrf_bsn_ta (:) = spval
+            allocate (momen_riv_ta (numbasin)) ; momen_riv_ta (:) = spval
+            allocate (veloc_riv_ta (numbasin)) ; veloc_riv_ta (:) = spval
+            allocate (discharge    (numbasin)) ; discharge    (:) = spval
+         ENDIF
+         IF (numhru > 0) THEN
+            allocate (xsubs_hru    (numhru)) ; xsubs_hru    (:) = spval
+            allocate (wdsrf_hru_ta (numhru)) ; wdsrf_hru_ta (:) = spval
+            allocate (momen_hru_ta (numhru)) ; momen_hru_ta (:) = spval
+            allocate (veloc_hru_ta (numhru)) ; veloc_hru_ta (:) = spval
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE allocate_1D_HydroFluxes
+
+   SUBROUTINE deallocate_1D_HydroFluxes
+
+   IMPLICIT NONE
+
+      IF (allocated(xsubs_pch)) deallocate(xsubs_pch)
+      IF (allocated(xsubs_hru)) deallocate(xsubs_hru)
+      IF (allocated(xsubs_bsn)) deallocate(xsubs_bsn)
+
+      IF (allocated(wdsrf_bsn_ta)) deallocate(wdsrf_bsn_ta)
+      IF (allocated(momen_riv_ta)) deallocate(momen_riv_ta)
+      IF (allocated(veloc_riv_ta)) deallocate(veloc_riv_ta)
+
+      IF (allocated(wdsrf_hru_ta)) deallocate(wdsrf_hru_ta)
+      IF (allocated(momen_hru_ta)) deallocate(momen_hru_ta)
+      IF (allocated(veloc_hru_ta)) deallocate(veloc_hru_ta)
+
+      IF (allocated(xwsur)) deallocate(xwsur)
+      IF (allocated(xwsub)) deallocate(xwsub)
+
+      IF (allocated(discharge)) deallocate(discharge)
+
+   END SUBROUTINE deallocate_1D_HydroFluxes
 
 END MODULE MOD_Hydro_Vars_1DFluxes
 #endif