convertfields.F90

Go to the documentation of this file.

!**********************************************************************
! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010         *
! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa,             *
! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
!                                                                     *
! This file is part of FLEXPART.                                      *
!                                                                     *
! FLEXPART is free software: you can redistribute it and/or modify    *
! it under the terms of the GNU General Public License as published by*
! the Free Software Foundation, either version 3 of the License, or   *
! (at your option) any later version.                                 *
!                                                                     *
! FLEXPART is distributed in the hope that it will be useful,         *
! but WITHOUT ANY WARRANTY; without even the implied warranty of      *
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *
! GNU General Public License for more details.                        *
!                                                                     *
! You should have received a copy of the GNU General Public License   *
! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
!**********************************************************************

subroutine convertfields(ind,metdata_format,dumpPath)
  !                       i     o
  !*****************************************************************************
  !                                                                            *
  !  This subroutine manages the 3 data fields to be kept in memory.           *
  !  During the first time step of petterssen it has to be fulfilled that the  *
  !  first data field must have |wftime|<itime, i.e. the absolute value of     *
  !  wftime must be smaller than the absolute value of the current time in [s].*
  !  The other 2 fields are the next in time after the first one.              *
  !  Pointers (memind) are used, because otherwise one would have to resort the*
  !  wind fields, which costs a lot of computing time. Here only the pointers  *
  !  are resorted.                                                             *
  !                                                                            *
  !     Author: A. Stohl                                                       *
  !                                                                            *
  !     29 April 1994                                                          *
  !                                                                            *
  !*****************************************************************************
  !  Changes, Bernd C. Krueger, Feb. 2001:
  !   Variables tth,qvh,tthn,qvhn (on eta coordinates) in common block.
  !   Function of nstop extended.
  !*****************************************************************************
 
  !  Changes Arnold, D. and Morton, D. (2015):                                 *
  !   -- description of local and common variables                             *
  !*****************************************************************************


  use par_mod
  use com_mod
  use fpmetbinary_mod

  implicit none

  !****************************************************************************
  ! Subroutine Parameters:                                                    *
  !    input                                                                  *
  ! nstop                > 0, if trajectory has to be terminated              *
  !    output                                                                 *
  ! metdata_format       0 = unknown, 1 = ecmwf, 2 = gfs meteorological data  *
  !  
  integer :: ind, metdata_format, i, lastslash
  integer :: dumpdata
  character(len=512):: fpfname, dumppath, filename


  !****************************************************************************

  !****************************************************************************
  ! Local variables                                                           *
  !
  ! indj                 indicates the number of the wind field to be read in *
  ! memaux               auxiliary variable to shuffle winds in memory        *
  ! indmin               remembers the number of wind fields already treated  *
  ! uu(0:nxmax,0:nymax,nuvzmax,2)  wind components in x-direction [m/s]       *
  ! vv(0:nxmax,0:nymax,nuvzmax,2)  wind components in y-direction [m/s]       *
  ! ww(0:nxmax,0:nymax,nwzmax,2)   wind components in z-direction [deltaeta/s]*
  ! tt(0:nxmax,0:nymax,nuvzmax,2)  temperature [K]                            *
  ! ps(0:nxmax,0:nymax,2)          surface pressure [Pa]                      *
  !
  integer :: memaux
  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
  real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
  real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
  !****************************************************************************


  !****************************************************************************
  ! Global variables                                                          *
  !     from par_mod and com_mod                                              *
  ! nx,ny,nuvz,nwz       field dimensions in x,y and z direction              *
  ! indmin               remembers the number of wind fields already treated  *
  ! memind(2)            pointer, on which place the wind fields are stored   *
  ! memtime(2) [s]       times of the wind fields, which are kept in memory   *
  ! ndinterval [s]    time difference between the two wind fields read in     *
  ! ldirect                 1 for forward, -1 for backward simulation         * 
  ! numbwf                  actual number of wind fields                      *
  ! wftime(maxwf) [s]       times relative to beginning time of wind fields   *
  ! wfname(maxwf)           name of met file (used for performance timing out)*
  !****************************************************************************


#ifdef PERFTIMER 
  INTEGER millisecs_start, millisecs_stop, count_rate, count_max
#endif

!-----------------------------------------------------------------------------


  ! Current time is after 2nd wind field
  ! -> Resort wind field pointers, so that current time is between 1st and 2nd
  !***************************************************************************

    !memaux=memind(1)
    !memind(1)=memind(2)
    !memind(2)=memaux
    !memtime(1)=memtime(2)


  ! Read a new wind field and store it on place memind(2)
  !******************************************************
#ifdef PERFTIMER
         CALL system_clock(millisecs_start, count_rate, count_max)
#endif
          if (metdata_format.eq.ecmwf_metdata) then
             call readwind_ecmwf(ind,memind(1),uuh,vvh,wwh)
             call readwind_nests(ind,memind(1),uuhn,vvhn,wwhn)
             call calcpar_ecmwf(memind(1),uuh,vvh,pvh) 
             call calcpar_nests(memind(1),uuhn,vvhn,pvhn,metdata_format)
             call verttransform_ecmwf(memind(1),uuh,vvh,wwh,pvh)
             call verttransform_nests(memind(1),uuhn,vvhn,wwhn,pvhn)
             memtime(1)=wftime(ind)
          endif
          if (metdata_format.eq.gfs_metdata) then
             call readwind_gfs(ind,memind(1),uuh,vvh,wwh)
             call readwind_nests(ind,memind(1),uuhn,vvhn,wwhn)
             call calcpar_gfs(memind(1),uuh,vvh,pvh)
             call calcpar_nests(memind(1),uuhn,vvhn,pvhn,metdata_format)
             call verttransform_gfs(memind(1),uuh,vvh,wwh,pvh)
             call verttransform_nests(memind(1),uuhn,vvhn,wwhn,pvhn)
             memtime(1)=wftime(ind)
          endif

#ifdef PERFTIMER
         CALL system_clock(millisecs_stop, count_rate, count_max)
         print *, 'Wall time to process: ', trim(wfname(ind)), &
                  ': ', (millisecs_stop-millisecs_start)/1000.0, ' seconds'
#endif


          lastslash = 0 
          do i=1,len(wfname(ind))
            if (wfname(ind)(i:i).eq.'/') then
              lastslash = i
            end if
          end do
          filename = wfname(ind)(lastslash+1:len(wfname(ind)))
       
          if ( ldirect.eq.1 ) then
              fpfname = trim(filename) // '_fwd.fp'
          else
              fpfname = trim(filename) // '_bwd.fp'
          endif
          print *, 'writing ',  trim(dumppath) // '/' //  trim(fpfname)

#ifdef PERFTIMER
         CALL system_clock(millisecs_start, count_rate, count_max)
#endif

          CALL fpmetbinary_dump( trim(dumppath) // '/' // trim(fpfname), memind(1))

#ifdef PERFTIMER
         CALL system_clock(millisecs_stop, count_rate, count_max)
         print *, 'Wall time to dump to: ', trim(fpfname), &
                  ': ', (millisecs_stop-millisecs_start)/1000.0, ' seconds'
#endif

end subroutine convertfields