629
630
631
632
633
634 use netcdf, only: nf90_strerror
635 character(len = *), intent(out):: msg
636 character(len = STRING):: message
637 character(len = 20):: errno_c
638 character(len = 20):: cause_int_c
639 continue
640 select case(errno)
641 case(gt_efake)
642 msg = ' function not implemented'
643
644
645
646
647 case(gt_enomoredims)
648 write(message, "(': dimension number', i4, ' is out of range')") cause_int
649 msg = trim(message)
650 case(gt_ebaddimname)
651 msg = '(' // trim(cause_string) // '): unknown dimension name'
652 case(gt_enotvar)
653 msg = ' variable not opened'
654 case(gt_enomem)
655 msg = ' allocate/deallocate error'
656 case(gt_edimnodim)
657 msg = ' dimension variable has no dimension'
658 case(gt_edimmultidim)
659 msg = ' dimension variable has many dimensions'
660 case(gt_edimotherdim)
661 msg = ' dimension variable has another dimension'
662 case(gt_eotherfile)
663 msg = ' specified dimensional variable not on the same file'
664 case(gt_eargsizemismatch)
665 msg = ' arguments (' // trim(cause_string) //') array size mismatch'
666 case(gt_enomatchdim)
667 msg = ' dimension matching failed'
668 case(gt_elimited)
669 msg = ' variable already limited'
670 case(gt_ebadvar)
671 msg = ' variable type not supported'
672 case(gt_echarshort)
673 msg = ' character length not enough'
674 case(gt_enounlimitdim)
675 msg = ' NC_UNLIMITED dimension is not found'
676 case(gt_ebadattrname)
677 msg = ' invalid attribute name'
678 case(gt_ebadallocatesize)
679 msg = ' invalid allocated size'
680 case(gt_erankmismatch)
681 msg = ' rank of data and argument are mismatch (' // trim(cause_string) // ')'
682 case(gt_enoturl)
683 msg = ' URL (' // trim(cause_string) // ') is not found'
684 case(gt_ebadgt4commagraphy)
685 msg = ' (' // trim(cause_string) // ') is not gtool4 comma-graphy (ex. "time=100.0,x=10:20,y=^1:^5")'
686
687
688
689
690 case(gr_enotgr)
691 msg = ' invalid GrADS file'
692
693
694
695
696 case(dc_enotinit)
697 msg = ' object (' // trim(cause_string) // ') is not initialized'
698 case(dc_ealreadyinit)
699 msg = ' object (' // trim(cause_string) // ') is already initialized'
700 case(dc_ebadunit)
701 msg = ' unit (' // trim(cause_string) // ') is invalid'
702 case(dc_ebadcaltype)
703 write(message, '(" calendar type (", i4, ") is invalid")') cause_int
704 msg = trim(message)
705 case(dc_ebadtimezone)
706 msg = ' time zone (' // trim(cause_string) // ') is invalid'
707 case(dc_efilenameempty)
708 msg = ' filename is empty'
709 case(dc_ebadfileopmode)
710 msg = ' file open mode (' // trim(cause_string) // ') is invalid'
711 case(dc_enounitnum)
712 msg = ' available unit number is not found within (' // trim(cause_string) // ')'
713 case(dc_enofileexist)
714 msg = ' file (' // trim(cause_string) // ') is not found'
715 case(dc_enofileread)
716 msg = ' file (' // trim(cause_string) // ') is not readable'
717 case(dc_enofilewrite)
718 msg = ' file (' // trim(cause_string) // ') is not writable'
719 case(dc_enegative)
720 msg = ' negative value is invalid for (' // trim(cause_string) // ')'
721 case(dc_earglack)
722 msg = ' lack of arguments (' // trim(cause_string) // ')'
723 case(dc_enoassoc)
724 msg = ' argument (' // trim(cause_string) // ') is not associated'
725 case(dc_enoentry)
726 msg = ' entry of (' // trim(cause_string) // ') is not found'
727 case(dc_enodimtime)
728 msg = ' dimensional time can not be converted into nondimensional time'
729 case(dc_edimtime)
730 msg = ' nondimensional time can not be converted into dimensional time'
731 case(dc_etoolargetime)
732 msg = ' number is too large for time'
733 case(dc_ebaddate)
734 msg = ' invalid expression of date'
735 case(dc_einconsistcaldate)
736 msg = ' calendar and date are inconsistent'
737
738
739
740
741 case(hst_enotindefine)
742 msg = ' operation (' // trim(cause_string) // ') not allowed in data mode'
743 case(hst_eindefine)
744 msg = ' operation (' // trim(cause_string) // ') not allowed in define mode'
745 case(hst_eintfile)
746 msg = ' different intervals are applied to a file (' // trim(cause_string) // ')'
747 case(hst_ebadname)
748 msg = ' name (' // trim(cause_string) // ') is invalid'
749 case(hst_enottermgthist)
750 msg = ' GT_HISTORY correspond to (' // trim(cause_string) // ') is not terminated'
751 case(hst_enodependtime)
752 msg = ' (' // trim(cause_string) // ') does not depend on time'
753 case(hst_ebadvarname)
754 msg = ' variable name (' // trim(cause_string) // ') is invalid'
755 case(hst_enotimedim)
756 msg = ' time dimension is not found'
757 case(hst_enoaxisname)
758 msg = ' axis or weight (' // trim(cause_string) // ') is not found'
759 case(hst_evarinuse)
760 msg = ' variable name (' // trim(cause_string) // ') is already used'
761 case(hst_ealreadyregvarfix)
762 msg = ' already register of variables is fixed by (' // trim(cause_string) // ')'
763 case(hst_ebadslice)
764 msg = ' slice options are invalid (' // trim(cause_string) // ')'
765 case(hst_ebadnewfileint)
766 msg = ' invalid newfile interval (' // trim(cause_string) // ')'
767 case(hst_emaxdimsdepended)
768 write(message, '("(", i4, ")")') cause_int
769 msg = trim(message)
770 msg = ' variable (' // trim(cause_string) // ') depends on ' // trim(message) // ' dimensions'
771 case(hst_eindivisible)
772 msg = ' (' // trim(cause_string) // ') can not be divided'
773 case(hst_ebadterminus)
774 msg = ' terminus options are invalid (' // trim(cause_string) // ')'
775 case(hst_ebadorigin)
776 msg = ' origin options are invalid (' // trim(cause_string) // ')'
777 case(hst_empinoaxisdata)
778 msg = ' data of axis (' // trim(cause_string) // ') for MPI is lack'
779
780
781
782
783
784
785 case(:usr_errno)
786 if (len(trim(adjustl(cause_string))) < 1) then
787 cause_string = 'Unknown error'
788 end if
789 if (cause_int_valid) then
790 write(cause_int_c, "(i8)") cause_int
791 msg = trim(cause_string) // ' (' // trim(adjustl(cause_int_c)) // ')'
792 else
793 msg = trim(cause_string)
794 end if
795 case default
796 goto 999
797 end select
798 write(errno_c, "(i8)") errno
799 msg = '*** ERROR (Code ' // trim(adjustl(errno_c)) // &
800 & ') [' // trim(cause_location) // '] *** ' // &
801 & trim(msg)
802 return
803
804999 continue
805 if (len(cause_string) > 0) then
806 message = nf90_strerror(errno)
807 write(errno_c, "(i8)") errno
808 msg = '*** ERROR (Code ' // trim(adjustl(errno_c)) // &
809 & ') [' // trim(cause_location) // &
810 & '(' // trim(cause_string) // ')] *** ' // &
811 & trim(message)
812 else if (cause_int_valid) then
813 message = nf90_strerror(errno)
814 write(errno_c, "(i8)") errno
815 write(cause_int_c, "(i8)") cause_int
816 msg = '*** ERROR (Code ' // trim(adjustl(errno_c)) // &
817 & ') [' // trim(cause_location) // &
818 & '(' // trim(adjustl(cause_int_c)) // ')] *** ' // &
819 & trim(message)
820 else
821 message = nf90_strerror(errno)
822 write(errno_c, "(i8)") errno
823 msg = '*** ERROR (Code ' // trim(adjustl(errno_c)) // &
824 & ') [' // trim(cause_location) // '] *** ' // &
825 & trim(message)
826 endif