Changeset 8366 for branches/ORCHIDEE_2_2

Timestamp:

2024-01-08T15:25:30+01:00 (11 months ago)

Author:

yann.meurdesoif

Message:

Update irrigation for native routing

• fix problem due to an uninitialized array that must be set to 0 for Pedro irrigation

YM

Location:

branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba

Files:

• routing_native.f90 (modified) (1 diff)
• routing_native_irrig.f90 (modified) (16 diffs)

branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba/routing_native.f90

@@ -457 +457 @@
        CALL routing_flow_set(coastalflow_mean=coastalflow)
       
-       CALL irrigation_main( dt_routing, reinfiltration, irrigated_next, irrig_frac, root_deficit, soiltile, &
+       CALL irrigation_main( dt_routing, contfrac, reinfiltration, irrigated_next, irrig_frac, root_deficit, soiltile, &
                              fraction_aeirrig_sw )
        

branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba/routing_native_irrig.f90

@@ -219 +219 @@
   
 
-  SUBROUTINE irrigation_main(dt_routing, reinfiltration, irrigated_next, irrig_frac, root_deficit, soiltile, &
+  SUBROUTINE irrigation_main(dt_routing, contfrac, reinfiltration, irrigated_next, irrig_frac, root_deficit, soiltile, &
                              fraction_aeirrig_sw )
   USE constantes
@@ -227 +227 @@
   IMPLICIT NONE 
     REAL(r_std), INTENT(IN)       :: dt_routing               
+    REAL(r_std), INTENT(IN)       :: contfrac(nbpt)               
     REAL(r_std), INTENT(IN)       :: reinfiltration(nbpt)               
     REAL(r_std), INTENT(IN)       :: irrigated_next(nbpt)           
@@ -242 +243 @@
    
       IF (old_irrig_scheme) THEN
-        CALL irrigation_compute_requested_old(reinfiltration, irrigated, irrig_needs_r)
+        CALL irrigation_compute_requested_old(contfrac, reinfiltration, irrigated, irrig_needs_r)
         CALL irrigation_old(irrig_needs_r, irrig_actual_r)
       ELSE
-        CALL irrigation_compute_requested_new(dt_routing, root_deficit, soiltile, irrig_frac, irrig_needs_r)
-        CALL irrigation_new(fraction_aeirrig_sw, irrig_needs_r, irrig_actual_r)
+        CALL irrigation_compute_requested_new(dt_routing, contfrac, root_deficit, soiltile, irrig_frac, irrig_needs_r)
+        CALL irrigation_new(contfrac,fraction_aeirrig_sw, irrig_needs_r, irrig_actual_r)
       ENDIF
       
@@ -254 +255 @@
       ENDIF
       CALL scatter_omp(irrig_actual,irrigation_mean)
-      irrigation_mean(:)=irrigation_mean(:)/area(:)
+      irrigation_mean(:)=irrigation_mean(:)/(area(:)*contfrac(:))
       CALL irrigation_mean_reset()
     ELSE
@@ -266 +267 @@
 
 
-  SUBROUTINE irrigation_new(fraction_aeirrig_sw, irrig_needs_r, irrig_actual_r)
+  SUBROUTINE irrigation_new(contfrac, fraction_aeirrig_sw, irrig_needs_r, irrig_actual_r)
   USE constantes
   USE routing_native_flow_mod, ONLY : routing_mask_r, routing_flow_get, routing_flow_set 
@@ -272 +273 @@
   USE xios
   IMPLICIT NONE
- 
-    REAL(r_std),INTENT(IN)        :: fraction_aeirrig_sw(nbpt)           !! Total irrigation requirement (water requirements by the crop for its optimal growth) (kg)
+    REAL(r_std),INTENT(IN)        :: contfrac(nbpt)           
+    REAL(r_std),INTENT(IN)        :: fraction_aeirrig_sw(nbpt)           
     REAL(r_std),INTENT(IN)        :: irrig_needs_r(nbpt_r)               !! Total irrigation requirement (water requirements by the crop for its optimal growth) (kg)
     REAL(r_std),INTENT(OUT)       :: irrig_actual_r(nbpt_r)             !! Possible irrigation according to the water availability in the reservoirs (kg)
@@ -300 +301 @@
 
     CALL gather_omp(fraction_aeirrig_sw, fraction_aeirrig_sw_mpi)
+    !! fraction moyenne => need contfrac ??
       
     IF (is_omp_root) THEN
-
+      
       CALL xios_send_field("fraction_aeirrig_sw", fraction_aeirrig_sw_mpi)
-      CALL xios_recv_field("fraction_aeirrig_sw_r", fraction_aeirrig_sw_r) ! ==> need conservative quantity interp
+      CALL xios_recv_field("fraction_aeirrig_sw_r", fraction_aeirrig_sw_r) ! ==> need conservative quantity interp => no flux => to check !!!
 
 
@@ -454 +456 @@
 
           ENDIF
-
+        ELSE
+          irrig_actual_r(ig) = 0
         ENDIF
       ENDDO
@@ -559 +562 @@
     
  
-  SUBROUTINE irrigation_compute_requested_new(dt_routing, root_deficit, soiltile, irrig_frac, irrig_netereq_r)
+  SUBROUTINE irrigation_compute_requested_new(dt_routing, contfrac, root_deficit, soiltile, irrig_frac, irrig_netereq_r)
   USE constantes
   USE constantes_soil
@@ -567 +570 @@
   IMPLICIT NONE
     REAL(r_std),INTENT(IN)   :: dt_routing          
+    REAL(r_std),INTENT(IN)   :: contfrac(nbpt)          
     REAL(r_std),INTENT(IN)   :: root_deficit(nbpt)               
     REAL(r_std),INTENT(IN)   :: soiltile(nbpt,nstm)  !! Fraction of each soil tile within vegtot (0-1, unitless)
@@ -574 +578 @@
     REAL(r_std)              :: irrig_netereq(nbpt)
     REAL(r_std)              :: irrig_netereq_mpi(nbp_mpi)
-    REAL(r_std)              :: area_mpi(nbp_mpi)
-
+   
     INTEGER  :: ig
    
@@ -604 +607 @@
     ENDDO
 
-    CALL gather_omp(irrig_netereq, irrig_netereq_mpi)
-    CALL gather_omp(area, area_mpi)
-      
+    CALL gather_omp(irrig_netereq*area*contfrac, irrig_netereq_mpi)
+          
     IF (is_omp_root) THEN
-      CALL xios_send_field("irrig_netereq",irrig_netereq_mpi*area_mpi) !! contfrac ?
+      CALL xios_send_field("irrig_netereq",irrig_netereq_mpi) !! contfrac => ok ?
       CALL xios_recv_field("irrig_netereq_r",irrig_netereq_r) ! ==> need conservative quantity interp
     ENDIF
@@ -615 +617 @@
   
  
-  SUBROUTINE irrigation_compute_requested_old(reinfiltration, irrigated, irrig_need_r)
+  SUBROUTINE irrigation_compute_requested_old(contfrac, reinfiltration, irrigated, irrig_need_r)
   USE constantes
   USE xios
@@ -621 +623 @@
   USE grid, ONLY : area
   IMPLICIT NONE
+    REAL(r_std),INTENT(IN)   :: contfrac(nbpt)          
     REAL(r_std),INTENT(IN)   :: reinfiltration(nbpt)               
     REAL(r_std),INTENT(IN)   :: irrigated(nbpt)               
@@ -627 +630 @@
     REAL(r_std)              :: irrig_netereq(nbpt)
     REAL(r_std)              :: irrig_netereq_mpi(nbp_mpi)
-    REAL(r_std)              :: area_mpi(nbp_mpi)
-
+   
     INTEGER  :: ig, ir
   
@@ -641 +643 @@
       ENDDO
     
-      CALL gather_omp(irrig_netereq, irrig_netereq_mpi)
-      CALL gather_omp(area, area_mpi)
-
+      CALL gather_omp(irrig_netereq*area*contfrac, irrig_netereq_mpi)
+     
       IF (is_omp_root) THEN
-        CALL xios_send_field("irrig_netereq",irrig_netereq_mpi*area_mpi) ! contfrac ??
+        CALL xios_send_field("irrig_netereq",irrig_netereq_mpi) ! contfrac ??
         CALL xios_recv_field("irrig_netereq_r",irrig_need_r) ! ==> need conservative quantity interp
       ENDIF