Changeset c2bd55e in flexpart.git


Ignore:
Timestamp:
Nov 24, 2017, 1:52:19 PM (6 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:
0ecc1fe
Parents:
0c00f1f
Message:

Fixed an issue with nested input fields, and nested output fields that have more than 1000 points in x or y (netcdf output)

Location:
src
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • src/com_mod.f90

    rfe32dca rc2bd55e  
    819819    allocate(clwchn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
    820820    allocate(ciwchn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
    821     allocate(ctwcn(0:nxmax-1,0:nymax-1,numwfmem,numbnests))
     821    allocate(ctwcn(0:nxmaxn-1,0:nymaxn-1,numwfmem,numbnests))
    822822
    823823    clwcn(:,:,:,:,:)=0.
  • src/mpi_mod.f90

    rbb579a9 rc2bd55e  
    19611961    if (readclouds) then
    19621962      j=j+1
    1963       call MPI_Irecv(ctwc(:,:,mind),d2s1*5,mp_sp,id_read,MPI_ANY_TAG,&
     1963      call MPI_Irecv(ctwc(:,:,mind),d2s1,mp_sp,id_read,MPI_ANY_TAG,&
    19641964           &MPI_COMM_WORLD,reqs(j),mp_ierr)
    19651965      if (mp_ierr /= 0) goto 600
     
    23262326      if (readclouds) then
    23272327        j=j+1
    2328         call MPI_Irecv(ctwcn(:,:,mind,k),d2s1*5,mp_sp,id_read,MPI_ANY_TAG,&
     2328        call MPI_Irecv(ctwcn(:,:,mind,k),d2s1,mp_sp,id_read,MPI_ANY_TAG,&
    23292329             &MPI_COMM_WORLD,reqs(j),mp_ierr)
    23302330        if (mp_ierr /= 0) goto 600
  • src/netcdf_output_mod.f90

    r4c64400 rc2bd55e  
    272272  character(len=10)           :: fprefix
    273273  character(len=3)            :: anspec
    274   character                   :: adate*8,atime*6,timeunit*32
    275   real, dimension(1000)       :: coord
     274  CHARACTER                   :: adate*8,atime*6,timeunit*32
     275  ! ESO DBG: WHY IS THIS HARDCODED TO 1000?
     276  !REAL, DIMENSION(1000)       :: coord
     277  real, allocatable, dimension(:) :: coord
    276278
    277279  integer                     :: cache_size
     
    613615  ! longitudes (grid cell centers)
    614616  if (lnest) then
     617    if (.not.allocated(coord)) allocate(coord(numxgridn))
    615618     do i = 1,numxgridn
    616619        coord(i) = outlon0n + (i-0.5)*dxoutn
    617620     enddo
    618621     call nf90_err(nf90_put_var(ncid, lonID, coord(1:numxgridn)))
     622     deallocate(coord)
    619623  else
     624    if (.not.allocated(coord)) allocate(coord(numxgrid))
    620625     do i = 1,numxgrid
    621626        coord(i) = outlon0 + (i-0.5)*dxout
    622627     enddo
    623628     call nf90_err(nf90_put_var(ncid, lonID, coord(1:numxgrid)))
     629     deallocate(coord)
    624630  endif
    625631  ! latitudes (grid cell centers)
    626632  if (lnest) then
     633    if (.not.allocated(coord)) allocate(coord(numygridn))
    627634     do i = 1,numygridn
    628635        coord(i) = outlat0n + (i-0.5)*dyoutn
    629636     enddo
    630637     call nf90_err(nf90_put_var(ncid, latID, coord(1:numygridn)))
     638     deallocate(coord)
    631639  else
     640    if (.not.allocated(coord)) allocate(coord(numygrid))
    632641     do i = 1,numygrid
    633642        coord(i) = outlat0 + (i-0.5)*dyout
    634643     enddo
    635644     call nf90_err(nf90_put_var(ncid, latID, coord(1:numygrid)))
     645     deallocate(coord)
    636646  endif
    637647  ! levels
  • src/par_mod.f90

    r273a015 rc2bd55e  
    153153
    154154! GFS
    155  integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138,nxshift=0
     155integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138,nxshift=0
    156156
    157157
     
    160160  !*********************************************
    161161
    162   integer,parameter :: maxnests=0,nxmaxn=451,nymaxn=226
     162  integer,parameter :: maxnests=1,nxmaxn=451,nymaxn=426
    163163
    164164  ! nxmax,nymax        maximum dimension of wind fields in x and y
     
    218218  !**************************************************
    219219
    220   integer,parameter :: maxpart=3000000
     220  integer,parameter :: maxpart=30000000
    221221  integer,parameter :: maxspec=6
    222222
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG