| 1 | ! ================================================================================================================================ |
|---|
| 2 | ! MODULE : routing_wrapper |
|---|
| 3 | ! |
|---|
| 4 | ! CONTACT : orchidee-help _at_ listes.ipsl.fr |
|---|
| 5 | ! |
|---|
| 6 | ! LICENCE : IPSL (2006) |
|---|
| 7 | ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC |
|---|
| 8 | ! |
|---|
| 9 | !>\BRIEF Interfaces to all routing schemes. |
|---|
| 10 | !! |
|---|
| 11 | !!\n DESCRIPTION: This module contains uniformed subroutines called from sechiba. These subroutines make the swich the between |
|---|
| 12 | !! the different existing routing modules. |
|---|
| 13 | !! |
|---|
| 14 | !! Depending on the key world ROUTING_METHOD set in run.def, this module calls one of the |
|---|
| 15 | !! available routing modules: |
|---|
| 16 | !! - ROUTING_METOD=standard for the standard routing scheme available in module routing. |
|---|
| 17 | !! - ROUTING_METHOD=simple for the routing scheme in module routing_simple. |
|---|
| 18 | !! |
|---|
| 19 | !! REFERENCE(S) : None |
|---|
| 20 | !! |
|---|
| 21 | !! SVN : |
|---|
| 22 | !! $HeadURL$ |
|---|
| 23 | !! $Date$ |
|---|
| 24 | !! $Revision$ |
|---|
| 25 | !! \n |
|---|
| 26 | !_ ================================================================================================================================ |
|---|
| 27 | |
|---|
| 28 | MODULE routing_wrapper |
|---|
| 29 | |
|---|
| 30 | USE defprec |
|---|
| 31 | USE pft_parameters |
|---|
| 32 | USE grid |
|---|
| 33 | USE routing |
|---|
| 34 | USE routing_simple |
|---|
| 35 | |
|---|
| 36 | IMPLICIT NONE |
|---|
| 37 | |
|---|
| 38 | CHARACTER(LEN=255), SAVE :: routing_method !! 'standard' or 'simple': Character string used to switch between routing modules |
|---|
| 39 | !$OMP THREADPRIVATE(routing_method) |
|---|
| 40 | |
|---|
| 41 | PUBLIC :: routing_wrapper_xios_initialize, routing_wrapper_initialize, & |
|---|
| 42 | routing_wrapper_main, routing_wrapper_finalize, routing_wrapper_clear |
|---|
| 43 | PRIVATE |
|---|
| 44 | |
|---|
| 45 | CONTAINS |
|---|
| 46 | |
|---|
| 47 | !! ============================================================================================================================= |
|---|
| 48 | !! SUBROUTINE: routing_wrapper_xios_initialize |
|---|
| 49 | !! |
|---|
| 50 | !>\BRIEF First initialization phase of the choosen routing module |
|---|
| 51 | !! |
|---|
| 52 | !! DESCRIPTION: Read ROUTING_METHOD from run.def and call the xios initialization subroutine from corresponding routing module. |
|---|
| 53 | !! This subroutine is called before the xios context is closed. |
|---|
| 54 | !! It is called from sechiba_initialize only if 1 is activated. |
|---|
| 55 | !! |
|---|
| 56 | !! RECENT CHANGE(S): None |
|---|
| 57 | !! |
|---|
| 58 | !! REFERENCE(S): None |
|---|
| 59 | !! |
|---|
| 60 | !! FLOWCHART: None |
|---|
| 61 | !! \n |
|---|
| 62 | !_ ============================================================================================================================== |
|---|
| 63 | SUBROUTINE routing_wrapper_xios_initialize() |
|---|
| 64 | |
|---|
| 65 | ! Get ROUTING_METHOD from run.def. Note that this is also done in |
|---|
| 66 | ! routing_wrapper_initialize because current subroutine is not alwyas called. |
|---|
| 67 | routing_method='standard' |
|---|
| 68 | CALL getin_p("ROUTING_METHOD",routing_method) |
|---|
| 69 | IF(routing_method=='simple') THEN |
|---|
| 70 | CALL routing_simple_xios_initialize |
|---|
| 71 | ENDIF |
|---|
| 72 | |
|---|
| 73 | END SUBROUTINE routing_wrapper_xios_initialize |
|---|
| 74 | |
|---|
| 75 | |
|---|
| 76 | |
|---|
| 77 | |
|---|
| 78 | !! ============================================================================================================================= |
|---|
| 79 | !! SUBROUTINE: routing_wrapper_initialize |
|---|
| 80 | !! |
|---|
| 81 | !>\BRIEF Initialize the choosen routing module |
|---|
| 82 | !! |
|---|
| 83 | !! DESCRIPTION: Read ROUTING_METHOD from run.def and call the initialization subroutine from corresponding routing module |
|---|
| 84 | !! |
|---|
| 85 | !! RECENT CHANGE(S): None |
|---|
| 86 | !! |
|---|
| 87 | !! REFERENCE(S): None |
|---|
| 88 | !! |
|---|
| 89 | !! FLOWCHART: None |
|---|
| 90 | !! \n |
|---|
| 91 | !_ ============================================================================================================================== |
|---|
| 92 | SUBROUTINE routing_wrapper_initialize( & |
|---|
| 93 | kjit, nbpt, index, & |
|---|
| 94 | rest_id, hist_id, hist2_id, lalo, & |
|---|
| 95 | neighbours, resolution, contfrac, stempdiag, & |
|---|
| 96 | returnflow, reinfiltration, irrigation, riverflow, & |
|---|
| 97 | coastalflow, flood_frac, flood_res ) |
|---|
| 98 | |
|---|
| 99 | |
|---|
| 100 | !! 0.1 Input variables |
|---|
| 101 | INTEGER(i_std), INTENT(in) :: kjit !! Time step number (unitless) |
|---|
| 102 | INTEGER(i_std), INTENT(in) :: nbpt !! Domain size (unitless) |
|---|
| 103 | INTEGER(i_std), INTENT(in) :: index(nbpt) !! Indices of the points on the map (unitless) |
|---|
| 104 | INTEGER(i_std),INTENT(in) :: rest_id !! Restart file identifier (unitless) |
|---|
| 105 | INTEGER(i_std),INTENT(in) :: hist_id !! Access to history file (unitless) |
|---|
| 106 | INTEGER(i_std),INTENT(in) :: hist2_id !! Access to history file 2 (unitless) |
|---|
| 107 | REAL(r_std), INTENT(in) :: lalo(nbpt,2) !! Vector of latitude and longitudes (beware of the order !) |
|---|
| 108 | |
|---|
| 109 | INTEGER(i_std), INTENT(in) :: neighbours(nbpt,8) !! Vector of neighbours for each grid point |
|---|
| 110 | !! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless) |
|---|
| 111 | REAL(r_std), INTENT(in) :: resolution(nbpt,2) !! The size of each grid box in X and Y (m) |
|---|
| 112 | REAL(r_std), INTENT(in) :: contfrac(nbpt) !! Fraction of land in each grid box (unitless;0-1) |
|---|
| 113 | REAL(r_std), INTENT(in) :: stempdiag(nbpt,nslm) !! Diagnostic soil temperature profile |
|---|
| 114 | |
|---|
| 115 | !! 0.2 Output variables |
|---|
| 116 | REAL(r_std), INTENT(out) :: returnflow(nbpt) !! The water flow from lakes and swamps which returns to the grid box. |
|---|
| 117 | !! This water will go back into the hydrol or hydrolc module to allow re-evaporation (kg/m^2/dt) |
|---|
| 118 | REAL(r_std), INTENT(out) :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt) |
|---|
| 119 | REAL(r_std), INTENT(out) :: irrigation(nbpt) !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt) |
|---|
| 120 | REAL(r_std), INTENT(out) :: riverflow(nbpt) !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt) |
|---|
| 121 | REAL(r_std), INTENT(out) :: coastalflow(nbpt) !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt) |
|---|
| 122 | REAL(r_std), INTENT(out) :: flood_frac(nbpt) !! Flooded fraction of the grid box (unitless;0-1) |
|---|
| 123 | REAL(r_std), INTENT(out) :: flood_res(nbpt) !! Diagnostic of water amount in the floodplains reservoir (kg) |
|---|
| 124 | |
|---|
| 125 | |
|---|
| 126 | !_ ================================================================================================================================ |
|---|
| 127 | |
|---|
| 128 | !! 1. Get routing_method from run.def |
|---|
| 129 | !! This variable will switch between the existing modules for the routing scheme. |
|---|
| 130 | |
|---|
| 131 | !Config Key = ROUTING_METHOD |
|---|
| 132 | !Config Desc = Choice of routing module to be used |
|---|
| 133 | !Config If = RIVER_ROUTING=T |
|---|
| 134 | !Config Def = standard |
|---|
| 135 | !Config Help = Possible options are standard and simple |
|---|
| 136 | !Config Units = character string |
|---|
| 137 | |
|---|
| 138 | routing_method='standard' |
|---|
| 139 | CALL getin_p("ROUTING_METHOD",routing_method) |
|---|
| 140 | |
|---|
| 141 | |
|---|
| 142 | !! 2. Initialize the choosen routing module |
|---|
| 143 | IF (routing_method == 'standard') THEN |
|---|
| 144 | |
|---|
| 145 | CALL routing_initialize( kjit, nbpt, index, & |
|---|
| 146 | rest_id, hist_id, hist2_id, lalo, & |
|---|
| 147 | neighbours, resolution, contfrac, stempdiag, & |
|---|
| 148 | returnflow, reinfiltration, irrigation, riverflow, & |
|---|
| 149 | coastalflow, flood_frac, flood_res ) |
|---|
| 150 | |
|---|
| 151 | ELSE IF(routing_method== 'simple') THEN |
|---|
| 152 | |
|---|
| 153 | CALL routing_simple_initialize( kjit, nbpt, index, & |
|---|
| 154 | rest_id, hist_id, hist2_id, lalo, & |
|---|
| 155 | neighbours, resolution, contfrac, stempdiag, & |
|---|
| 156 | returnflow, reinfiltration, irrigation, riverflow, & |
|---|
| 157 | coastalflow, flood_frac, flood_res ) |
|---|
| 158 | |
|---|
| 159 | riverflow(:) = zero |
|---|
| 160 | coastalflow(:) = zero |
|---|
| 161 | returnflow(:) = zero |
|---|
| 162 | reinfiltration(:) = zero |
|---|
| 163 | irrigation(:) = zero |
|---|
| 164 | flood_frac(:) = zero |
|---|
| 165 | flood_res(:) = zero |
|---|
| 166 | |
|---|
| 167 | ELSE |
|---|
| 168 | ! Bad choice of routing_method. Exit the model now. |
|---|
| 169 | WRITE(numout,*) 'Following routing method is not implemented, ROUTING_METHOD=',routing_method |
|---|
| 170 | CALL ipslerr_p(3,'routing_wrapper_inititalize','ROUTING_METHOD can only be standard or simple','Error in run.def','') |
|---|
| 171 | ENDIF |
|---|
| 172 | |
|---|
| 173 | END SUBROUTINE routing_wrapper_initialize |
|---|
| 174 | |
|---|
| 175 | |
|---|
| 176 | |
|---|
| 177 | !! ============================================================================================================================= |
|---|
| 178 | !! SUBROUTINE: routing_wrapper_main |
|---|
| 179 | !! |
|---|
| 180 | !>\BRIEF Call the main subroutine for the choosen routing module |
|---|
| 181 | !! |
|---|
| 182 | !! DESCRIPTION: Call the main subroutine for the choosen routing module according to ROUTING_METHOD |
|---|
| 183 | !! |
|---|
| 184 | !! RECENT CHANGE(S): None |
|---|
| 185 | !! |
|---|
| 186 | !! REFERENCE(S): None |
|---|
| 187 | !! |
|---|
| 188 | !! FLOWCHART: None |
|---|
| 189 | !! \n |
|---|
| 190 | !_ ============================================================================================================================== |
|---|
| 191 | SUBROUTINE routing_wrapper_main(kjit, nbpt, index, & |
|---|
| 192 | lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, & |
|---|
| 193 | drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, & |
|---|
| 194 | stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id) |
|---|
| 195 | |
|---|
| 196 | |
|---|
| 197 | |
|---|
| 198 | IMPLICIT NONE |
|---|
| 199 | |
|---|
| 200 | !! 0.1 Input variables |
|---|
| 201 | INTEGER(i_std), INTENT(in) :: kjit !! Time step number (unitless) |
|---|
| 202 | INTEGER(i_std), INTENT(in) :: nbpt !! Domain size (unitless) |
|---|
| 203 | INTEGER(i_std),INTENT(in) :: rest_id !! Restart file identifier (unitless) |
|---|
| 204 | INTEGER(i_std),INTENT(in) :: hist_id !! Access to history file (unitless) |
|---|
| 205 | INTEGER(i_std),INTENT(in) :: hist2_id !! Access to history file 2 (unitless) |
|---|
| 206 | INTEGER(i_std), INTENT(in) :: index(nbpt) !! Indices of the points on the map (unitless) |
|---|
| 207 | REAL(r_std), INTENT(in) :: lalo(nbpt,2) !! Vector of latitude and longitudes (beware of the order !) |
|---|
| 208 | INTEGER(i_std), INTENT(in) :: neighbours(nbpt,NbNeighb) !! Vector of neighbours for each grid point (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) (unitless) |
|---|
| 209 | REAL(r_std), INTENT(in) :: resolution(nbpt,2) !! The size of each grid box in X and Y (m) |
|---|
| 210 | REAL(r_std), INTENT(in) :: contfrac(nbpt) !! Fraction of land in each grid box (unitless;0-1) |
|---|
| 211 | REAL(r_std), INTENT(in) :: totfrac_nobio(nbpt) !! Total fraction of no-vegetation (continental ice, lakes ...) (unitless;0-1) |
|---|
| 212 | REAL(r_std), INTENT(in) :: veget_max(nbpt,nvm) !! Maximal fraction of vegetation (unitless;0-1) |
|---|
| 213 | REAL(r_std), INTENT(in) :: floodout(nbpt) !! Grid-point flow out of floodplains (kg/m^2/dt) |
|---|
| 214 | REAL(r_std), INTENT(in) :: runoff(nbpt) !! Grid-point runoff (kg/m^2/dt) |
|---|
| 215 | REAL(r_std), INTENT(in) :: drainage(nbpt) !! Grid-point drainage (kg/m^2/dt) |
|---|
| 216 | REAL(r_std), INTENT(in) :: transpot(nbpt,nvm) !! Potential transpiration of the vegetation (kg/m^2/dt) |
|---|
| 217 | REAL(r_std), INTENT(in) :: precip_rain(nbpt) !! Rainfall (kg/m^2/dt) |
|---|
| 218 | REAL(r_std), INTENT(in) :: k_litt(nbpt) !! Averaged conductivity for saturated infiltration in the 'litter' layer (kg/m^2/dt) |
|---|
| 219 | REAL(r_std), INTENT(in) :: humrel(nbpt,nvm) !! Soil moisture stress, root extraction potential (unitless) |
|---|
| 220 | REAL(r_std), INTENT(in) :: stempdiag(nbpt,nslm) !! Diagnostic soil temperature profile |
|---|
| 221 | REAL(r_std), INTENT(in) :: reinf_slope(nbpt) !! Coefficient which determines the reinfiltration ratio in the grid box due to flat areas (unitless;0-1) |
|---|
| 222 | |
|---|
| 223 | !! 0.2 Output variables |
|---|
| 224 | REAL(r_std), INTENT(out) :: returnflow(nbpt) !! The water flow from lakes and swamps which returns to the grid box. |
|---|
| 225 | !! This water will go back into the hydrol module to allow re-evaporation (kg/m^2/dt) |
|---|
| 226 | REAL(r_std), INTENT(out) :: reinfiltration(nbpt) !! Water flow from ponds and floodplains which returns to the grid box (kg/m^2/dt) |
|---|
| 227 | REAL(r_std), INTENT(out) :: irrigation(nbpt) !! Irrigation flux. This is the water taken from the reservoirs and beeing put into the upper layers of the soil (kg/m^2/dt) |
|---|
| 228 | REAL(r_std), INTENT(out) :: riverflow(nbpt) !! Outflow of the major rivers. The flux will be located on the continental grid but this should be a coastal point (kg/dt) |
|---|
| 229 | REAL(r_std), INTENT(out) :: coastalflow(nbpt) !! Outflow on coastal points by small basins. This is the water which flows in a disperse way into the ocean (kg/dt) |
|---|
| 230 | REAL(r_std), INTENT(out) :: flood_frac(nbpt) !! Flooded fraction of the grid box (unitless;0-1) |
|---|
| 231 | REAL(r_std), INTENT(out) :: flood_res(nbpt) !! Diagnostic of water amount in the floodplains reservoir (kg) |
|---|
| 232 | |
|---|
| 233 | !_ ================================================================================================================================ |
|---|
| 234 | |
|---|
| 235 | !! 1. Call the main subroutine from the routing module corresponding to the choice of ROUTING_METHOD |
|---|
| 236 | |
|---|
| 237 | IF (routing_method=='standard') THEN |
|---|
| 238 | |
|---|
| 239 | CALL routing_main (kjit, nbpt, index, & |
|---|
| 240 | lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, & |
|---|
| 241 | drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, & |
|---|
| 242 | stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id) |
|---|
| 243 | |
|---|
| 244 | ELSE IF(routing_method=='simple') THEN |
|---|
| 245 | |
|---|
| 246 | CALL routing_simple_main (kjit, nbpt, index, & |
|---|
| 247 | lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, floodout, runoff, & |
|---|
| 248 | drainage, transpot, precip_rain, humrel, k_litt, flood_frac, flood_res, & |
|---|
| 249 | stempdiag, reinf_slope, returnflow, reinfiltration, irrigation, riverflow, coastalflow, & |
|---|
| 250 | rest_id, hist_id, hist2_id) |
|---|
| 251 | ENDIF |
|---|
| 252 | |
|---|
| 253 | |
|---|
| 254 | END SUBROUTINE routing_wrapper_main |
|---|
| 255 | |
|---|
| 256 | |
|---|
| 257 | !! ============================================================================================================================= |
|---|
| 258 | !! SUBROUTINE: routing_wrapper_finalize |
|---|
| 259 | !! |
|---|
| 260 | !>\BRIEF Call the finalization subroutine for the choosen routing module |
|---|
| 261 | !! |
|---|
| 262 | !! DESCRIPTION: Call the subroutine for finalization for the choosen routing module according to ROUTING_METHOD |
|---|
| 263 | !! |
|---|
| 264 | !! RECENT CHANGE(S): None |
|---|
| 265 | !! |
|---|
| 266 | !! REFERENCE(S): None |
|---|
| 267 | !! |
|---|
| 268 | !! FLOWCHART: None |
|---|
| 269 | !! \n |
|---|
| 270 | !_ ============================================================================================================================== |
|---|
| 271 | SUBROUTINE routing_wrapper_finalize( kjit, nbpt, rest_id, flood_frac, flood_res ) |
|---|
| 272 | |
|---|
| 273 | IMPLICIT NONE |
|---|
| 274 | !! 0.1 Input variables |
|---|
| 275 | INTEGER(i_std), INTENT(in) :: kjit !! Time step number (unitless) |
|---|
| 276 | INTEGER(i_std), INTENT(in) :: nbpt !! Domain size (unitless) |
|---|
| 277 | INTEGER(i_std),INTENT(in) :: rest_id !! Restart file identifier (unitless) |
|---|
| 278 | REAL(r_std), INTENT(in) :: flood_frac(nbpt) !! Flooded fraction of the grid box (unitless;0-1) |
|---|
| 279 | REAL(r_std), INTENT(in) :: flood_res(nbpt) !! Diagnostic of water amount in the floodplains reservoir (kg) |
|---|
| 280 | |
|---|
| 281 | !_ ================================================================================================================================ |
|---|
| 282 | |
|---|
| 283 | !! 1. Call the finalization subroutine from the routing module corresponding to the choice of ROUTING_METHOD |
|---|
| 284 | |
|---|
| 285 | IF (routing_method=='standard') THEN |
|---|
| 286 | |
|---|
| 287 | CALL routing_finalize( kjit, nbpt, rest_id, flood_frac, flood_res ) |
|---|
| 288 | |
|---|
| 289 | ELSE IF(routing_method=='simple') THEN |
|---|
| 290 | |
|---|
| 291 | CALL routing_simple_finalize( kjit, nbpt, rest_id, flood_frac, flood_res ) |
|---|
| 292 | |
|---|
| 293 | ENDIF |
|---|
| 294 | |
|---|
| 295 | END SUBROUTINE routing_wrapper_finalize |
|---|
| 296 | |
|---|
| 297 | |
|---|
| 298 | !! ============================================================================================================================= |
|---|
| 299 | !! SUBROUTINE: routing_wrapper_clear |
|---|
| 300 | !! |
|---|
| 301 | !>\BRIEF Call the clear subroutine for the choosen routing module |
|---|
| 302 | !! |
|---|
| 303 | !! DESCRIPTION: Call the clear subroutine for the choosen routing module according to ROUTING_METHOD |
|---|
| 304 | !! |
|---|
| 305 | !! RECENT CHANGE(S): None |
|---|
| 306 | !! |
|---|
| 307 | !! REFERENCE(S): None |
|---|
| 308 | !! |
|---|
| 309 | !! FLOWCHART: None |
|---|
| 310 | !! \n |
|---|
| 311 | !_ ============================================================================================================================== |
|---|
| 312 | SUBROUTINE routing_wrapper_clear |
|---|
| 313 | |
|---|
| 314 | IF (routing_method=='standard') THEN |
|---|
| 315 | |
|---|
| 316 | CALL routing_clear |
|---|
| 317 | |
|---|
| 318 | ELSE IF(routing_method=='simple') THEN |
|---|
| 319 | |
|---|
| 320 | CALL routing_simple_clear |
|---|
| 321 | |
|---|
| 322 | ENDIF |
|---|
| 323 | |
|---|
| 324 | END SUBROUTINE routing_wrapper_clear |
|---|
| 325 | |
|---|
| 326 | END MODULE routing_wrapper |
|---|
