00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021 module ice_read_write
00022
00023
00024
00025 use ice_kinds_mod
00026 use ice_constants
00027 use ice_communicate, only: my_task, master_task
00028 use ice_broadcast
00029 use ice_domain_size
00030 use ice_blocks
00031 use ice_fileunits
00032 #ifdef ncdf
00033 use netcdf
00034 #endif
00035
00036
00037
00038 implicit none
00039
00040 public :: ice_read_global_nc
00041
00042 interface ice_read_global_nc
00043 module procedure ice_read_global_nc_dbl, &
00044 ice_read_global_nc_r4
00045 end interface
00046
00047
00048
00049 contains
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059 subroutine ice_open(nu, filename, nbits)
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074 integer (kind=int_kind), intent(in) ::
00075 nu ,
00076 nbits
00077
00078 character (*) :: filename
00079
00080
00081
00082 if (my_task == master_task) then
00083
00084 if (nbits == 0) then
00085
00086 open(nu,file=filename,form='unformatted')
00087
00088 else
00089 open(nu,file=filename,recl=nx_global*ny_global*nbits/8, &
00090 form='unformatted',access='direct')
00091 endif
00092
00093 endif
00094
00095 end subroutine ice_open
00096
00097
00098
00099
00100
00101
00102
00103
00104 subroutine ice_read(nu, nrec, work, atype, diag, &
00105 field_loc, field_type, &
00106 ignore_eof, hit_eof)
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123 use ice_domain
00124 use ice_gather_scatter
00125 use ice_work, only: work_g1, work_gr, work_gi4, work_gi8
00126
00127
00128
00129 integer (kind=int_kind), intent(in) ::
00130 nu ,
00131 nrec
00132
00133 real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks),
00134 intent(out) ::
00135 work
00136
00137 character (len=4), intent(in) ::
00138 atype
00139
00140
00141 logical (kind=log_kind), intent(in) ::
00142 diag
00143
00144 integer (kind=int_kind), optional, intent(in) ::
00145 field_loc,
00146 field_type
00147
00148 logical (kind=log_kind), optional, intent(in) :: ignore_eof
00149 logical (kind=log_kind), optional, intent(out) :: hit_eof
00150
00151
00152
00153 integer (kind=int_kind) :: i, j, ios
00154
00155 real (kind=dbl_kind) ::
00156 amin, amax
00157
00158 logical (kind=log_kind) :: ignore_eof_use
00159
00160 if (my_task == master_task) then
00161 allocate(work_g1(nx_global,ny_global))
00162 else
00163 allocate(work_g1(1,1))
00164 endif
00165
00166 if (my_task == master_task) then
00167
00168
00169
00170
00171 if (present(hit_eof)) hit_eof = .false.
00172
00173 if (atype == 'ida4') then
00174 allocate(work_gi4(nx_global,ny_global))
00175 read(nu,rec=nrec) work_gi4
00176 work_g1 = real(work_gi4,kind=dbl_kind)
00177 deallocate(work_gi4)
00178 elseif (atype == 'ida8') then
00179 allocate(work_gi8(nx_global,ny_global))
00180 read(nu,rec=nrec) work_gi8
00181 work_g1 = real(work_gi8,kind=dbl_kind)
00182 deallocate(work_gi8)
00183 elseif (atype == 'rda4') then
00184 allocate(work_gr(nx_global,ny_global))
00185 read(nu,rec=nrec) work_gr
00186 work_g1 = work_gr
00187 deallocate(work_gr)
00188 elseif (atype == 'rda8') then
00189 read(nu,rec=nrec) work_g1
00190 elseif (atype == 'ruf8') then
00191 if (present(ignore_eof)) then
00192 ignore_eof_use = ignore_eof
00193 else
00194 ignore_eof_use = .false.
00195 endif
00196 if (ignore_eof_use) then
00197
00198 read(nu, iostat=ios) ((work_g1(i,j),i=1,nx_global), &
00199 j=1,ny_global)
00200 if (present(hit_eof)) hit_eof = ios < 0
00201 else
00202 read(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global)
00203 endif
00204 else
00205 write(nu_diag,*) ' ERROR: reading unknown atype ',atype
00206 endif
00207 endif
00208
00209 if (present(hit_eof)) then
00210 call broadcast_scalar(hit_eof,master_task)
00211 if (hit_eof) then
00212 deallocate(work_g1)
00213 return
00214 endif
00215 endif
00216
00217
00218
00219
00220
00221 if (my_task==master_task .and. diag) then
00222 amin = minval(work_g1)
00223 amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
00224 write(nu_diag,*) ' read_global ',nu, nrec, amin, amax
00225 endif
00226
00227
00228
00229
00230
00231
00232 if (present(field_loc)) then
00233 call scatter_global(work, work_g1, master_task, distrb_info, &
00234 field_loc, field_type)
00235 else
00236 call scatter_global(work, work_g1, master_task, distrb_info, &
00237 field_loc_noupdate, field_type_noupdate)
00238 endif
00239
00240 deallocate(work_g1)
00241
00242 end subroutine ice_read
00243
00244
00245
00246
00247
00248
00249
00250
00251 subroutine ice_read_global (nu, nrec, work_g, atype, diag, &
00252 ignore_eof, hit_eof)
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265 use ice_work, only: work_gr, work_gi4, work_gi8
00266
00267
00268
00269 integer (kind=int_kind), intent(in) ::
00270 nu ,
00271 nrec
00272
00273 real (kind=dbl_kind), dimension(:,:),
00274 intent(out) ::
00275 work_g
00276
00277 character (len=4) ::
00278 atype
00279
00280
00281 logical (kind=log_kind) ::
00282 diag
00283
00284 logical (kind=log_kind), optional, intent(in) :: ignore_eof
00285 logical (kind=log_kind), optional, intent(out) :: hit_eof
00286
00287
00288
00289 integer (kind=int_kind) :: i, j, ios
00290
00291 real (kind=dbl_kind) ::
00292 amin, amax
00293
00294 logical (kind=log_kind) :: ignore_eof_use
00295
00296 work_g(:,:) = c0
00297
00298 if (my_task == master_task) then
00299
00300
00301
00302
00303 if (present(hit_eof)) hit_eof = .false.
00304
00305 if (atype == 'ida4') then
00306 allocate(work_gi4(nx_global,ny_global))
00307 read(nu,rec=nrec) work_gi4
00308 work_g = real(work_gi4,kind=dbl_kind)
00309 deallocate(work_gi4)
00310 elseif (atype == 'ida8') then
00311 allocate(work_gi8(nx_global,ny_global))
00312 read(nu,rec=nrec) work_gi8
00313 work_g = real(work_gi8,kind=dbl_kind)
00314 deallocate(work_gi8)
00315 elseif (atype == 'rda4') then
00316 allocate(work_gr(nx_global,ny_global))
00317 read(nu,rec=nrec) work_gr
00318 work_g = work_gr
00319 deallocate(work_gr)
00320 elseif (atype == 'rda8') then
00321 read(nu,rec=nrec) work_g
00322 elseif (atype == 'ruf8') then
00323 if (present(ignore_eof)) then
00324 ignore_eof_use = ignore_eof
00325 else
00326 ignore_eof_use = .false.
00327 endif
00328 if (ignore_eof_use) then
00329
00330 read(nu, iostat=ios) ((work_g(i,j),i=1,nx_global), &
00331 j=1,ny_global)
00332 if (present(hit_eof)) hit_eof = ios < 0
00333 else
00334 read(nu) ((work_g(i,j),i=1,nx_global),j=1,ny_global)
00335 endif
00336 else
00337 write(nu_diag,*) ' ERROR: reading unknown atype ',atype
00338 endif
00339 endif
00340
00341 if (present(hit_eof)) then
00342 call broadcast_scalar(hit_eof,master_task)
00343 if (hit_eof) return
00344 endif
00345
00346
00347
00348
00349 if (my_task == master_task .and. diag) then
00350 amin = minval(work_g)
00351 amax = maxval(work_g, mask = work_g /= spval_dbl)
00352 write(nu_diag,*) ' read_global ',nu, nrec, amin, amax
00353 endif
00354
00355 end subroutine ice_read_global
00356
00357
00358
00359
00360
00361
00362
00363
00364 subroutine ice_write(nu, nrec, work, atype, diag)
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377 use ice_gather_scatter
00378 use ice_domain
00379 use ice_work, only: work_g1, work_gr, work_gi4, work_gi8
00380
00381
00382
00383 integer (kind=int_kind), intent(in) ::
00384 nu ,
00385 nrec
00386
00387 real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks),
00388 intent(in) ::
00389 work
00390
00391 character (len=4) ::
00392 atype
00393
00394
00395 logical (kind=log_kind) ::
00396 diag
00397
00398
00399
00400 integer (kind=int_kind) :: i, j
00401
00402 real (kind=dbl_kind) ::
00403 amin, amax
00404
00405
00406
00407
00408
00409 if (my_task == master_task) then
00410 allocate(work_g1(nx_global,ny_global))
00411 else
00412 allocate(work_g1(1,1))
00413 endif
00414
00415 call gather_global(work_g1, work, master_task, distrb_info)
00416
00417 if (my_task == master_task) then
00418
00419
00420
00421
00422 if (atype == 'ida4') then
00423 allocate(work_gi4(nx_global,ny_global))
00424 work_gi4 = nint(work_g1)
00425 write(nu,rec=nrec) work_gi4
00426 deallocate(work_gi4)
00427 elseif (atype == 'ida8') then
00428 allocate(work_gi8(nx_global,ny_global))
00429 work_gi8 = nint(work_g1)
00430 write(nu,rec=nrec) work_gi8
00431 deallocate(work_gi8)
00432 elseif (atype == 'rda4') then
00433 allocate(work_gr(nx_global,ny_global))
00434 work_gr = work_g1
00435 write(nu,rec=nrec) work_gr
00436 deallocate(work_gr)
00437 elseif (atype == 'rda8') then
00438 write(nu,rec=nrec) work_g1
00439 elseif (atype == 'ruf8') then
00440 write(nu) ((work_g1(i,j),i=1,nx_global),j=1,ny_global)
00441 else
00442 write(nu_diag,*) ' ERROR: writing unknown atype ',atype
00443 endif
00444
00445
00446
00447
00448 if (diag) then
00449 amin = minval(work_g1)
00450 amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
00451 write(nu_diag,*) ' write_global ', nu, nrec, amin, amax
00452 endif
00453
00454 endif
00455
00456 deallocate(work_g1)
00457
00458 end subroutine ice_write
00459
00460
00461
00462
00463
00464
00465
00466
00467 subroutine ice_write_nc(fid, nrec, varname, work, atype, diag)
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477
00478
00479
00480 use ice_gather_scatter
00481 use ice_domain
00482 use ice_work, only: work_g1, work_gr, work_gi4, work_gi8
00483 use ice_exit
00484
00485
00486
00487 integer (kind=int_kind), intent(in) ::
00488 fid ,
00489 nrec
00490
00491 character (len=*), intent(in) :: varname
00492
00493 real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks),
00494 intent(in) ::
00495 work
00496
00497 character (len=4), intent(in) ::
00498 atype
00499
00500
00501 logical (kind=log_kind), intent(in) ::
00502 diag
00503
00504
00505
00506 integer (kind=int_kind) :: i, j, varid, numDims
00507
00508 integer (kind=int_kind) ::
00509 status
00510
00511 real (kind=dbl_kind) ::
00512 amin, amax
00513
00514 integer (kind=int_kind), allocatable ::
00515 start_arr(:), count_arr(:)
00516
00517
00518
00519
00520
00521 if (my_task == master_task) then
00522 allocate(work_g1(nx_global,ny_global))
00523 else
00524 allocate(work_g1(1,1))
00525 endif
00526
00527 call gather_global(work_g1, work, master_task, distrb_info)
00528
00529 if (my_task == master_task) then
00530
00531 status = nf90_inq_varid(fid, trim(varname), varid)
00532
00533 if (status /= nf90_noerr) then
00534 call abort_ice ( &
00535 'ice_write_nc: Cannot find variable '//trim(varname) )
00536 endif
00537
00538 status = nf90_inquire_variable(fid, varid, ndims = numDims)
00539
00540 if (status /= nf90_noerr) then
00541 call abort_ice ( &
00542 'ice_write_nc: Cannot find dimensions for '//trim(varname) )
00543 endif
00544
00545 allocate(start_arr(numDims))
00546 allocate(count_arr(numDims))
00547
00548 if (numDims > 2) then
00549 start_arr(1) = 1
00550 start_arr(2) = 1
00551 start_arr(3) = nrec
00552 count_arr(1) = nx_global
00553 count_arr(2) = ny_global
00554 count_arr(3) = 1
00555 else
00556 start_arr(1) = 1
00557 start_arr(2) = 1
00558 count_arr(1) = nx_global
00559 count_arr(2) = ny_global
00560 endif
00561
00562
00563
00564
00565 if (atype == 'ida4') then
00566 allocate(work_gi4(nx_global,ny_global))
00567 work_gi4 = nint(work_g1)
00568 status = nf90_put_var(fid,varid,work_gi4, &
00569 start=start_arr, &
00570 count=count_arr)
00571 deallocate(work_gi4)
00572 elseif (atype == 'ida8') then
00573 allocate(work_gi8(nx_global,ny_global))
00574 work_gi8 = nint(work_g1)
00575 status = nf90_put_var(fid,varid,work_gi8, &
00576 start=start_arr, &
00577 count=count_arr)
00578 deallocate(work_gi8)
00579 elseif (atype == 'rda4') then
00580 allocate(work_gr(nx_global,ny_global))
00581 work_gr = work_g1
00582 status = nf90_put_var(fid,varid,work_gr, &
00583 start=start_arr, &
00584 count=count_arr)
00585 deallocate(work_gr)
00586 elseif (atype == 'rda8') then
00587 status = nf90_put_var(fid,varid,work_g1, &
00588 start=start_arr, &
00589 count=count_arr)
00590 else
00591 write(nu_diag,*) ' ERROR: writing unknown atype ',atype
00592 endif
00593
00594
00595
00596
00597 if (diag) then
00598 amin = minval(work_g1)
00599 amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
00600 write(nu_diag,*) ' write_global ', fid, varid, nrec, amin, amax
00601 endif
00602
00603 deallocate(start_arr)
00604 deallocate(count_arr)
00605
00606 endif
00607
00608 deallocate(work_g1)
00609
00610 end subroutine ice_write_nc
00611
00612
00613
00614
00615
00616
00617
00618
00619
00620 subroutine ice_open_nc(filename, fid)
00621
00622
00623
00624
00625
00626
00627
00628
00629
00630
00631
00632 use ice_exit
00633
00634
00635
00636
00637 character (char_len_long), intent(in) ::
00638 filename
00639
00640 integer (kind=int_kind), intent(out) ::
00641 fid
00642
00643
00644
00645 #ifdef ncdf
00646 integer (kind=int_kind) ::
00647 status
00648
00649
00650 if (my_task == master_task) then
00651
00652 status = nf90_open(filename, NF90_NOWRITE, fid)
00653 if (status /= nf90_noerr) then
00654 call abort_ice ( &
00655 'ice_open_nc: Cannot open '//trim(filename) )
00656 endif
00657
00658 endif
00659
00660 #else
00661 fid = -999
00662 #endif
00663 end subroutine ice_open_nc
00664
00665
00666
00667
00668
00669
00670
00671
00672 subroutine ice_read_nc(fid, nrec, varname, work, diag, &
00673 field_loc, field_type)
00674
00675
00676
00677
00678
00679
00680
00681
00682
00683
00684
00685
00686
00687
00688
00689 use ice_domain
00690 use ice_gather_scatter
00691 #ifdef ORCA_GRID
00692 use ice_work, only: work_g1, work_g2
00693 #else
00694 use ice_work, only: work_g1
00695 #endif
00696 use ice_exit
00697
00698
00699
00700 integer (kind=int_kind), intent(in) ::
00701 fid ,
00702 nrec
00703
00704 logical (kind=log_kind), intent(in) ::
00705 diag
00706
00707 character (len=*), intent(in) ::
00708 varname
00709
00710 real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks),
00711 intent(out) ::
00712 work
00713
00714 integer (kind=int_kind), optional, intent(in) ::
00715 field_loc,
00716 field_type
00717
00718
00719
00720 #ifdef ncdf
00721
00722 integer (kind=int_kind) ::
00723 varid,
00724 status,
00725 ndim, nvar,
00726 id,
00727 dimlen
00728
00729 real (kind=dbl_kind) ::
00730 amin, amax
00731
00732 character (char_len) ::
00733 dimname
00734
00735 if (my_task == master_task) then
00736 allocate(work_g1(nx_global,ny_global))
00737 else
00738 allocate(work_g1(1,1))
00739 endif
00740
00741 #ifdef ORCA_GRID
00742 if (my_task == master_task) then
00743 allocate(work_g2(nx_global+2,ny_global+1))
00744 else
00745 allocate(work_g2(1,1))
00746 endif
00747 #endif
00748
00749 if (my_task == master_task) then
00750
00751
00752
00753
00754
00755 status = nf90_inq_varid(fid, trim(varname), varid)
00756
00757 if (status /= nf90_noerr) then
00758 call abort_ice ( &
00759 'ice_read_nc: Cannot find variable '//trim(varname) )
00760 endif
00761
00762
00763
00764
00765
00766 #ifndef ORCA_GRID
00767 status = nf90_get_var( fid, varid, work_g1, &
00768 start=(/1,1,nrec/), &
00769 count=(/nx_global,ny_global,1/) )
00770 #else
00771 status = nf90_get_var( fid, varid, work_g2, &
00772 start=(/1,1,nrec/), &
00773 count=(/nx_global+2,ny_global+1,1/) )
00774 work_g1=work_g2(2:nx_global+1,1:ny_global)
00775 #endif
00776
00777 endif
00778
00779
00780
00781
00782
00783 if (my_task==master_task .and. diag) then
00784
00785
00786
00787
00788 status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
00789
00790 do id=1,ndim
00791 status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
00792
00793 enddo
00794 amin = minval(work_g1)
00795 amax = maxval(work_g1, mask = work_g1 /= spval_dbl)
00796 write(nu_diag,*) ' read_global ',fid, varid, nrec, amin, amax
00797
00798 endif
00799
00800
00801
00802
00803
00804
00805 if (present(field_loc)) then
00806 call scatter_global(work, work_g1, master_task, distrb_info, &
00807 field_loc, field_type)
00808 else
00809 call scatter_global(work, work_g1, master_task, distrb_info, &
00810 field_loc_noupdate, field_type_noupdate)
00811 endif
00812
00813 deallocate(work_g1)
00814 #ifdef ORCA_GRID
00815 deallocate(work_g2)
00816 #endif
00817
00818 #else
00819 work = c0
00820 #endif
00821 end subroutine ice_read_nc
00822
00823
00824
00825
00826
00827
00828
00829
00830 subroutine ice_read_global_nc_dbl (fid, nrec, varname, work_g, diag)
00831
00832
00833
00834
00835
00836
00837
00838
00839
00840
00841
00842
00843
00844 use ice_exit
00845 #ifdef ORCA_GRID
00846 use ice_work, only: work_g3
00847 #endif
00848
00849
00850
00851 integer (kind=int_kind), intent(in) ::
00852 fid ,
00853 nrec
00854
00855 character (len=*), intent(in) ::
00856 varname
00857
00858 real (kind=dbl_kind), dimension(:,:),
00859 intent(out) ::
00860 work_g
00861
00862 logical (kind=log_kind) ::
00863 diag
00864
00865
00866
00867 #ifdef ncdf
00868
00869 integer (kind=int_kind) ::
00870 varid,
00871 status,
00872 ndim, nvar,
00873 id,
00874 dimlen
00875
00876 real (kind=dbl_kind) ::
00877 amin, amax
00878
00879 character (char_len) ::
00880 dimname
00881
00882
00883 #ifdef ORCA_GRID
00884 if (my_task == master_task) then
00885 allocate(work_g3(nx_global+2,ny_global+1))
00886 else
00887 allocate(work_g3(1,1))
00888 endif
00889
00890 work_g3(:,:) = c0
00891 #endif
00892 work_g(:,:) = c0
00893
00894 if (my_task == master_task) then
00895
00896
00897
00898
00899
00900 status = nf90_inq_varid(fid, trim(varname), varid)
00901
00902 if (status /= nf90_noerr) then
00903 call abort_ice ( &
00904 'ice_read_global_nc: Cannot find variable '//trim(varname) )
00905 endif
00906
00907
00908
00909
00910
00911 #ifndef ORCA_GRID
00912 status = nf90_get_var( fid, varid, work_g, &
00913 start=(/1,1,nrec/), &
00914 count=(/nx_global,ny_global,1/) )
00915 #else
00916 status = nf90_get_var( fid, varid, work_g3, &
00917 start=(/1,1,nrec/), &
00918 count=(/nx_global+2,ny_global+1,1/) )
00919 work_g=work_g3(2:nx_global+1,1:ny_global)
00920 #endif
00921
00922 endif
00923
00924
00925
00926
00927
00928 if (my_task == master_task .and. diag) then
00929
00930
00931
00932
00933 status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
00934
00935 do id=1,ndim
00936 status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
00937
00938 enddo
00939 amin = minval(work_g)
00940 amax = maxval(work_g, mask = work_g /= spval_dbl)
00941
00942
00943 write(nu_diag,*) ' read_global ',fid, varid, nrec, amin, amax
00944
00945 endif
00946
00947 #ifdef ORCA_GRID
00948 deallocate(work_g3)
00949 #endif
00950
00951 #else
00952 work_g = c0
00953 #endif
00954 end subroutine ice_read_global_nc_dbl
00955
00956
00957
00958
00959
00960
00961
00962 subroutine ice_read_global_nc_r4 (fid, nrec, varname, work_g, diag)
00963
00964
00965
00966
00967
00968
00969
00970
00971
00972
00973
00974
00975
00976 use ice_exit
00977 #ifdef ORCA_GRID
00978 use ice_work, only: work_g3
00979 #endif
00980
00981
00982
00983 integer (kind=int_kind), intent(in) ::
00984 fid ,
00985 nrec
00986
00987 character (len=*), intent(in) ::
00988 varname
00989
00990 real (kind=real_kind), dimension(:,:),
00991 intent(out) ::
00992 work_g
00993
00994 logical (kind=log_kind) ::
00995 diag
00996
00997
00998
00999 #ifdef ncdf
01000
01001 integer (kind=int_kind) ::
01002 varid,
01003 status,
01004 ndim, nvar,
01005 id,
01006 dimlen
01007
01008 real (kind=dbl_kind) ::
01009 amin, amax
01010
01011 character (char_len) ::
01012 dimname
01013
01014
01015 #ifdef ORCA_GRID
01016 if (my_task == master_task) then
01017 allocate(work_g3(nx_global+2,ny_global+1))
01018 else
01019 allocate(work_g3(1,1))
01020 endif
01021
01022 work_g3(:,:) = c0
01023 #endif
01024 work_g(:,:) = c0
01025
01026 if (my_task == master_task) then
01027
01028
01029
01030
01031
01032 status = nf90_inq_varid(fid, trim(varname), varid)
01033
01034 if (status /= nf90_noerr) then
01035 call abort_ice ( &
01036 'ice_read_global_nc: Cannot find variable '//trim(varname) )
01037 endif
01038
01039
01040
01041
01042
01043 #ifndef ORCA_GRID
01044 status = nf90_get_var( fid, varid, work_g, &
01045 start=(/1,1,nrec/), &
01046 count=(/nx_global,ny_global,1/) )
01047 #else
01048 status = nf90_get_var( fid, varid, work_g3, &
01049 start=(/1,1,nrec/), &
01050 count=(/nx_global+2,ny_global+1,1/) )
01051 work_g=work_g3(2:nx_global+1,1:ny_global)
01052 #endif
01053
01054 endif
01055
01056
01057
01058
01059
01060 if (my_task == master_task .and. diag) then
01061
01062
01063
01064
01065 status = nf90_inquire(fid, nDimensions=ndim, nVariables=nvar)
01066
01067 do id=1,ndim
01068 status = nf90_inquire_dimension(fid,id,name=dimname,len=dimlen)
01069
01070 enddo
01071 amin = minval(work_g)
01072 amax = maxval(work_g, mask = work_g /= spval_dbl)
01073
01074
01075 write(nu_diag,*) ' read_global ',fid, varid, nrec, amin, amax
01076
01077 endif
01078
01079 #ifdef ORCA_GRID
01080 deallocate(work_g3)
01081 #endif
01082
01083 #else
01084 work_g = c0
01085 #endif
01086 end subroutine ice_read_global_nc_r4
01087
01088
01089
01090
01091
01092
01093
01094
01095 subroutine ice_close_nc(fid)
01096
01097
01098
01099
01100
01101
01102
01103
01104
01105
01106
01107
01108
01109 integer (kind=int_kind), intent(in) ::
01110 fid
01111
01112
01113
01114 #ifdef ncdf
01115 integer (kind=int_kind) ::
01116 status
01117
01118 if (my_task == master_task) then
01119
01120 status = nf90_close(fid)
01121
01122 endif
01123
01124 #endif
01125 end subroutine ice_close_nc
01126
01127
01128
01129 end module ice_read_write
01130
01131