4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801 integer, intent(in) :: ng, model
4802
4803 integer, intent(in), optional :: ncid
4804 integer, intent(in), optional :: start(:)
4805 integer, intent(in), optional :: total(:)
4806
4807 character (len=*), intent(in) :: ncname
4808 character (len=*), intent(in) :: myVarName
4809
4810 logical, intent(out) :: A(:)
4811
4812
4813
4814 integer :: i, my_ncid, my_type, status, varid
4815
4816 integer, dimension(SIZE(A,1)) :: AI
4817
4818#if !defined PARALLEL_IO && defined DISTRIBUTE
4819 integer, dimension(2) :: ibuffer
4820#endif
4821
4822 character (len=1), dimension(SIZE(A,1)) :: Achar
4823
4824 character (len=*), parameter :: MyFile = &
4825 & __FILE__//", netcdf_get_lvar_1d"
4826
4827
4828
4829
4830
4831
4832
4833 IF (.not.PRESENT(ncid)) THEN
4834 CALL netcdf_open (ng, model, trim(ncname), 0, my_ncid)
4835 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4836 ELSE
4837 my_ncid=ncid
4838 END IF
4839
4840
4841
4842 IF (inpthread) THEN
4843 status=nf90_inq_varid(my_ncid, trim(myvarname), varid)
4844 IF (status.eq.nf90_noerr) THEN
4845 status=nf90_inquire_variable(my_ncid, varid, &
4846 & xtype = my_type)
4847 IF (status.eq.nf90_noerr) THEN
4848 IF (my_type.eq.nf90_int) THEN
4849 IF (PRESENT(start).and.PRESENT(total)) THEN
4850 status=nf90_get_var(my_ncid, varid, ai, start, total)
4851 ELSE
4852 status=nf90_get_var(my_ncid, varid, ai)
4853 END IF
4854 IF (status.eq.nf90_noerr) THEN
4855 DO i=1,SIZE(a,1)
4856 IF (ai(i).eq.0) THEN
4857 a(i)=.false.
4858 ELSE
4859 a(i)=.true.
4860 END IF
4861 END DO
4862 END IF
4863 ELSE IF (my_type.eq.nf90_char) THEN
4864 IF (PRESENT(start).and.PRESENT(total)) THEN
4865 status=nf90_get_var(my_ncid, varid, achar, start, total)
4866 ELSE
4867 status=nf90_get_var(my_ncid, varid, achar)
4868 END IF
4869 IF (status.eq.nf90_noerr) THEN
4870 DO i=1,SIZE(a,1)
4871 a(i)=.false.
4872 IF ((achar(i).eq.'t').or.(achar(i).eq.'T')) THEN
4873 a(i)=.true.
4874 END IF
4875 END DO
4876 END IF
4877 END IF
4878 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4879 WRITE (stdout,10) trim(myvarname), trim(ncname), &
4880 & trim(sourcefile), nf90_strerror(status)
4881 exit_flag=2
4882 ioerror=status
4883 END IF
4884 ELSE
4885 WRITE (stdout,20) trim(myvarname), trim(ncname), &
4886 & trim(sourcefile), nf90_strerror(status)
4887 exit_flag=2
4888 ioerror=status
4889 END IF
4890 ELSE
4891 WRITE (stdout,30) trim(myvarname), trim(ncname), &
4892 & trim(sourcefile), nf90_strerror(status)
4893 exit_flag=2
4894 ioerror=status
4895 END IF
4896 END IF
4897
4898#if !defined PARALLEL_IO && defined DISTRIBUTE
4899
4900
4901
4902 ibuffer(1)=exit_flag
4903 ibuffer(2)=ioerror
4904 CALL mp_bcasti (ng, model, ibuffer)
4905 exit_flag=ibuffer(1)
4906 ioerror=ibuffer(2)
4907 IF (exit_flag.eq.noerror) THEN
4908 CALL mp_bcastl (ng, model, a)
4909 END IF
4910#endif
4911
4912
4913
4914 IF (.not.PRESENT(ncid)) THEN
4915 CALL netcdf_close (ng, model, my_ncid, ncname, .false.)
4916 END IF
4917
4918 10 FORMAT (/,' NETCDF_GET_LVAR_1D - error while reading variable:', &
4919 & 2x,a,/,22x,'in input file:',2x,a,/,22x,'call from:',2x,a, &
4920 & /,22x,a)
4921 20 FORMAT (/,' NETCDF_GET_LVAR_1D - error while inquiring type for ',&
4922 & 'variable:',2x,a,/,22x,'in input file:',2x,a,/,22x, &
4923 & 'call from:',2x,a,/,22x,a)
4924 30 FORMAT (/,' NETCDF_GET_LVAR_1D - error while inquiring ID for ', &
4925 & 'variable:',2x,a,/,22x,'in input file:',2x,a,/,22x, &
4926 & 'call from:',2x,a,/,22x,a)
4927
4928 RETURN