source: lmdz_wrf/trunk/WRFV3/external/io_pnetcdf/field_routines.F90 @ 1327

Last change on this file since 1327 was 1, checked in by lfita, 11 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 8.1 KB
Line 
1!*------------------------------------------------------------------------------
2!*  Standard Disclaimer
3!*
4!*  Forecast Systems Laboratory
5!*  NOAA/OAR/ERL/FSL
6!*  325 Broadway
7!*  Boulder, CO     80303
8!*
9!*  AVIATION DIVISION
10!*  ADVANCED COMPUTING BRANCH
11!*  SMS/NNT Version: 2.0.0
12!*
13!*  This software and its documentation are in the public domain and
14!*  are furnished "as is".  The United States government, its
15!*  instrumentalities, officers, employees, and agents make no
16!*  warranty, express or implied, as to the usefulness of the software
17!*  and documentation for any purpose.  They assume no
18!*  responsibility (1) for the use of the software and documentation;
19!*  or (2) to provide technical support to users.
20!*
21!*  Permission to use, copy, modify, and distribute this software is
22!*  hereby granted, provided that this disclaimer notice appears in
23!*  all copies.  All modifications to this software must be clearly
24!*  documented, and are solely the responsibility of the agent making
25!*  the modification.  If significant modifications or enhancements
26!*  are made to this software, the SMS Development team
27!*  (sms-info@fsl.noaa.gov) should be notified.
28!*
29!*----------------------------------------------------------------------------
30!*
31!*  WRF NetCDF I/O
32!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
33!*  Date:    October 6, 2000
34!*
35!*----------------------------------------------------------------------------
36subroutine ext_pnc_RealFieldIO(Coll,IO,NCID,VarID,VStart,VCount,Data,Status)
37  use wrf_data_pnc
38  use ext_pnc_support_routines
39  implicit none
40  include 'wrf_status_codes.h'
41#  include "pnetcdf.inc"
42  logical                     ,intent(in)    :: Coll
43  character (*)               ,intent(in)    :: IO
44  integer                     ,intent(in)    :: NCID
45  integer                     ,intent(in)    :: VarID
46  integer ,dimension(NVarDims),intent(in)    :: VStart
47  integer ,dimension(NVarDims),intent(in)    :: VCount
48  real, dimension(*)          ,intent(inout) :: Data
49  integer                     ,intent(out)   :: Status
50  integer                                    :: stat
51!local
52  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
53  VStart_mpi = VStart
54  VCount_mpi = VCount
55
56  if(IO == 'write') then
57    if(Coll)then
58      stat = NFMPI_PUT_VARA_REAL_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
59    else
60      stat = NFMPI_PUT_VARA_REAL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
61    end if
62  else
63    if(Coll)then
64      stat = NFMPI_GET_VARA_REAL_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
65   else
66      stat = NFMPI_GET_VARA_REAL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
67   end if
68  endif
69  call netcdf_err(stat,Status)
70  if(Status /= WRF_NO_ERR) then
71    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
72    call wrf_debug ( WARN , msg)
73  endif
74  return
75end subroutine ext_pnc_RealFieldIO
76
77subroutine ext_pnc_DoubleFieldIO(Coll,IO,NCID,VarID,VStart,VCount,Data,Status)
78  use wrf_data_pnc
79  use ext_pnc_support_routines
80  implicit none
81  include 'wrf_status_codes.h'
82#  include "pnetcdf.inc"
83  logical                     ,intent(in)    :: Coll
84  character (*)               ,intent(in)    :: IO
85  integer                     ,intent(in)    :: NCID
86  integer                     ,intent(in)    :: VarID
87  integer ,dimension(NVarDims),intent(in)    :: VStart
88  integer ,dimension(NVarDims),intent(in)    :: VCount
89  real*8                      ,intent(inout) :: Data
90  integer                     ,intent(out)   :: Status
91  integer                                    :: stat
92!local
93  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
94  VStart_mpi = VStart
95  VCount_mpi = VCount
96
97  if(IO == 'write') then
98    if(Coll)then
99      stat = NFMPI_PUT_VARA_DOUBLE_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
100   else
101      stat = NFMPI_PUT_VARA_DOUBLE(NCID,VarID,VStart_mpi,VCount_mpi,Data)
102   endif
103  else
104    if(Coll)then
105      stat = NFMPI_GET_VARA_DOUBLE_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
106   else
107      stat = NFMPI_GET_VARA_DOUBLE(NCID,VarID,VStart_mpi,VCount_mpi,Data)
108   endif
109  endif
110  call netcdf_err(stat,Status)
111  if(Status /= WRF_NO_ERR) then
112    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
113    call wrf_debug ( WARN , msg)
114  endif
115  return
116end subroutine ext_pnc_DoubleFieldIO
117
118subroutine ext_pnc_IntFieldIO(Coll,IO,NCID,VarID,VStart,VCount,Data,Status)
119  use wrf_data_pnc
120  use ext_pnc_support_routines
121  implicit none
122  include 'wrf_status_codes.h'
123#  include "pnetcdf.inc"
124  logical                     ,intent(in)    :: Coll
125  character (*)               ,intent(in)    :: IO
126  integer                     ,intent(in)    :: NCID
127  integer                     ,intent(in)    :: VarID
128  integer ,dimension(NVarDims),intent(in)    :: VStart
129  integer ,dimension(NVarDims),intent(in)    :: VCount
130  integer                     ,intent(inout) :: Data
131  integer                     ,intent(out)   :: Status
132  integer                                    :: stat
133!local
134  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
135  VStart_mpi = VStart
136  VCount_mpi = VCount
137
138  if(IO == 'write') then
139    if(Coll)then
140      stat = NFMPI_PUT_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
141    else
142      stat = NFMPI_PUT_VARA_INT(NCID,VarID,VStart_mpi,VCount_mpi,Data)
143    endif
144  else
145    if(Coll)then
146      stat = NFMPI_GET_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Data)
147   else
148      stat = NFMPI_GET_VARA_INT(NCID,VarID,VStart_mpi,VCount_mpi,Data)
149   end if
150  endif
151  call netcdf_err(stat,Status)
152  if(Status /= WRF_NO_ERR) then
153    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
154    call wrf_debug ( WARN , msg)
155  endif
156  return
157end subroutine ext_pnc_IntFieldIO
158
159subroutine ext_pnc_LogicalFieldIO(Coll,IO,NCID,VarID,VStart,VCount,Data,Status)
160  use wrf_data_pnc
161  use ext_pnc_support_routines
162  implicit none
163  include 'wrf_status_codes.h'
164#  include "pnetcdf.inc"
165  logical                                         ,intent(in)    :: Coll
166  character (*)                                   ,intent(in)    :: IO
167  integer                                         ,intent(in)    :: NCID
168  integer                                         ,intent(in)    :: VarID
169  integer,dimension(NVarDims)                     ,intent(in)    :: VStart
170  integer,dimension(NVarDims)                     ,intent(in)    :: VCount
171  logical,dimension(VCount(1),VCount(2),VCount(3)),intent(inout) :: Data
172  integer                                         ,intent(out)   :: Status
173  integer,dimension(:,:,:),allocatable                           :: Buffer
174  integer                                                        :: stat
175  integer                                                        :: i,j,k
176!local
177  integer(KIND=MPI_OFFSET_KIND), dimension(NVarDims)    :: VStart_mpi, VCount_mpi
178  VStart_mpi = VStart
179  VCount_mpi = VCount
180
181  allocate(Buffer(VCount(1),VCount(2),VCount(3)), STAT=stat)
182  if(stat/= 0) then
183    Status = WRF_ERR_FATAL_ALLOCATION_ERROR
184    write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
185    call wrf_debug ( FATAL , msg)
186    return
187  endif
188  if(IO == 'write') then
189    do k=1,VCount(3)
190      do j=1,VCount(2)
191        do i=1,VCount(1)
192          if(data(i,j,k)) then
193            Buffer(i,j,k)=1
194          else
195            Buffer(i,j,k)=0
196          endif
197        enddo
198      enddo
199    enddo
200    if(Coll)then
201      stat = NFMPI_PUT_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Buffer)
202   else
203      stat = NFMPI_PUT_VARA_INT(NCID,VarID,VStart_mpi,VCount_mpi,Buffer)
204   end if
205  else
206    if(Coll)then
207      stat = NFMPI_GET_VARA_INT_ALL(NCID,VarID,VStart_mpi,VCount_mpi,Buffer)
208    else
209      stat = NFMPI_GET_VARA_INT(NCID,VarID,VStart_mpi,VCount_mpi,Buffer)
210    end if
211    Data = Buffer == 1
212  endif
213  call netcdf_err(stat,Status)
214  if(Status /= WRF_NO_ERR) then
215    write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
216    call wrf_debug ( WARN , msg)
217    return
218  endif
219  deallocate(Buffer, STAT=stat)
220  if(stat/= 0) then
221    Status = WRF_ERR_FATAL_DEALLOCATION_ERR
222    write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
223    call wrf_debug ( FATAL , msg)
224    return
225  endif
226  return
227end subroutine ext_pnc_LogicalFieldIO
Note: See TracBrowser for help on using the repository browser.