Changeset 6ecb30a in flexpart.git


Ignore:
Timestamp:
Aug 17, 2017, 4:39:17 PM (7 years ago)
Author:
Espen Sollum ATMOS <eso@…>
Branches:
master, 10.4.1_pesei, GFS_025, bugfixes+enhancements, dev, release-10, release-10.4.1, scaling-bug, univie
Children:
5b34509
Parents:
61e07ba
Message:

Merged changes from CTBTO project

Location:
src
Files:
25 edited

Legend:

Unmodified
Added
Removed
  • src/FLEXPART.f90

    rc8fc724 r6ecb30a  
    3333  !                                                                            *
    3434  !*****************************************************************************
     35  ! Changes:                                                                   *
     36  !   Unified ECMWF and GFS builds                                             *
     37  !   Marian Harustak, 12.5.2017                                               *
     38  !     - Added detection of metdata format using gributils routines           *
     39  !     - Distinguished calls to ecmwf/gfs gridcheck versions based on         *
     40  !       detected metdata format                                              *
     41  !     - Passed metdata format down to timemanager                            *
     42  !*****************************************************************************
    3543  !                                                                            *
    3644  ! Variables:                                                                 *
     
    4654  use netcdf_output_mod, only: writeheader_netcdf
    4755  use random_mod, only: gasdev1
     56  use class_gribfile
    4857
    4958  implicit none
     
    5261  integer :: idummy = -320
    5362  character(len=256) :: inline_options  !pathfile, flexversion, arg2
     63  integer :: metdata_format = GRIBFILE_CENTRE_UNKNOWN
     64  integer :: detectformat
     65
    5466
    5567
     
    172184  call readavailable
    173185
     186  ! Detect metdata format
     187  !**********************
     188
     189  metdata_format = detectformat()
     190
     191  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     192    print *,'ECMWF metdata detected'
     193  elseif (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
     194    print *,'NCEP metdata detected'
     195  else
     196    print *,'Unknown metdata format'
     197    return
     198  endif
     199
     200
     201
    174202  ! If nested wind fields are used, allocate arrays
    175203  !************************************************
     
    188216  endif
    189217
    190   call gridcheck
     218  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     219    call gridcheck_ecmwf
     220  else
     221    call gridcheck_gfs
     222  end if
    191223
    192224  if (verbosity.gt.1) then   
     
    411443  endif
    412444
    413   call timemanager
     445  call timemanager(metdata_format)
    414446
    415447! NIK 16.02.2005
  • src/FLEXPART_MPI.f90

    r5184a7c r6ecb30a  
    3333  !                                                                            *
    3434  !*****************************************************************************
     35  ! Changes:                                                                   *
     36  !   Unified ECMWF and GFS builds                                             *
     37  !   Marian Harustak, 12.5.2017                                               *
     38  !     - Added detection of metdata format using gributils routines           *
     39  !     - Distinguished calls to ecmwf/gfs gridcheck versions based on         *
     40  !       detected metdata format                                              *
     41  !     - Passed metdata format down to timemanager                            *
     42  !*****************************************************************************
    3543  !                                                                            *
    3644  ! Variables:                                                                 *
     
    4755  use netcdf_output_mod, only: writeheader_netcdf
    4856  use random_mod, only: gasdev1
     57  use class_gribfile
    4958
    5059  implicit none
     
    5362  integer :: idummy = -320
    5463  character(len=256) :: inline_options  !pathfile, flexversion, arg2
     64  integer :: metdata_format = GRIBFILE_CENTRE_UNKNOWN
     65  integer :: detectformat
     66
    5567
    5668
     
    197209  call readavailable
    198210
     211  ! Detect metdata format
     212  !**********************
     213
     214  metdata_format = detectformat()
     215
     216  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     217    print *,'ECMWF metdata detected'
     218  elseif (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
     219    print *,'NCEP metdata detected'
     220  else
     221    print *,'Unknown metdata format'
     222    return
     223  endif
     224
     225
     226
    199227  ! If nested wind fields are used, allocate arrays
    200228  !************************************************
     
    213241  endif
    214242
    215   call gridcheck
     243  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     244    call gridcheck_ecmwf
     245  else
     246    call gridcheck_gfs
     247  end if
     248
    216249
    217250  if (verbosity.gt.1 .and. lroot) then   
     
    456489
    457490
    458   call timemanager
     491  call timemanager(metdata_format)
    459492
    460493
  • src/calcmatrix.f90

    re200b7a r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine calcmatrix(lconv,delt,cbmf)
     22subroutine calcmatrix(lconv,delt,cbmf,metdata_format)
    2323  !                        o    i    o
    2424  !*****************************************************************************
     
    3030  !  Petra Seibert, Bernd C. Krueger, 2000-2001                                *
    3131  !                                                                            *
     32  !*****************************************************************************
     33  ! Changes:                                                                   *
    3234  !  changed by C. Forster, November 2003 - February 2004                      *
    3335  !  array fmassfrac(nconvlevmax,nconvlevmax) represents                       *
    3436  !  the convective redistribution matrix for the particles                    *
    3537  !                                                                            *
     38  !   Unified ECMWF and GFS builds                                             *
     39  !   Marian Harustak, 12.5.2017                                               *
     40  !     - Merged calcmatrix and calcmatrix_gfs into one routine using if-then  *
     41  !       for meteo-type dependent code                                        *
     42  !*****************************************************************************
     43  !                                                                            *
    3644  !  lconv        indicates whether there is convection in this cell, or not   *
    3745  !  delt         time step for convection [s]                                 *
    3846  !  cbmf         cloud base mass flux                                         *
     47  !  metdata_format format of metdata (ecmwf/gfs)                              *
    3948  !                                                                            *
    4049  !*****************************************************************************
     
    4352  use com_mod
    4453  use conv_mod
     54  use class_gribfile
    4555
    4656  implicit none
    4757
    4858  real :: rlevmass,summe
     59  integer :: metdata_format
    4960
    5061  integer :: iflag, k, kk, kuvz
     
    7788  do kuvz = 2,nuvz
    7889    k = kuvz-1
     90    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
    7991    pconv(k) = (akz(kuvz) + bkz(kuvz)*psconv)
    8092    phconv(kuvz) = (akm(kuvz) + bkm(kuvz)*psconv)
     93    else
     94      phconv(kuvz) =  0.5*(pconv(kuvz)+pconv(k))
     95    endif
    8196    dpr(k) = phconv(k) - phconv(kuvz)
    8297    qsconv(k) = f_qvsat( pconv(k), tconv(k) )
  • src/calcpar.f90

    re200b7a r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine calcpar(n,uuh,vvh,pvh)
     22subroutine calcpar(n,uuh,vvh,pvh,metdata_format)
    2323  !                   i  i   i   o
    2424  !*****************************************************************************
     
    3737  !     new variables in call to richardson                                    *
    3838  !                                                                            *
    39   !*****************************************************************************
    40   !  Changes, Bernd C. Krueger, Feb. 2001:
    41   !   Variables tth and qvh (on eta coordinates) in common block
     39  !   CHANGE 17/11/2005 Caroline Forster NCEP GFS version                      *
     40  !                                                                            *
     41  !   Changes, Bernd C. Krueger, Feb. 2001:                                    *
     42  !    Variables tth and qvh (on eta coordinates) in common block              *
     43  !                                                                            *
     44  !   Unified ECMWF and GFS builds                                             *
     45  !   Marian Harustak, 12.5.2017                                               *
     46  !     - Merged calcpar and calcpar_gfs into one routine using if-then        *
     47  !       for meteo-type dependent code                                        *
     48  !*****************************************************************************
     49
    4250  !*****************************************************************************
    4351  !                                                                            *
    4452  ! Variables:                                                                 *
    4553  ! n                  temporal index for meteorological fields (1 to 3)       *
     54  ! uuh                                                                        *
     55  ! vvh                                                                        *
     56  ! pvh                                                                        *
     57  ! metdata_format     format of metdata (ecmwf/gfs)                           *
    4658  !                                                                            *
    4759  ! Constants:                                                                 *
     
    5668  use par_mod
    5769  use com_mod
     70  use class_gribfile
    5871
    5972  implicit none
    6073
    61   integer :: n,ix,jy,i,kz,lz,kzmin
     74  integer :: metdata_format
     75  integer :: n,ix,jy,i,kz,lz,kzmin,llev,loop_start
    6276  real :: ttlev(nuvzmax),qvlev(nuvzmax),obukhov,scalev,ol,hmixplus
    6377  real :: ulev(nuvzmax),vlev(nuvzmax),ew,rh,vd(maxspec),subsceff,ylat
    64   real :: altmin,tvold,pold,zold,pint,tv,zlev(nuvzmax)
     78  real :: altmin,tvold,pold,zold,pint,tv,zlev(nuvzmax),hmixdummy
    6579  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
    6680  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
     
    111125  !***********************************************
    112126
     127      if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
     128        ! NCEP version: find first level above ground
     129        llev = 0
     130        do i=1,nuvz
     131          if (ps(ix,jy,1,n).lt.akz(i)) llev=i
     132        end do
     133        llev = llev+1
     134        if (llev.gt.nuvz) llev = nuvz-1
     135        ! NCEP version
     136
     137        ! calculate inverse Obukhov length scale with tth(llev)
    113138      ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
    114            tth(ix,jy,2,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n),akm,bkm)
     139            tth(ix,jy,llev,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n),akm,bkm,akz(llev),metdata_format)
     140      else
     141        llev=0
     142        ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
     143            tth(ix,jy,2,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n),akm,bkm,akz(llev),metdata_format)
     144      end if
     145
    115146      if (ol.ne.0.) then
    116147        oli(ix,jy,1,n)=1./ol
     
    130161      end do
    131162
     163      if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
     164        ! NCEP version hmix has been read in in readwind.f, is therefore not calculated here
    132165      call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
    133166           ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
    134            td2(ix,jy,1,n),hmix(ix,jy,1,n),wstar(ix,jy,1,n),hmixplus)
     167             td2(ix,jy,1,n),hmixdummy,wstar(ix,jy,1,n),hmixplus,metdata_format)
     168      else
     169        call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
     170             ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
     171             td2(ix,jy,1,n),hmix(ix,jy,1,n),wstar(ix,jy,1,n),hmixplus,metdata_format)
     172      end if
    135173
    136174      if(lsubgrid.eq.1) then
     
    173211  !******************************************************
    174212
    175   ! 1) Calculate altitudes of ECMWF model levels
    176   !*********************************************
     213  ! 1) Calculate altitudes of model levels
     214  !***************************************
    177215
    178216      tvold=tt2(ix,jy,1,n)*(1.+0.378*ew(td2(ix,jy,1,n))/ &
     
    180218      pold=ps(ix,jy,1,n)
    181219      zold=0.
    182       do kz=2,nuvz
     220      if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     221        loop_start=2
     222      else
     223        loop_start=llev
     224      end if
     225      do kz=loop_start,nuvz
    183226        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)  ! pressure on model layers
    184227        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
     
    199242  !************************************************************************
    200243
    201       do kz=1,nuvz
     244      if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     245        loop_start=1
     246      else
     247        loop_start=llev
     248      end if
     249
     250      do kz=loop_start,nuvz
    202251        if (zlev(kz).ge.altmin) then
    203252          kzmin=kz
  • src/calcpar_nests.f90

    rdb712a8 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine calcpar_nests(n,uuhn,vvhn,pvhn)
     22subroutine calcpar_nests(n,uuhn,vvhn,pvhn,metdata_format)
    2323  !                         i  i    i    o
    2424  !*****************************************************************************
     
    3939  !                                                                            *
    4040  !*****************************************************************************
    41   !  Changes, Bernd C. Krueger, Feb. 2001:
    42   !   Variables tth and qvh (on eta coordinates) in common block
     41  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
     42  !   Variables tth and qvh (on eta coordinates) in common block               *
     43  !                                                                            *
     44  !   Unified ECMWF and GFS builds                                             *
     45  !   Marian Harustak, 12.5.2017                                               *
     46  !     - Added passing of metdata_format as it was needed by called routines  *
    4347  !*****************************************************************************
    4448  !                                                                            *
    4549  ! Variables:                                                                 *
    4650  ! n                  temporal index for meteorological fields (1 to 3)       *
     51  ! metdata_format     format of metdata (ecmwf/gfs)                           *
    4752  !                                                                            *
    4853  ! Constants:                                                                 *
     
    6065  implicit none
    6166
     67  integer :: metdata_format
    6268  integer :: n,ix,jy,i,l,kz,lz,kzmin
    63   real :: ttlev(nuvzmax),qvlev(nuvzmax),obukhov,scalev,ol,hmixplus
     69  real :: ttlev(nuvzmax),qvlev(nuvzmax),obukhov,scalev,ol,hmixplus,dummyakzllev
    6470  real :: ulev(nuvzmax),vlev(nuvzmax),ew,rh,vd(maxspec),subsceff,ylat
    6571  real :: altmin,tvold,pold,zold,pint,tv,zlev(nuvzmax)
     
    110116      ol=obukhov(psn(ix,jy,1,n,l),tt2n(ix,jy,1,n,l), &
    111117           td2n(ix,jy,1,n,l),tthn(ix,jy,2,n,l),ustarn(ix,jy,1,n,l), &
    112            sshfn(ix,jy,1,n,l),akm,bkm)
     118           sshfn(ix,jy,1,n,l),akm,bkm,dummyakzllev,metdata_format)
    113119      if (ol.ne.0.) then
    114120        olin(ix,jy,1,n,l)=1./ol
     
    131137           qvlev,ulev,vlev,nuvz,akz,bkz,sshfn(ix,jy,1,n,l), &
    132138           tt2n(ix,jy,1,n,l),td2n(ix,jy,1,n,l),hmixn(ix,jy,1,n,l), &
    133            wstarn(ix,jy,1,n,l),hmixplus)
     139           wstarn(ix,jy,1,n,l),hmixplus,metdata_format)
    134140
    135141      if(lsubgrid.eq.1) then
  • src/convmix.f90

    r8a65cb0 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine convmix(itime)
     22subroutine convmix(itime,metdata_format)
    2323  !                     i
    2424  !**************************************************************
     
    3131  !CHANGES by A. Stohl:
    3232  !  various run-time optimizations - February 2005
     33  ! CHANGES by C. Forster, November 2005, NCEP GFS version
     34  !      in the ECMWF version convection is calculated on the
     35  !      original eta-levels
     36  !      in the GFS version convection is calculated on the
     37  !      FLEXPART levels
     38  !
     39  !   Unified ECMWF and GFS builds                                             
     40  !   Marian Harustak, 12.5.2017                                             
     41  !     - Merged convmix and convmix_gfs into one routine using if-then           
     42  !       for meteo-type dependent code                                       
    3343  !**************************************************************
    3444
     
    3747  use com_mod
    3848  use conv_mod
     49  use class_gribfile
    3950
    4051  implicit none
     
    4455  integer :: jy, kpart, ktop, ngrid,kz
    4556  integer :: igrid(maxpart), ipoint(maxpart), igridn(maxpart,maxnests)
     57  integer :: metdata_format
    4658
    4759  ! itime [s]                 current time
     
    104116
    105117    ngrid=0
     118    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
    106119    do j=numbnests,1,-1
    107120      if ( x.gt.xln(j)+eps .and. x.lt.xrn(j)-eps .and. &
     
    111124      endif
    112125    end do
     126    else
     127      do j=numbnests,1,-1
     128        if ( x.gt.xln(j) .and. x.lt.xrn(j) .and. &
     129             y.gt.yln(j) .and. y.lt.yrn(j) ) then
     130          ngrid=j
     131          goto 23
     132        endif
     133      end do
     134    endif
    113135 23   continue
    114136
     
    167189      td2conv=(td2(ix,jy,1,mind1)*dt2+td2(ix,jy,1,mind2)*dt1)*dtt
    168190!!$      do kz=1,nconvlev+1      !old
     191      if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
    169192        do kz=1,nuvz-1           !bugfix
    170193        tconv(kz)=(tth(ix,jy,kz+1,mind1)*dt2+ &
     
    173196             qvh(ix,jy,kz+1,mind2)*dt1)*dtt
    174197      end do
     198      else
     199        do kz=1,nuvz-1           !bugfix
     200          pconv(kz)=(pplev(ix,jy,kz,mind1)*dt2+ &
     201              pplev(ix,jy,kz,mind2)*dt1)*dtt
     202          tconv(kz)=(tt(ix,jy,kz,mind1)*dt2+ &
     203              tt(ix,jy,kz,mind2)*dt1)*dtt
     204          qconv(kz)=(qv(ix,jy,kz,mind1)*dt2+ &
     205              qv(ix,jy,kz,mind2)*dt1)*dtt
     206        end do
     207      end if
    175208
    176209  ! Calculate translocation matrix
    177       call calcmatrix(lconv,delt,cbaseflux(ix,jy))
     210      call calcmatrix(lconv,delt,cbaseflux(ix,jy),metdata_format)
    178211      igrold = igr
    179212      ktop = 0
     
    252285  ! calculate translocation matrix
    253286  !*******************************
    254         call calcmatrix(lconv,delt,cbasefluxn(ix,jy,inest))
     287        call calcmatrix(lconv,delt,cbasefluxn(ix,jy,inest),metdata_format)
    255288        igrold = igr
    256289        ktop = 0
  • src/getfields.f90

    rd1a8707 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine getfields(itime,nstop)
     22subroutine getfields(itime,nstop,metdata_format)
    2323!                       i     o
    2424!*****************************************************************************
     
    3838!                                                                            *
    3939!*****************************************************************************
    40 !  Changes, Bernd C. Krueger, Feb. 2001:
    41 !   Variables tth,qvh,tthn,qvhn (on eta coordinates) in common block.
    42 !   Function of nstop extended.
     40!  Changes, Bernd C. Krueger, Feb. 2001:                                     *
     41!   Variables tth,qvh,tthn,qvhn (on eta coordinates) in common block.        *
     42!   Function of nstop extended.                                              *
     43!                                                                            *
     44!   Unified ECMWF and GFS builds                                             *
     45!   Marian Harustak, 12.5.2017                                               *
     46!     - Added passing of metdata_format as it was needed by called routines  *
    4347!*****************************************************************************
    4448!                                                                            *
     
    5862! tt(0:nxmax,0:nymax,nuvzmax,2)   temperature [K]                            *
    5963! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
     64! metdata_format     format of metdata (ecmwf/gfs)                           *
    6065!                                                                            *
    6166! Constants:                                                                 *
     
    6772  use par_mod
    6873  use com_mod
     74  use class_gribfile
    6975
    7076  implicit none
    7177
    7278  integer :: indj,itime,nstop,memaux
     79  integer :: metdata_format
    7380
    7481  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
     
    125132    do indj=indmin,numbwf-1
    126133      if (ldirect*wftime(indj+1).gt.ldirect*itime) then
    127         call readwind(indj+1,memind(2),uuh,vvh,wwh)
     134        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     135          call readwind_ecmwf(indj+1,memind(2),uuh,vvh,wwh)
     136        else
     137          call readwind_gfs(indj+1,memind(2),uuh,vvh,wwh)
     138        end if
    128139        call readwind_nests(indj+1,memind(2),uuhn,vvhn,wwhn)
    129         call calcpar(memind(2),uuh,vvh,pvh)
    130         call calcpar_nests(memind(2),uuhn,vvhn,pvhn)
    131         call verttransform(memind(2),uuh,vvh,wwh,pvh)
     140        call calcpar(memind(2),uuh,vvh,pvh,metdata_format)
     141        call calcpar_nests(memind(2),uuhn,vvhn,pvhn,metdata_format)
     142        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     143          call verttransform_ecmwf(memind(2),uuh,vvh,wwh,pvh)
     144        else
     145          call verttransform_gfs(memind(2),uuh,vvh,wwh,pvh)
     146        end if
    132147        call verttransform_nests(memind(2),uuhn,vvhn,wwhn,pvhn)
    133148        memtime(2)=wftime(indj+1)
     
    152167           (ldirect*wftime(indj+1).gt.ldirect*itime)) then
    153168        memind(1)=1
    154         call readwind(indj,memind(1),uuh,vvh,wwh)
     169        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     170          call readwind_ecmwf(indj,memind(1),uuh,vvh,wwh)
     171        else
     172          call readwind_gfs(indj,memind(1),uuh,vvh,wwh)
     173        end if
    155174        call readwind_nests(indj,memind(1),uuhn,vvhn,wwhn)
    156         call calcpar(memind(1),uuh,vvh,pvh)
    157         call calcpar_nests(memind(1),uuhn,vvhn,pvhn)
    158         call verttransform(memind(1),uuh,vvh,wwh,pvh)
     175        call calcpar(memind(1),uuh,vvh,pvh,metdata_format)
     176        call calcpar_nests(memind(1),uuhn,vvhn,pvhn,metdata_format)
     177        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     178          call verttransform_ecmwf(memind(1),uuh,vvh,wwh,pvh)
     179        else
     180          call verttransform_gfs(memind(1),uuh,vvh,wwh,pvh)
     181        end if
    159182        call verttransform_nests(memind(1),uuhn,vvhn,wwhn,pvhn)
    160183        memtime(1)=wftime(indj)
    161184        memind(2)=2
    162         call readwind(indj+1,memind(2),uuh,vvh,wwh)
     185        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     186          call readwind_ecmwf(indj+1,memind(2),uuh,vvh,wwh)
     187        else
     188          call readwind_gfs(indj+1,memind(2),uuh,vvh,wwh)
     189        end if
    163190        call readwind_nests(indj+1,memind(2),uuhn,vvhn,wwhn)
    164         call calcpar(memind(2),uuh,vvh,pvh)
    165         call calcpar_nests(memind(2),uuhn,vvhn,pvhn)
    166         call verttransform(memind(2),uuh,vvh,wwh,pvh)
     191        call calcpar(memind(2),uuh,vvh,pvh,metdata_format)
     192        call calcpar_nests(memind(2),uuhn,vvhn,pvhn,metdata_format)
     193        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     194          call verttransform_ecmwf(memind(2),uuh,vvh,wwh,pvh)
     195        else
     196          call verttransform_gfs(memind(2),uuh,vvh,wwh,pvh)
     197        end if
    167198        call verttransform_nests(memind(2),uuhn,vvhn,wwhn,pvhn)
    168199        memtime(2)=wftime(indj+1)
  • src/getfields_mpi.f90

    r78e62dc r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine getfields(itime,nstop,memstat)
     22subroutine getfields(itime,nstop,memstat,metdata_format)
    2323!                       i     o       o
    2424!*****************************************************************************
     
    5858!    memstat=0:      no new fields to be read
    5959!         
     60!   Unified ECMWF and GFS builds                                             
     61!   Marian Harustak, 12.5.2017                                               
     62!     - Added passing of metdata_format as it was needed by called routines 
     63!         
    6064!*****************************************************************************
    6165!                                                                            *
     
    7781! tt(0:nxmax,0:nymax,nuvzmax,numwfmem)   temperature [K]                     *
    7882! ps(0:nxmax,0:nymax,numwfmem)           surface pressure [Pa]               *
     83! metdata_format     format of metdata (ecmwf/gfs)                           *
    7984!                                                                            *
    8085! Constants:                                                                 *
     
    8792  use com_mod
    8893  use mpi_mod, only: lmpreader,lmp_use_reader,lmp_sync
     94  use class_gribfile
    8995
    9096  implicit none
    9197
     98  integer :: metdata_format
    9299  integer :: indj,itime,nstop,memaux,mindread
    93100! mindread: index of where to read 3rd field
     
    204211      if (ldirect*wftime(indj+1).gt.ldirect*itime) then
    205212        if (lmpreader.or..not. lmp_use_reader) then
    206           call readwind(indj+1,mindread,uuh,vvh,wwh)
     213          if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     214            call readwind_ecmwf(indj+1,mindread,uuh,vvh,wwh)
     215          else
     216            call readwind_gfs(indj+1,mindread,uuh,vvh,wwh)
     217          end if
    207218          call readwind_nests(indj+1,mindread,uuhn,vvhn,wwhn)
    208           call calcpar(mindread,uuh,vvh,pvh)
    209           call calcpar_nests(mindread,uuhn,vvhn,pvhn)
    210           call verttransform(mindread,uuh,vvh,wwh,pvh)
     219          call calcpar(mindread,uuh,vvh,pvh,metdata_format)
     220          call calcpar_nests(mindread,uuhn,vvhn,pvhn,metdata_format)
     221          if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     222            call verttransform_ecmwf(mindread,uuh,vvh,wwh,pvh)
     223          else
     224            call verttransform_gfs(mindread,uuh,vvh,wwh,pvh)
     225          end if
    211226          call verttransform_nests(mindread,uuhn,vvhn,wwhn,pvhn)
    212227        end if
     
    230245        memind(1)=1
    231246        if (lmpreader.or..not.lmp_use_reader) then
    232           call readwind(indj,memind(1),uuh,vvh,wwh)
     247          if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     248            call readwind_ecmwf(indj,memind(1),uuh,vvh,wwh)
     249          else
     250            call readwind_gfs(indj,memind(1),uuh,vvh,wwh)
     251          end if
    233252          call readwind_nests(indj,memind(1),uuhn,vvhn,wwhn)
    234           call calcpar(memind(1),uuh,vvh,pvh)
    235           call calcpar_nests(memind(1),uuhn,vvhn,pvhn)
    236           call verttransform(memind(1),uuh,vvh,wwh,pvh)
     253          call calcpar(memind(1),uuh,vvh,pvh,metdata_format)
     254          call calcpar_nests(memind(1),uuhn,vvhn,pvhn,metdata_format)
     255          if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     256            call verttransform_ecmwf(memind(1),uuh,vvh,wwh,pvh)
     257          else
     258            call verttransform_gfs(memind(1),uuh,vvh,wwh,pvh)
     259          end if
    237260          call verttransform_nests(memind(1),uuhn,vvhn,wwhn,pvhn)
    238261        end if
     
    240263        memind(2)=2
    241264        if (lmpreader.or..not.lmp_use_reader) then
    242           call readwind(indj+1,memind(2),uuh,vvh,wwh)
     265          if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     266            call readwind_ecmwf(indj+1,memind(2),uuh,vvh,wwh)
     267          else
     268            call readwind_gfs(indj+1,memind(2),uuh,vvh,wwh)
     269          end if
    243270          call readwind_nests(indj+1,memind(2),uuhn,vvhn,wwhn)
    244           call calcpar(memind(2),uuh,vvh,pvh)
    245           call calcpar_nests(memind(2),uuhn,vvhn,pvhn)
    246           call verttransform(memind(2),uuh,vvh,wwh,pvh)
     271          call calcpar(memind(2),uuh,vvh,pvh,metdata_format)
     272          call calcpar_nests(memind(2),uuhn,vvhn,pvhn,metdata_format)
     273          if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     274            call verttransform_ecmwf(memind(2),uuh,vvh,wwh,pvh)
     275          else
     276            call verttransform_gfs(memind(2),uuh,vvh,wwh,pvh)
     277          end if
    247278          call verttransform_nests(memind(2),uuhn,vvhn,wwhn,pvhn)
    248279        end if
  • src/gridcheck_gfs.f90

    r4c64400 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine gridcheck
     22subroutine gridcheck_gfs
    2323
    2424  !**********************************************************************
     
    3838  !             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
    3939  !                                 ECMWF grib_api                      *
     40  !                                                                     *
     41  !   Unified ECMWF and GFS builds                                      *
     42  !   Marian Harustak, 12.5.2017                                        *
     43  !     - Renamed routine from gridcheck to gridcheck_gfs               *
    4044  !                                                                     *
    4145  !**********************************************************************
     
    537541  endif
    538542
    539 end subroutine gridcheck
     543end subroutine gridcheck_gfs
  • src/makefile

    r61e07ba r6ecb30a  
    143143ew.o                    readreleases.o  \
    144144readdepo.o              get_vdep_prob.o   \
    145 get_wetscav.o   \
     145get_wetscav.o           readwind_gfs.o \
    146146psim.o                  outgrid_init.o  \
    147 outgrid_init_nest.o     \
     147outgrid_init_nest.o     calcmatrix.o \
    148148photo_O1D.o             readlanduse.o \
    149149interpol_wind.o         readoutgrid.o \
    150150interpol_all.o          readpaths.o \
    151 getrb.o                 \
    152 getrc.o                 \
     151getrb.o                 obukhov.o \
     152getrc.o                 convmix.o \
    153153getvdep.o               readspecies.o \
    154 interpol_misslev.o      \
    155 scalev.o \
    156 pbl_profile.o           readOHfield.o\
    157 juldate.o               \
     154interpol_misslev.o      richardson.o \
     155scalev.o                verttransform_ecmwf.o \
     156pbl_profile.o           readOHfield.o \
     157juldate.o               verttransform_gfs.o \
    158158interpol_vdep.o         interpol_rain.o \
    159159hanna.o                 wetdepokernel.o \
    160                   wetdepo.o \
     160calcpar.o               wetdepo.o \
    161161hanna_short.o           windalign.o \
    162 hanna1.o                        \
    163                         gridcheck_nests.o \
     162hanna1.o                gridcheck_ecmwf.o \
     163gridcheck_gfs.o         gridcheck_nests.o \
    164164readwind_nests.o        calcpar_nests.o \
    165165verttransform_nests.o   interpol_all_nests.o \
    166166interpol_wind_nests.o   interpol_misslev_nests.o \
    167167interpol_vdep_nests.o   interpol_rain_nests.o \
    168 readageclasses.o        \
     168readageclasses.o        detectformat.o \
    169169calcfluxes.o            fluxoutput.o \
    170170qvsat.o                 skplin.o \
     
    319319mpi_mod.o: com_mod.o par_mod.o unc_mod.o
    320320netcdf_output_mod.o: com_mod.o outg_mod.o par_mod.o point_mod.o unc_mod.o mean_mod.o
    321 obukhov.o: par_mod.o
    322 obukhov_gfs.o: par_mod.o
     321obukhov.o: par_mod.o class_gribfile_mod.o
    323322ohreaction.o: com_mod.o oh_mod.o par_mod.o
    324323openouttraj.o: com_mod.o par_mod.o point_mod.o
     
    327326outgrid_init.o: com_mod.o flux_mod.o oh_mod.o outg_mod.o par_mod.o unc_mod.o
    328327outgrid_init_nest.o: com_mod.o outg_mod.o par_mod.o unc_mod.o
    329 par_mod.o :
    330328part0.o: par_mod.o
    331329partdep.o: par_mod.o
  • src/mpi_mod.f90

    rb5127f9 r6ecb30a  
    5959!                                                                            *
    6060!*****************************************************************************
     61!                                                                            *
     62! Modification by DJM, 2017-05-09 - added #ifdef USE_MPIINPLACE cpp          *
     63! directive to mpif_tm_reduce_grid() to insure that MPI_IN_PLACE is          *
     64! used in the MPI_Reduce() only if specifically compiled with that           *
     65! directive.                                                                 *
     66!                                                                            *
     67!*****************************************************************************
    6168
    6269  use mpi
     
    24212428
    24222429! 2) Using in-place reduction
     2430
     2431!!!--------------------------------------------------------------------
     2432!!! DJM - 2017-05-09 change - MPI_IN_PLACE option for MPI_Reduce() causes
     2433!!! severe numerical problems in some cases.  I'm guessing there are memory
     2434!!! overrun issues in this complex code, but have so far failed to identify
     2435!!! a specific problem.  And/or, when one searches the Internet for this
     2436!!! issue, there is "some" hint that the implementation may be buggy. 
     2437!!!
     2438!!! At this point, with the following CPP USE_MPIINPLACE directive, the
     2439!!! default behaviour will be to not use the MPI_IN_PLACE option.
     2440!!! Users will have to compile with -DUSE_MPIINPLACE if they want that option.
     2441!!! Introduction of the CPP directives also requires that the code be compiled
     2442!!! with the "-x f95-cpp-input" option.
     2443!!!
     2444!!! Modification of this section requires the addition of array gridunc0, which
     2445!!! requires an allocation in outgrid_init.f90 and initial declaration in
     2446!!! unc_mod.f90.
     2447!!!--------------------------------------------------------------------
     2448
     2449#ifdef USE_MPIINPLACE
     2450
    24232451    if (lroot) then
    24242452      call MPI_Reduce(MPI_IN_PLACE, gridunc, grid_size3d, mp_sp, MPI_SUM, id_root, &
     
    24292457           & mp_comm_used, mp_ierr)
    24302458    end if
     2459
     2460#else
     2461
     2462      call MPI_Reduce(gridunc, gridunc0, grid_size3d, mp_sp, MPI_SUM, id_root, &
     2463           & mp_comm_used, mp_ierr)
     2464      if (lroot) gridunc = gridunc0
     2465
     2466#endif
    24312467
    24322468    if ((WETDEP).and.(ldirect.gt.0)) then
  • src/obukhov.f90

    re200b7a r6ecb30a  
    2020!**********************************************************************
    2121
    22 real function obukhov(ps,tsurf,tdsurf,tlev,ustar,hf,akm,bkm)
     22real function obukhov(ps,tsurf,tdsurf,tlev,ustar,hf,akm,bkm,plev,metdata_format)
    2323
    2424  !********************************************************************
     
    2727  !                       Date:   1994-06-27                          *
    2828  !                                                                   *
    29   !  Update: A. Stohl, 2000-09-25, avoid division by zero by          *
    30   !  setting ustar to minimum value                                   *
     29  !     This program calculates Obukhov scale height from surface     *
     30  !     meteorological data and sensible heat flux.                   *
    3131  !                                                                   *
    3232  !********************************************************************
    3333  !                                                                   *
    34   !     This program calculates Obukhov scale height from surface     *
    35   !     meteorological data and sensible heat flux.                   *
     34  !  Update: A. Stohl, 2000-09-25, avoid division by zero by          *
     35  !  setting ustar to minimum value                                   *
     36  !  CHANGE: 17/11/2005 Caroline Forster NCEP GFS version             *
     37  !                                                                   *
     38  !   Unified ECMWF and GFS builds                                    *
     39  !   Marian Harustak, 12.5.2017                                      *
     40  !     - Merged obukhov and obukhov_gfs into one routine using       *
     41  !       if-then for meteo-type dependent code                       *
    3642  !                                                                   *
    3743  !********************************************************************
     
    4753  !     akm     ECMWF vertical discretization parameter               *
    4854  !     bkm     ECMWF vertical discretization parameter               *
     55  !     plev                                                          *
     56  !     metdata_format format of metdata (ecmwf/gfs)                  *
    4957  !                                                                   *
    5058  !********************************************************************
    5159
    5260  use par_mod
     61  use class_gribfile
    5362
    5463  implicit none
    5564
     65  integer :: metdata_format
    5666  real :: akm(nwzmax),bkm(nwzmax)
    5767  real :: ps,tsurf,tdsurf,tlev,ustar,hf,e,ew,tv,rhoa,plev
     
    6272  tv=tsurf*(1.+0.378*e/ps)               ! virtual temperature
    6373  rhoa=ps/(r_air*tv)                      ! air density
     74  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
    6475  ak1=(akm(1)+akm(2))/2.
    6576  bk1=(bkm(1)+bkm(2))/2.
    6677  plev=ak1+bk1*ps                        ! Pressure level 1
     78  end if
    6779  theta=tlev*(100000./plev)**(r_air/cpa) ! potential temperature
    6880  if (ustar.le.0.) ustar=1.e-8
  • src/outgrid_init.f90

    r6b22af9 r6ecb30a  
    1919! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
    2020!**********************************************************************
     21!                                                                     *
     22! DJM - 2017-05-09 - added #ifdef USE_MPIINPLACE cpp directive to     *
     23! enable allocation of a gridunc0 array if required by MPI code in    *
     24! mpi_mod.f90                                                         *
     25!                                                                     *
     26!**********************************************************************
     27
    2128
    2229subroutine outgrid_init
     
    215222! Extra field for totals at MPI root process
    216223  if (lroot.and.mpi_mode.gt.0) then
    217     ! allocate(gridunc0(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
    218     !      maxpointspec_act,nclassunc,maxageclass),stat=stat)
    219     ! if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
     224
     225#ifdef USE_MPIINPLACE
     226#else
     227    ! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(),
     228    ! then an aux array is needed for parallel grid reduction
     229    allocate(gridunc0(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
     230         maxpointspec_act,nclassunc,maxageclass),stat=stat)
     231    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
     232#endif
    220233    if (ldirect.gt.0) then
    221234      allocate(wetgridunc0(0:numxgrid-1,0:numygrid-1,maxspec, &
  • src/par_mod.f90

    r61e07ba r6ecb30a  
    142142 
    143143!  integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92 !ECMWF new
    144   integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138 !ECMWF new
     144!  integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138 !ECMWF new
     145
     146  integer,parameter :: nxmax=181,nymax=91,nuvzmax=138,nwzmax=138,nzmax=138 !ECMWF new
    145147
    146148!  INTEGER,PARAMETER :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138 !NCEP data
     
    149151!  integer,parameter :: nxshift=0     ! for GFS
    150152!  integer,parameter :: nxmax=15,nymax=15,nuvzmax=140,nwzmax=140,nzmax=140
    151   integer,parameter :: nxshift=359  ! for ECMWF
    152 !  integer,parameter :: nxshift=0     ! for GFS
     153!  integer,parameter :: nxshift=359  ! for ECMWF
     154  integer,parameter :: nxshift=0     ! for GFS
    153155
    154156  !*********************************************
  • src/readwind_gfs.f90

    r8a65cb0 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine readwind(indj,n,uuh,vvh,wwh)
     22subroutine readwind_gfs(indj,n,uuh,vvh,wwh)
    2323
    2424  !***********************************************************************
     
    3838  !*             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
    3939  !*                                 ECMWF grib_api                      *
     40  !                                                                      *
     41  !   Unified ECMWF and GFS builds                                       *
     42  !   Marian Harustak, 12.5.2017                                         *
     43  !     - Renamed routine from readwind to readwind_gfs                  *
    4044  !*                                                                     *
    4145  !***********************************************************************
     
    716720  stop 'Execution terminated'
    717721
    718 end subroutine readwind
     722end subroutine readwind_gfs
  • src/richardson.f90

    rc2162ce r6ecb30a  
    2121
    2222subroutine richardson(psurf,ust,ttlev,qvlev,ulev,vlev,nuvz, &
    23        akz,bkz,hf,tt2,td2,h,wst,hmixplus)
     23       akz,bkz,hf,tt2,td2,h,wst,hmixplus,metdata_format)
    2424  !                        i    i    i     i    i    i    i
    2525  ! i   i  i   i   i  o  o     o
     
    4141  !     Meteor. 81, 245-269.                                                  *
    4242  !                                                                           *
     43  !****************************************************************************
     44  !                                                                           *
    4345  !     Update: 1999-02-01 by G. Wotawa                                       *
    4446  !                                                                           *
     
    4648  !     instead of first model level.                                         *
    4749  !     New input variables tt2, td2 introduced.                              *
     50  !                                                                           *
     51  !     CHANGE: 17/11/2005 Caroline Forster NCEP GFS version                  *
     52  !                                                                           *
     53  !     Unified ECMWF and GFS builds                                          *
     54  !     Marian Harustak, 12.5.2017                                            *
     55  !       - Merged richardson and richardson_gfs into one routine using       *
     56  !         if-then for meteo-type dependent code                             *
    4857  !                                                                           *
    4958  !****************************************************************************
     
    5564  ! tv                         virtual temperature                            *
    5665  ! wst                        convective velocity scale                      *
     66  ! metdata_format             format of metdata (ecmwf/gfs)                  *
    5767  !                                                                           *
    5868  ! Constants:                                                                *
     
    6272
    6373  use par_mod
     74  use class_gribfile
    6475
    6576  implicit none
    6677
    67   integer :: i,k,nuvz,iter
     78  integer :: metdata_format
     79  integer :: i,k,nuvz,iter,llev,loop_start
    6880  real :: tv,tvold,zref,z,zold,pint,pold,theta,thetaref,ri
    6981  real :: akz(nuvz),bkz(nuvz),ulev(nuvz),vlev(nuvz),hf,wst,tt2,td2,ew
     
    7789  iter=0
    7890
     91  if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
     92    ! NCEP version: find first model level above ground
     93    !**************************************************
     94
     95     llev = 0
     96     do i=1,nuvz
     97       if (psurf.lt.akz(i)) llev=i
     98     end do
     99     llev = llev+1
     100    ! sec llev should not be 1!
     101     if (llev.eq.1) llev = 2
     102     if (llev.gt.nuvz) llev = nuvz-1
     103    ! NCEP version
     104  end if
     105
     106
    79107  ! Compute virtual temperature and virtual potential temperature at
    80108  ! reference level (2 m)
     
    95123  ! Integrate z up to one level above zt
    96124  !*************************************
    97 
    98   do k=2,nuvz
     125  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
     126    loop_start=2
     127  else
     128    loop_start=llev
     129  end if
     130  do k=loop_start,nuvz
    99131    pint=akz(k)+bkz(k)*psurf  ! pressure on model layers
    100132    tv=ttlev(k)*(1.+0.608*qvlev(k))
  • src/timemanager.f90

    ra76d954 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine timemanager
     22subroutine timemanager(metdata_format)
    2323
    2424  !*****************************************************************************
     
    5050  !   For compatibility with MPI version,                                      *
    5151  !   variables uap,ucp,uzp,us,vs,ws,cbt now in module com_mod                 *
     52  !  Unified ECMWF and GFS builds                                              *
     53  !   Marian Harustak, 12.5.2017                                               *
     54  !   - Added passing of metdata_format as it was needed by called routines    *
    5255  !*****************************************************************************
    5356  !                                                                            *
     
    8386  ! xtra1(maxpart), ytra1(maxpart), ztra1(maxpart) =                           *
    8487  !                    spatial positions of trajectories                       *
     88  ! metdata_format     format of metdata (ecmwf/gfs)                           *
    8589  !                                                                            *
    8690  ! Constants:                                                                 *
     
    102106  implicit none
    103107
     108  integer :: metdata_format
    104109  integer :: j,ks,kp,l,n,itime=0,nstop,nstop1
    105110! integer :: ksp
     
    194199           write (*,*) 'timemanager> call convmix -- backward'
    195200        endif         
    196       call convmix(itime)
     201      call convmix(itime,metdata_format)
    197202        if (verbosity.gt.1) then
    198203          !CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
     
    207212           write (*,*) 'timemanager> call getfields'
    208213    endif
    209     call getfields(itime,nstop1)
     214    call getfields(itime,nstop1,metdata_format)
    210215        if (verbosity.gt.1) then
    211216          CALL SYSTEM_CLOCK(count_clock)
     
    266271       write (*,*) 'timemanager> call convmix -- forward'
    267272     endif   
    268      call convmix(itime)
     273     call convmix(itime,metdata_format)
    269274   endif
    270275
  • src/timemanager_mpi.f90

    rb5127f9 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine timemanager
     22subroutine timemanager(metdata_format)
    2323
    2424!*****************************************************************************
     
    5050!   MPI version                                                              *
    5151!   Variables uap,ucp,uzp,us,vs,ws,cbt now in module com_mod                 *
     52!  Unified ECMWF and GFS builds                                              *
     53!   Marian Harustak, 12.5.2017                                               *
     54!   - Added passing of metdata_format as it was needed by called routines    *
    5255!*****************************************************************************
    5356!                                                                            *
     
    205208      endif
    206209! readwind process skips this step
    207       if (.not.(lmpreader.and.lmp_use_reader)) call convmix(itime)
     210      if (.not.(lmpreader.and.lmp_use_reader)) call convmix(itime,metdata_format)
    208211    endif
    209212
     
    218221    if (mp_measure_time) call mpif_mtime('getfields',0)
    219222
    220     call getfields(itime,nstop1,memstat)
     223    call getfields(itime,nstop1,memstat,metdata_format)
    221224
    222225    if (mp_measure_time) call mpif_mtime('getfields',1)
  • src/unc_mod.f90

    r4c64400 r6ecb30a  
    1919! along with FLEXPART.  If not, see <http://www.gnu.org/licenses/>.   *
    2020!**********************************************************************
     21!                                                                     *
     22! DJM - 2017-05-09 - added #ifdef USE_MPIINPLACE cpp directive to     *
     23! enable declaration of a gridunc0 array if required by MPI code in   *
     24! mpi_mod.f90                                                         *
     25!                                                                     *
     26!**********************************************************************
    2127
    2228module unc_mod
     
    2733
    2834  real,allocatable, dimension (:,:,:,:,:,:,:) :: gridunc
     35#ifdef USE_MPIINPLACE
     36#else
     37  ! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(),
     38  ! then an aux array is needed for parallel grid reduction
     39  real,allocatable, dimension (:,:,:,:,:,:,:) :: gridunc0
     40#endif
    2941  real,allocatable, dimension (:,:,:,:,:,:,:) :: griduncn
    3042  real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: drygridunc
  • src/verttransform_ecmwf.f90

    r61e07ba r6ecb30a  
    144144
    145145
    146     tvold(ixm,jym)=tt2(ixm,jym,1,n)*(1.+0.378*ew*(td2(ixm,jym,1,n))/ &
     146    tvold(ixm,jym)=tt2(ixm,jym,1,n)*(1.+0.378*ew(td2(ixm,jym,1,n))/ &
    147147         ps(ixm,jym,1,n))
    148148    pold(ixm,jym)=ps(ixm,jym,1,n)
     
    194194  do jy=0,nymin1
    195195    do ix=0,nxmin1
    196       tvold(ix,jy)=tt2(ix,jy,1,n)*(1.+0.378*ew*(td2(ix,jy,1,n))/ &
     196      tvold(ix,jy)=tt2(ix,jy,1,n)*(1.+0.378*ew(td2(ix,jy,1,n))/ &
    197197           ps(ix,jy,1,n))
    198198    enddo
  • src/verttransform_gfs.f90

    r4fbe7a5 r6ecb30a  
    2020!**********************************************************************
    2121
    22 subroutine verttransform(n,uuh,vvh,wwh,pvh)
     22subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh)
    2323  !                      i  i   i   i   i
    2424  !*****************************************************************************
     
    4747  !  Changes, Bernd C. Krueger, Feb. 2001:
    4848  !   Variables tth and qvh (on eta coordinates) from common block
     49  !
     50  !   Unified ECMWF and GFS builds                                     
     51  !   Marian Harustak, 12.5.2017                                       
     52  !     - Renamed routine from verttransform to verttransform_gfs
     53  !
    4954  !*****************************************************************************
    5055  !                                                                            *
     
    531536
    532537
    533 end subroutine verttransform
     538end subroutine verttransform_gfs
  • src/writeheader.f90

    rf13406c r6ecb30a  
    3535  !*****************************************************************************
    3636  !                                                                            *
     37  !  Modified to remove TRIM around the output of flexversion so that          *
     38  !  it will be a constant length (defined in com_mod.f90) in output header    *
     39  !                                                                            *
     40  !     Don Morton, Boreal Scientific Computing                                *
     41  !     07 May 2017                                                            *
     42  !                                                                            *
     43  !*****************************************************************************
     44  !                                                                            *
    3745  ! Variables:                                                                 *
    3846  !                                                                            *
     
    6775
    6876  if (ldirect.eq.1) then
    69     write(unitheader) ibdate,ibtime, trim(flexversion)
     77    write(unitheader) ibdate,ibtime, flexversion
    7078  else
    71     write(unitheader) iedate,ietime, trim(flexversion)
     79    write(unitheader) iedate,ietime, flexversion
    7280  endif
    7381
  • src/writeheader_nest.f90

    r4fbe7a5 r6ecb30a  
    3535  !*****************************************************************************
    3636  !                                                                            *
     37  !  Modified to remove TRIM around the output of flexversion so that          *
     38  !  it will be a constant length (defined in com_mod.f90) in output header    *
     39  !                                                                            *
     40  !     Don Morton, Boreal Scientific Computing                                *
     41  !     07 May 2017                                                            *
     42  !                                                                            *
     43  !*****************************************************************************
     44  !                                                                            *
    3745  ! Variables:                                                                 *
    3846  !                                                                            *
     
    6775
    6876  if (ldirect.eq.1) then
    69     write(unitheader) ibdate,ibtime, trim(flexversion)
     77    write(unitheader) ibdate,ibtime, flexversion
    7078  else
    71     write(unitheader) iedate,ietime, trim(flexversion)
     79    write(unitheader) iedate,ietime, flexversion
    7280  endif
    7381
  • src/writeheader_nest_surf.f90

    rf13406c r6ecb30a  
    3535  !*****************************************************************************
    3636  !                                                                            *
     37  !  Modified to remove TRIM around the output of flexversion so that          *
     38  !  it will be a constant length (defined in com_mod.f90) in output header    *
     39  !                                                                            *
     40  !     Don Morton, Boreal Scientific Computing                                *
     41  !     07 May 2017                                                            *
     42  !                                                                            *
     43  !*****************************************************************************
     44  !                                                                            *
    3745  ! Variables:                                                                 *
    3846  !                                                                            *
     
    6775
    6876  if (ldirect.eq.1) then
    69     write(unitheader) ibdate,ibtime,trim(flexversion)
     77    write(unitheader) ibdate,ibtime,flexversion
    7078  else
    71     write(unitheader) iedate,ietime,trim(flexversion)
     79    write(unitheader) iedate,ietime,flexversion
    7280  endif
    7381
  • src/writeheader_surf.f90

    rf13406c r6ecb30a  
    3535  !*****************************************************************************
    3636  !                                                                            *
     37  !  Modified to remove TRIM around the output of flexversion so that          *
     38  !  it will be a constant length (defined in com_mod.f90) in output header    *
     39  !                                                                            *
     40  !     Don Morton, Boreal Scientific Computing                                *
     41  !     07 May 2017                                                            *
     42  !                                                                            *
     43  !*****************************************************************************
     44  !                                                                            *
    3745  ! Variables:                                                                 *
    3846  !                                                                            *
     
    6775
    6876  if (ldirect.eq.1) then
    69     write(unitheader) ibdate,ibtime, trim(flexversion)
     77    write(unitheader) ibdate,ibtime, flexversion
    7078  else
    71     write(unitheader) iedate,ietime, trim(flexversion)
     79    write(unitheader) iedate,ietime, flexversion
    7280  endif
    7381
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG