Subroutine transpmodel
1 : !***********************************************************************
2 : !* Transpiration model and layered water balance
3 : !*----------------------------------------------------------------------
4 : !* Author: Stan Schymanski, CWR, University of Western Australia
5 : !* 03/2006
6 : !* now at: Max Planck Institute for Biogeochemistry
7 : !* Email: sschym@bgc-jena.mpg.de
8 : !* 02/2008
9 : !* Version: big leaf, trees and grass, layered unsaturated zone
10 : !* optimised root profile, pcg_d and Jmax25
11 : !*----------------------------------------------------------------------
12 : !*
13 : !* Numbers in the commented parentheses refer to the equation numeration
14 : !* in Schymanski (2007): PhD thesis, University of W.A.
15 : !* and in the document 'equations.pdf' that comes with the documentation.
16 : !*
17 : !*----------------------------------------------------------------------
18 : !* Copyright (C) 2008 Stan Schymanski
19 : !*
20 : !* This program is free software: you can redistribute it and/or modify
21 : !* it under the terms of the GNU General Public License as published by
22 : !* the Free Software Foundation, either version 3 of the License, or
23 : !* (at your option) any later version.
24 : !*
25 : !* This program is distributed in the hope that it will be useful,
26 : !* but WITHOUT ANY WARRANTY; without even the implied warranty of
27 : !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28 : !* GNU General Public License for more details.
29 : !*
30 : !* You should have received a copy of the GNU General Public License
31 : !* along with this program. If not, see http://www.gnu.org/licenses.
32 : !*
33 : !***********************************************************************
34 :
35 : subroutine transpmodel(invar, dim_invar, tp_netass, option1)
36 : use vom_vegwat_mod
37 : !$ USE omp_lib
38 : implicit none
39 :
40 : INTEGER, INTENT(in) :: dim_invar
41 : REAL*8, INTENT(inout) :: tp_netass
42 : INTEGER, INTENT(in) :: option1
43 : REAL*8, DIMENSION(dim_invar), INTENT(in) :: invar
44 : REAL*8 :: tp_netasst_d
45 : REAL*8 :: tp_netassg_d
46 : !REAL*8, ALLOCATABLE, DIMENSION(:,:) :: output_mat
47 :
48 : tp_netass = 0.d0
49 :
50 :
51 : call transpmodel_init(invar, dim_invar, option1)
52 :
53 : ! * DAILY LOOPS
54 :
55 : do while (nday .lt. c_testday)
56 : nday = nday + 1
57 : tp_netassg_d = 0.d0
58 : tp_netasst_d = 0.d0
59 :
60 : call vom_daily_init()
61 :
62 : ! * HOURLY LOOPS (loops through each hour of daily dataset)
63 : do nhour = 1, 24
64 : th_ = nday * 24 + nhour - 24
65 :
66 : call vom_hourly_init()
67 :
68 : ! * calculate gstom, et and ass
69 :
70 : call vom_gstom()
71 :
72 : ! * SUB-HOURLY LOOPS
73 :
74 : do while (time .lt. 3600.d0)
75 :
76 : ! * setting variables from previous loop
77 :
78 : call vom_subhourly_init()
79 :
80 : ! * root water uptake
81 :
82 : call vom_rootuptake()
83 :
84 : if (q_md .gt. 0.d0) then
85 :
86 : ! * steady-state tissue water (mqss)
87 :
88 : if (wlayer_ .ge. 1) then
89 : call vom_mqss(mqsst_)
90 : else
91 : mqsst_ = 0.9d0 * q_mqx
92 : endif
93 : mqsstmin = MIN(mqsstmin,mqsst_)
94 :
95 : ! * transpiration, gstom and tissue water
96 :
97 : call vom_tissue_water_et(tp_netass)
98 : if (finish .eq. 1) return
99 :
100 : endif
101 :
102 : ! * water balance and conditions at next time step
103 :
104 : call vom_subhourly()
105 :
106 : time = time + dt_
107 : mqtnew = mqt_ + dmqt * dt_
108 :
109 : ! * adding up hourly fluxes
110 :
111 : call vom_add_hourly()
112 :
113 : ! * END OF HOUR
114 :
115 : enddo
116 :
117 : ! * rl does not need to be included here as ass=-rl if j=0 (at night)
118 : tp_netass = tp_netass + asst_h(2,2) - 3600.d0 * (q_cpcct_d + rrt_d &
119 : & + q_tct_d(2) ) + assg_h(2,2,2) - 3600.d0 * (cpccg_d(2) &
120 : & + rrg_d + tcg_d(2,2))
121 : tp_netassg_d = tp_netassg_d + assg_h(2,2,2) - 3600.d0 * (cpccg_d(2) &
122 : & + rrg_d + tcg_d(2,2))
123 : tp_netasst_d = tp_netasst_d + asst_h(2,2) - 3600.d0 * (q_cpcct_d + rrt_d &
124 : & + q_tct_d(2) )
125 :
126 : asst_d(:,:) = asst_d(:,:) + asst_h(:,:)
127 : assg_d(:,:,:) = assg_d(:,:,:) + assg_h(:,:,:)
128 : ruptkt_d(:) = ruptkt_d(:) + ruptkt_h(:)
129 : ruptkg_d(:) = ruptkg_d(:) + ruptkg_h(:)
130 :
131 : !if (optmode .eq. 0) then
132 :
133 : !formatted output for single model run
134 : if (option1 .eq. 2) then
135 : call vom_add_daily()
136 : call vom_write_hourly()
137 :
138 : ! * check water balance
139 :
140 : call vom_check_water()
141 : if (finish .eq. 1) return
142 :
143 : endif
144 :
145 : !formatted output for multiple runs
146 : if (option1 .eq. 5) then
147 : call vom_add_daily()
148 : !call vom_write_hourly() !replace with a new subroutine
149 :
150 : ! * check water balance
151 :
152 : call vom_check_water()
153 : if (finish .eq. 1) return
154 :
155 : endif
156 :
157 :
158 :
159 : enddo
160 :
161 : ! * END OF DAY
162 :
163 :
164 : !if(nday .eq. 1) then
165 : !allocate matrix for 21 variables with lengt of timeseries
166 : ! allocate( output_mat (21, c_testday ) )
167 : !end if
168 :
169 : !last daily step
170 : call transpmodel_daily_step(tp_netass,tp_netassg_d, tp_netasst_d, option1)
171 :
172 : enddo
173 :
174 : ! * END OF DAILY LOOPS
175 :
176 : call transpmodel_last_step(tp_netass, option1)
177 :
178 : return
179 : end subroutine transpmodel