00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015 module ice_pio
00016
00017
00018
00019 use shr_kind_mod, only: r8 => shr_kind_r8, in=>shr_kind_in
00020 use shr_kind_mod, only: cl => shr_kind_cl
00021 use shr_sys_mod , only: shr_sys_flush
00022 use ice_kinds_mod
00023 use ice_blocks
00024 use ice_broadcast
00025 use ice_communicate
00026 use ice_domain, only : nblocks, blocks_ice
00027 use ice_domain_size
00028 use ice_fileunits
00029 use ice_exit
00030 use pio
00031
00032 implicit none
00033 private
00034
00035
00036
00037
00038
00039
00040
00041 interface ice_pio_initdecomp
00042 module procedure ice_pio_initdecomp_2d
00043 module procedure ice_pio_initdecomp_3d
00044 module procedure ice_pio_initdecomp_3d_inner
00045 end interface
00046
00047 public ice_pio_init
00048 public ice_pio_finalize
00049 public ice_pio_initdecomp
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059 integer, private :: ice_pio_stride, ice_num_iotasks,
00060 ice_pio_root,ice_pio_type
00061
00062 type(iosystem_desc_t) :: ice_pio_subsystem
00063
00064
00065
00066 contains
00067
00068
00069
00070
00071
00072
00073
00074 subroutine ice_pio_finalize
00075
00076 integer :: ierr
00077
00078 call pio_finalize(ice_pio_subsystem,ierr)
00079
00080 end subroutine ice_pio_finalize
00081
00082
00083
00084
00085
00086
00087 subroutine ice_pio_init(mode, filename, File, clobber, cdf64)
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097 implicit none
00098 character(len=*) , intent(in) :: mode
00099 character(len=*) , intent(in) :: filename
00100 type(file_desc_t) , intent(inout) :: File
00101 logical,optional , intent(in) :: clobber
00102 logical,optional , intent(in) :: cdf64
00103
00104
00105
00106 integer (int_kind) ::
00107 nml_error
00108
00109 character(len=16) :: ice_pio_type_name
00110
00111 logical :: exists
00112 logical :: lclobber
00113 logical :: lcdf64
00114 integer :: status
00115 integer :: nmode
00116 character(*),parameter :: subName = '(ice_pio_wopen) '
00117
00118
00119
00120 namelist /ice_pio_nml/ &
00121 ice_num_iotasks, &
00122 ice_pio_stride, &
00123 ice_pio_type_name
00124
00125 ice_pio_root = 1
00126
00127 ice_num_iotasks = -1
00128 ice_pio_stride = -1
00129 ice_pio_type_name = 'netcdf'
00130
00131 if (my_task == master_task) then
00132 call get_fileunit(nu_nml)
00133 open (nu_nml, file=nml_filename, status='old',iostat=nml_error)
00134 if (nml_error /= 0) then
00135 nml_error = -1
00136 else
00137 nml_error = 1
00138 endif
00139 do while (nml_error > 0)
00140 read(nu_nml, nml=ice_pio_nml,iostat=nml_error)
00141 if (nml_error > 0) read(nu_nml,*)
00142 end do
00143 if (nml_error == 0) close(nu_nml)
00144 call ice_pio_set_params(ice_pio_type_name)
00145 call release_fileunit(nu_nml)
00146
00147 write(nu_diag,*) 'CICE PIO parameter settings...'
00148 write(nu_diag,*) ' ice_pio_stride = ',ice_pio_stride
00149 write(nu_diag,*) ' ice_num_iotasks = ',ice_num_iotasks
00150 write(nu_diag,*) ' ice pio_type_name = ',ice_pio_type_name
00151 call shr_sys_flush(nu_diag)
00152 endif
00153
00154 call broadcast_scalar(nml_error, master_task)
00155 if (nml_error /= 0) then
00156 call abort_ice('ice: error reading pio_nml')
00157 endif
00158
00159 call broadcast_scalar(ice_num_iotasks, master_task)
00160 call broadcast_scalar(ice_pio_root, master_task)
00161 call broadcast_scalar(ice_pio_stride, master_task)
00162 call broadcast_scalar(ice_pio_type, master_task)
00163
00164 call pio_init(my_task, MPI_COMM_ICE, ice_num_iotasks, &
00165 ice_pio_root, ice_pio_stride, PIO_REARR_BOX, ice_pio_subsystem)
00166
00167 if (trim(mode) == 'write') then
00168 lclobber = .false.
00169 if (present(clobber)) lclobber=clobber
00170
00171 lcdf64 = .false.
00172 if (present(cdf64)) lcdf64=cdf64
00173
00174 if (File%fh<0) then
00175
00176 inquire(file=trim(filename),exist=exists)
00177 if (exists) then
00178 if (lclobber) then
00179 nmode = pio_clobber
00180 if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
00181 status = pio_createfile(ice_pio_subsystem, File, ice_pio_type, trim(filename), nmode)
00182 if (my_task == master_task) then
00183 write(nu_diag,*) subname,' create file ',trim(filename)
00184 end if
00185 else
00186 status = pio_openfile(ice_pio_subsystem, File, ice_pio_type, trim(filename), pio_write)
00187 if (my_task == master_task) then
00188 write(nu_diag,*) subname,' open file ',trim(filename)
00189 end if
00190 endif
00191 else
00192 nmode = pio_noclobber
00193 if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
00194 status = pio_createfile(ice_pio_subsystem, File, ice_pio_type, trim(filename), nmode)
00195 if (my_task == master_task) then
00196 write(nu_diag,*) subname,' create file ',trim(filename)
00197 end if
00198 endif
00199 else
00200
00201 endif
00202 end if
00203
00204 if (trim(mode) == 'read') then
00205 inquire(file=trim(filename),exist=exists)
00206 if (exists) then
00207 status = pio_openfile(ice_pio_subsystem, File, ice_pio_type, trim(filename), pio_nowrite)
00208 call pio_seterrorhandling(File,PIO_RETURN_ERROR)
00209 else
00210 if(my_task==master_task) then
00211 write(nu_diag,*) 'ice_pio_ropen ERROR: file invalid ',trim(filename)
00212 end if
00213 call abort_ice('aborting in ice-pio_ropen with invalid file')
00214 endif
00215 end if
00216
00217 end subroutine ice_pio_init
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227 subroutine ice_pio_set_params(ice_pio_type_name)
00228
00229
00230
00231
00232
00233
00234 use shr_string_mod,only: shr_string_toUpper
00235
00236
00237
00238 implicit none
00239 character(len=*), intent(in) :: ice_pio_type_name
00240
00241
00242
00243 character(len=16) :: tmpname
00244 integer (kind=int_kind) :: npes
00245
00246 tmpname = shr_string_toupper(ice_pio_type_name)
00247
00248 if (trim(tmpname) == 'NETCDF') then
00249 ice_pio_type = iotype_netcdf
00250 else if (trim(tmpname) == 'PNETCDF') then
00251 ice_pio_type = iotype_pnetcdf
00252 else
00253 if (my_task == master_task) then
00254 write(nu_diag,*)' Bad io_type argument - using iotype_netcdf'
00255 end if
00256 ice_pio_type = iotype_netcdf
00257 end if
00258
00259 npes = get_num_procs()
00260 if (ice_pio_stride>0 .and. ice_num_iotasks<0) then
00261 ice_num_iotasks = npes/ice_pio_stride
00262 else if (ice_num_iotasks>0 .and. ice_pio_stride<0) then
00263 ice_pio_stride = npes/ice_num_iotasks
00264 else if (ice_num_iotasks<0 .and. ice_pio_stride<0) then
00265 ice_pio_stride = max(min(npes,4),npes/8)
00266 ice_num_iotasks = npes/ice_pio_stride
00267 end if
00268
00269 if (ice_pio_root<0) then
00270 ice_pio_root = 1
00271 endif
00272 ice_pio_root = min(ice_pio_root,npes-1)
00273
00274 if(ice_pio_root + (ice_pio_stride)*(ice_num_iotasks-1) >= npes .or. &
00275 ice_pio_stride<=0 .or. ice_num_iotasks<=0 .or. ice_pio_root < 0 .or. &
00276 ice_pio_root > npes-1) then
00277 if (my_task == master_task) then
00278 write(nu_diag,*)&
00279 'ice_pio_stride or ice_num_iotasks out of bounds, resetting to defaults ',&
00280 ice_pio_stride, ice_num_iotasks, ice_pio_root
00281 end if
00282 ice_pio_stride = max(1,npes/4)
00283 ice_num_iotasks = npes/ice_pio_stride
00284 ice_pio_root = min(1,npes-1)
00285 end if
00286 if (my_task == master_task) then
00287 write(nu_diag,*)'Using io_type=',tmpname,' stride=',ice_pio_stride,&
00288 ' iotasks=',ice_num_iotasks,' root=',ice_pio_root
00289 end if
00290
00291 end subroutine ice_pio_set_params
00292
00293
00294
00295 subroutine ice_pio_initdecomp_2d(iodesc)
00296
00297 type(io_desc_t), intent(out) :: iodesc
00298
00299 integer (kind=int_kind) ::
00300 iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k
00301
00302 type(block) :: this_block
00303
00304 integer(kind=int_kind), pointer :: dof2d(:)
00305
00306 allocate(dof2d(nx_block*ny_block*nblocks))
00307
00308 n=0
00309 do iblk = 1, nblocks
00310 this_block = get_block(blocks_ice(iblk),iblk)
00311 ilo = this_block%ilo
00312 ihi = this_block%ihi
00313 jlo = this_block%jlo
00314 jhi = this_block%jhi
00315
00316 do j=1,ny_block
00317 do i=1,nx_block
00318 n = n+1
00319 if (j < jlo .or. j>jhi) then
00320 dof2d(n) = 0
00321 else if (i < ilo .or. i > ihi) then
00322 dof2d(n) = 0
00323 else
00324 lon = this_block%i_glob(i)
00325 lat = this_block%j_glob(j)
00326 dof2d(n) = (lat-1)*nx_global + lon
00327 endif
00328 enddo
00329 enddo
00330 end do
00331
00332 call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global/), &
00333 dof2d, iodesc)
00334
00335 deallocate(dof2d)
00336
00337 end subroutine ice_pio_initdecomp_2d
00338
00339
00340
00341 subroutine ice_pio_initdecomp_3d (ndim3, iodesc)
00342
00343 integer(kind=int_kind), intent(in) :: ndim3
00344 type(io_desc_t), intent(out) :: iodesc
00345
00346 integer (kind=int_kind) ::
00347 iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k
00348
00349 type(block) :: this_block
00350
00351 integer(kind=int_kind), pointer :: dof3d(:)
00352
00353 allocate(dof3d(nx_block*ny_block*nblocks*ndim3))
00354
00355 n=0
00356 do iblk = 1, nblocks
00357 this_block = get_block(blocks_ice(iblk),iblk)
00358 ilo = this_block%ilo
00359 ihi = this_block%ihi
00360 jlo = this_block%jlo
00361 jhi = this_block%jhi
00362
00363 do k=1,ndim3
00364 do j=1,ny_block
00365 do i=1,nx_block
00366 n = n+1
00367 if (j < jlo .or. j>jhi) then
00368 dof3d(n)=0
00369 else if (i < ilo .or. i > ihi) then
00370 dof3d(n) = 0
00371 else
00372 lon = this_block%i_glob(i)
00373 lat = this_block%j_glob(j)
00374 dof3d(n) = ((lat-1)*nx_global + lon) + (k-1)*nx_global*ny_global
00375 endif
00376 enddo
00377 enddo
00378 enddo
00379 end do
00380
00381 call pio_initdecomp(ice_pio_subsystem, pio_double, (/nx_global,ny_global,ndim3/), &
00382 dof3d, iodesc)
00383
00384 deallocate(dof3d)
00385
00386 end subroutine ice_pio_initdecomp_3d
00387
00388
00389
00390 subroutine ice_pio_initdecomp_3d_inner(ndim3, inner_dim, iodesc)
00391
00392 integer(kind=int_kind), intent(in) :: ndim3
00393 logical, intent(in) :: inner_dim
00394 type(io_desc_t), intent(out) :: iodesc
00395
00396 integer (kind=int_kind) ::
00397 iblk,ilo,ihi,jlo,jhi,lon,lat,i,j,n,k
00398
00399 type(block) :: this_block
00400
00401 integer(kind=int_kind), pointer :: dof3d(:)
00402
00403 allocate(dof3d(nx_block*ny_block*nblocks*ndim3))
00404
00405 n=0
00406 do iblk = 1, nblocks
00407 this_block = get_block(blocks_ice(iblk),iblk)
00408 ilo = this_block%ilo
00409 ihi = this_block%ihi
00410 jlo = this_block%jlo
00411 jhi = this_block%jhi
00412
00413 do j=1,ny_block
00414 do i=1,nx_block
00415 do k=1,ndim3
00416 n = n+1
00417 if (j < jlo .or. j>jhi) then
00418 dof3d(n) = 0
00419 else if (i < ilo .or. i > ihi) then
00420 dof3d(n) = 0
00421 else
00422 lon = this_block%i_glob(i)
00423 lat = this_block%j_glob(j)
00424 dof3d(n) = k + ((lon-1) + (lat-1)*nx_global)*ndim3
00425 endif
00426 end do
00427 enddo
00428 enddo
00429 end do
00430
00431 call pio_initdecomp(ice_pio_subsystem, pio_double, (/ndim3,nx_global,ny_global/), &
00432 dof3d, iodesc)
00433
00434 deallocate(dof3d)
00435
00436 end subroutine ice_pio_initdecomp_3d_inner
00437
00438
00439 end module ice_pio