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