calc_mean_fields.F90 11.9 KB
Newer Older
kbk's avatar
kbk committed
1 2 3 4 5 6 7 8 9 10 11 12
#include "cppdefs.h"
!----------------------------------------------------------------------
!BOP
!
! !IROUTINE: calc_mean_fields() - produces averaged output.
!
! !INTERFACE:
   subroutine calc_mean_fields(n,meanout)
!
! !DESCRIPTION:
!
! !USES:
13
   use domain, only: imax,imin,jmax,jmin,kmax
kbk's avatar
kbk committed
14 15
   use domain, only: az,au,av
   use meteo, only: swr
16
   use m3d, only: M,calc_temp,calc_salt
17
   use variables_3d, only: do_numerical_analyses
kbk's avatar
kbk committed
18 19 20
   use variables_3d, only: hn,uu,hun,vv,hvn,ww,taub
#ifndef NO_BAROCLINIC
   use variables_3d, only: S,T
21
#endif
22 23
   use variables_3d, only: nummix3d_S,nummix2d_S,nummix3d_T,nummix2d_T
   use variables_3d, only: phymix3d_S,phymix2d_S,phymix3d_T,phymix2d_T
Knut's avatar
Knut committed
24
   use variables_3d, only: numdis3d,numdis2d
25 26 27 28 29 30 31
#ifdef GETM_BIO
   use bio, only: bio_calc
   use bio_var, only: numc
   use variables_3d,  only: cc3d
#endif
#ifdef _FABM_
   use getm_fabm, only: fabm_pel,fabm_ben,fabm_diag,fabm_diag_hz
kbk's avatar
kbk committed
32
#endif
kbk's avatar
kbk committed
33
   use diagnostic_variables
bjb's avatar
bjb committed
34
   use getm_timers, only: tic, toc, TIM_CALCMEANF
kbk's avatar
kbk committed
35 36 37 38 39 40 41 42 43 44 45 46 47
   IMPLICIT NONE
!
! !INPUT PARAMETERS:
   integer, intent(in)  :: n,meanout
!
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding & Adolf Stips
!
! !LOCAL VARIABLES:
   integer         :: i,j,k,rc
   REALTYPE        :: tmpf(I3DFIELD)
   REALTYPE,save   :: step=_ZERO_
   logical,save    :: first=.true.
48
   logical,save    :: fabm_mean=.false.
kbk's avatar
kbk committed
49 50 51 52 53 54 55 56
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
   integer, save :: Ncall = 0
   Ncall = Ncall+1
   write(debug,*) 'calc_mean_fields() # ',Ncall
#endif
bjb's avatar
bjb committed
57
   call tic(TIM_CALCMEANF)
kbk's avatar
kbk committed
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87

   if (first ) then
      LEVEL3 'calc_mean_fields(): initialising variables'
      allocate(swrmean(E2DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (swrmean)'
      allocate(ustarmean(E2DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (ustarmean)'
      allocate(ustar2mean(E2DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (ustar2mean)'
      allocate(uumean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (uumean)'
      allocate(vvmean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (vvmean)'
      allocate(wmean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (wmean)'
      allocate(humean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (humean)'
      allocate(hvmean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (hvmean)'
      allocate(hmean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (hmean)'
kbk's avatar
kbk committed
88
#ifndef NO_BAROCLINIC
kbk's avatar
kbk committed
89 90 91 92 93 94
      allocate(Tmean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (Tmean)'
      allocate(Smean(I3DFIELD),stat=rc)
      if (rc /= 0) &
          stop 'calc_mean_fields.F90: Error allocating memory (Smean)'
Knut's avatar
Knut committed
95
#endif
96

97
      if (do_numerical_analyses) then
98 99 100 101 102 103
         allocate(numdis3d_mean(I3DFIELD),stat=rc)
           if (rc /= 0) &
              stop 'calc_mean_fields.F90: Error allocating memory (numdis3d_mean)'
         allocate(numdis2d_mean(I2DFIELD),stat=rc)
           if (rc /= 0) &
              stop 'calc_mean_fields.F90: Error allocating memory (numdis2d_mean)'
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
         if (calc_temp) then
            allocate(nummix3d_T_mean(I3DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix3d_T_mean)'
            allocate(nummix2d_T_mean(I2DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix2d_T_mean)'
            allocate(phymix3d_T_mean(I3DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix3d_T_mean)'
            allocate(phymix2d_T_mean(I2DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix2d_T_mean)'
         end if
         if (calc_salt) then
            allocate(nummix3d_S_mean(I3DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix3d_S_mean)'
            allocate(nummix2d_S_mean(I2DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix2d_S_mean)'
            allocate(phymix3d_S_mean(I3DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix3d_S_mean)'
            allocate(phymix2d_S_mean(I2DFIELD),stat=rc)
            if (rc /= 0) &
               stop 'calc_mean_fields.F90: Error allocating memory (nummix2d_S_mean)'
         end if
132
      end if
133
#ifdef GETM_BIO
134 135
      allocate(cc3dmean(numc,I3DFIELD),stat=rc)
      if (rc /= 0) &
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
          stop 'calc_mean_fields.F90: Error allocating memory (cc3dmean)'
#endif
#ifdef _FABM_
      if (allocated(fabm_pel)) then
         fabm_mean=.true.
         allocate(fabmmean_pel(I3DFIELD,ubound(fabm_pel,4)),stat=rc)
         if (rc /= 0) &
            stop 'calc_mean_fields.F90: Error allocating memory (fabmmean_pel)'
         allocate(fabmmean_ben(I2DFIELD,ubound(fabm_ben,3)),stat=rc)
         if (rc /= 0) &
            stop 'calc_mean_fields.F90: Error allocating memory (fabmmean_ben)'
         allocate(fabmmean_diag(I3DFIELD,ubound(fabm_diag,4)),stat=rc)
         if (rc /= 0) &
            stop 'calc_mean_fields.F90: Error allocating memory (fabmmean_diag)'
         allocate(fabmmean_diag_hz(I2DFIELD,ubound(fabm_diag_hz,3)),stat=rc)
         if (rc /= 0) &
            stop 'calc_mean_fields.F90: Error allocating memory (fabmmean_diag_hz)'
      else
         fabm_mean=.false.
      end if
156
#endif
kbk's avatar
kbk committed
157 158 159
      first = .false.
   end if

lars's avatar
lars committed
160
   if (step .eq. _ZERO_ ) then
kbk's avatar
kbk committed
161 162
      uumean=_ZERO_; vvmean=_ZERO_; wmean=_ZERO_
      humean=_ZERO_; hvmean=_ZERO_; hmean=_ZERO_
kbk's avatar
kbk committed
163
#ifndef NO_BAROCLINIC
kbk's avatar
kbk committed
164
      Tmean=_ZERO_; Smean=_ZERO_
Knut's avatar
Knut committed
165
#endif
166
      if (do_numerical_analyses) then
167
         numdis3d_mean=_ZERO_; numdis2d_mean=_ZERO_
168 169 170 171 172 173 174 175
         if (calc_temp) then
            nummix3d_T_mean=_ZERO_; nummix2d_T_mean=_ZERO_
            phymix3d_T_mean=_ZERO_; phymix2d_T_mean=_ZERO_
         end if
         if (calc_salt) then
            nummix3d_S_mean=_ZERO_; nummix2d_S_mean=_ZERO_
            phymix3d_S_mean=_ZERO_; phymix2d_S_mean=_ZERO_
         end if
176
      end if
177 178
#ifdef GETM_BIO
      cc3dmean=_ZERO_
179 180 181 182 183 184 185 186
#endif
#ifdef _FABM_
      if (fabm_mean) then
         fabmmean_pel=_ZERO_
         fabmmean_ben=_ZERO_
         fabmmean_diag=_ZERO_
         fabmmean_diag_hz=_ZERO_
      end if
kbk's avatar
kbk committed
187
#endif
kbk's avatar
kbk committed
188 189 190 191
      ustarmean=_ZERO_; ustar2mean=_ZERO_; swrmean=_ZERO_
   end if

!  Sum every macro time step, even less would be okay
192
   if(mod(n,M) .eq. 0) then
kbk's avatar
kbk committed
193 194

      swrmean = swrmean + swr
195
!     AS this has to be checked, if it is the correct ustar,
kbk's avatar
kbk committed
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
!     so we must not divide by rho_0 !!
      ustarmean = ustarmean + sqrt(taub)
      ustar2mean = ustar2mean + (taub)

      uumean = uumean + uu
      vvmean = vvmean + vv

!  calculate the real vertical velocities
!KBK - the towas done by Adolf Stips has some errors. For now the mean
!vertical velocity is the grid-ralated velocity.
#if 0
      tmpf=_ZERO_
      call towas(tmpf)
      wmean = wmean + tmpf
#else
      wmean = wmean + ww
#endif

214
      humean = humean + hun
215 216
      hvmean = hvmean + hvn
      hmean = hmean + hn
kbk's avatar
kbk committed
217

kbk's avatar
kbk committed
218
#ifndef NO_BAROCLINIC
kbk's avatar
kbk committed
219 220
      Tmean = Tmean + T
      Smean = Smean + S
Knut's avatar
Knut committed
221
#endif
222
      if (do_numerical_analyses) then
223 224
         numdis3d_mean = numdis3d_mean + numdis3d
         numdis2d_mean = numdis2d_mean + numdis2d
225 226 227 228 229 230 231 232 233 234 235 236
         if (calc_temp) then
            nummix3d_T_mean = nummix3d_T_mean + nummix3d_T
            nummix2d_T_mean = nummix2d_T_mean + nummix2d_T
            phymix3d_T_mean = phymix3d_T_mean + phymix3d_T
            phymix2d_T_mean = phymix2d_T_mean + phymix2d_T
         end if
         if (calc_salt) then
            nummix3d_S_mean = nummix3d_S_mean + nummix3d_S
            nummix2d_S_mean = nummix2d_S_mean + nummix2d_S
            phymix3d_S_mean = phymix3d_S_mean + phymix3d_S
            phymix2d_S_mean = phymix2d_S_mean + phymix2d_S
         end if
Knut's avatar
Knut committed
237
      end if
238 239 240
#ifdef GETM_BIO
      if (bio_calc) cc3dmean=cc3dmean + cc3d
#endif
241 242 243 244 245 246 247 248
#ifdef _FABM_
      if (fabm_mean) then
          fabmmean_pel = fabmmean_pel + fabm_pel
          fabmmean_ben = fabmmean_ben + fabm_ben
          fabmmean_diag = fabmmean_diag + fabm_diag
          fabmmean_diag_hz = fabmmean_diag_hz + fabm_diag_hz
      end if
#endif
kbk's avatar
kbk committed
249 250 251 252 253 254 255 256 257 258 259 260 261
!  count them
      step = step + 1.0
   end if   ! here we summed them up

!  prepare for output
   if(meanout .gt. 0 .and. mod(n,meanout) .eq. 0) then

      if ( step .ge. 1.0) then
         uumean = uumean / step
         vvmean = vvmean / step
         wmean = wmean / step
         humean = humean / step
         hvmean = hvmean / step
262
         hmean = hmean / step
kbk's avatar
kbk committed
263

kbk's avatar
kbk committed
264
#ifndef NO_BAROCLINIC
kbk's avatar
kbk committed
265 266
         Tmean = Tmean / step
         Smean = Smean / step
Knut's avatar
Knut committed
267
#endif
268
         if (do_numerical_analyses) then
269 270
            numdis3d_mean = numdis3d_mean / step
            numdis2d_mean = numdis2d_mean / step
271 272 273 274 275 276 277 278 279 280 281 282
            if (calc_temp) then
               nummix3d_T_mean = nummix3d_T_mean / step
               nummix2d_T_mean = nummix2d_T_mean / step
               phymix3d_T_mean = phymix3d_T_mean / step
               phymix2d_T_mean = phymix2d_T_mean / step
            end if
            if (calc_salt) then
               nummix3d_S_mean = nummix3d_S_mean / step
               nummix2d_S_mean = nummix2d_S_mean / step
               phymix3d_S_mean = phymix3d_S_mean / step
               phymix2d_S_mean = phymix2d_S_mean / step
            end if
Knut's avatar
Knut committed
283
         end if
284 285
#ifdef GETM_BIO
         if (bio_calc) cc3dmean = cc3dmean / step
286 287 288 289 290 291 292 293
#endif
#ifdef _FABM_
         if (fabm_mean) then
            fabmmean_pel = fabmmean_pel / step
            fabmmean_ben = fabmmean_ben / step
            fabmmean_diag = fabmmean_diag / step
            fabmmean_diag_hz = fabmmean_diag_hz / step
         end if
294
#endif
kbk's avatar
kbk committed
295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313
         ustarmean = ustarmean / step
         swrmean = swrmean / step

!  now calculate the velocities
         where ( humean .ne. _ZERO_ )
            uumean = uumean/humean
         elsewhere
            uumean =  _ZERO_
         end where

         where ( hvmean .ne. _ZERO_ )
            vvmean = vvmean/hvmean
         elsewhere
            vvmean = _ZERO_
         end where

!  we must destagger,  yes

         tmpf = _ZERO_
314 315
         do j=jmin,jmax
            do i=imin,imax
kbk's avatar
kbk committed
316 317 318 319 320 321 322 323 324 325 326
!  check if we are in the water
               if(au(i,j) .gt. 0 .and. au(i-1,j) .gt. 0) then
                  do k = 1, kmax
                     tmpf(i,j,k)=(uumean(i,j,k)+uumean(i-1,j,k))/2.0
                  end do !k
               end if
            end do
         end do
         uumean = tmpf

         tmpf = _ZERO_
327 328
         do j=jmin,jmax
            do i=imin,imax
kbk's avatar
kbk committed
329 330 331 332 333 334 335 336 337 338 339
!  check if we are in the water
               if(av(i,j) .gt. 0 .and. av(i,j-1) .gt. 0) then
                  do k = 1, kmax
                     tmpf(i,j,k)=(vvmean(i,j,k)+vvmean(i,j-1,k))/2.0
                  end do !k
               end if
            end do
         end do
         vvmean = tmpf

         tmpf = 0.0
340 341
         do j=jmin,jmax
            do i=imin,imax
kbk's avatar
kbk committed
342 343 344 345 346 347 348 349 350 351 352 353 354 355
!  check if we are in the water
               if(az(i,j) .gt. 0) then
                  tmpf(i,j,1)=wmean(i,j,1)/2.0
                  do k = 2, kmax
                     tmpf(i,j,k) = (wmean(i,j,k)+wmean(i,j,k-1))/2.0
                  end do
               end if
            end do
         end do
         wmean = tmpf
      end if
      step = _ZERO_
   end if

bjb's avatar
bjb committed
356
   call toc(TIM_CALCMEANF)
kbk's avatar
kbk committed
357 358 359 360 361 362 363
   return
   end subroutine calc_mean_fields
!EOC

!-----------------------------------------------------------------------
! Copyright (C) 2004 -  Adolf Stips  & Karsten Bolding                 !
!-----------------------------------------------------------------------