71 module procedure present_and_eq_integer
72 module procedure present_and_eq_real
73 module procedure present_and_eq_double
76 module procedure present_and_ne_integer
77 module procedure present_and_ne_real
78 module procedure present_and_ne_double
81 module procedure present_select_char
82 module procedure present_select_char_auto
83 module procedure present_select_int
84 module procedure present_select_int_auto
85 module procedure present_select_real
86 module procedure present_select_real_auto
87 module procedure present_select_double
88 module procedure present_select_double_auto
104 logical,
intent(in),
optional :: arg
106 if(
present(arg))
then
129 logical,
intent(in),
optional :: arg
131 if(
present(arg))
then
154 integer,
intent(in),
optional :: arg
156 if(
present(arg))
then
179 integer,
intent(in),
optional :: arg
181 if(
present(arg))
then
204 function present_and_eq_integer(arg,val)
result(result)
206 integer,
intent(in),
optional :: arg
207 integer,
intent(in) :: val
210 if(
present(arg))
then
219 end function present_and_eq_integer
233 function present_and_eq_real(arg,val)
result(result)
235 real(
sp),
intent(in),
optional :: arg
236 real(
sp),
intent(in) :: val
239 if(
present(arg))
then
240 if( abs(arg - val) .le.
sp_eps )
then
248 end function present_and_eq_real
262 function present_and_eq_double(arg,val)
result(result)
264 real(
dp),
intent(in),
optional :: arg
265 real(
dp),
intent(in) :: val
267 if(
present(arg))
then
268 if ( abs(arg - val) .le.
dp_eps )
then
276 end function present_and_eq_double
290 function present_and_ne_integer(arg,val)
result(result)
292 integer,
intent(in),
optional :: arg
293 integer,
intent(in) :: val
296 if(
present(arg))
then
305 end function present_and_ne_integer
319 function present_and_ne_real(arg,val)
result(result)
321 real(
sp),
intent(in),
optional :: arg
322 real(
sp),
intent(in) :: val
325 if(
present(arg))
then
326 if( abs(arg - val) .gt.
sp_eps )
then
334 end function present_and_ne_real
348 function present_and_ne_double(arg,val)
result(result)
350 real(
dp),
intent(in),
optional :: arg
351 real(
dp),
intent(in) :: val
354 if(
present(arg))
then
355 if(abs(arg - val) .gt.
dp_eps)
then
363 end function present_and_ne_double
377 character(len=*),
intent(in),
optional :: arg
380 if(
present(arg) .AND. (arg .ne.
'')) result = .true.
405 function present_select_char( &
406 & invalid, default, &
407 & c0,c1,c2,c3,c4,c5,c6,c7,c8,c9 &
410 character(*) ,
intent(in) :: invalid
411 character(*) ,
intent(in) :: default
412 character(*) ,
intent(in),
optional :: c0,c1,c2,c3,c4,c5,c6,c7,c8,c9
413 character(STRING) :: result
418 if (
present(c0) )
then
419 if ( len(trim(c0)) > len(trim(invalid)) )
then
423 if ( trim(c0) /= invalid(:len(trim(c0))) )
then
429 if (
present(c1) )
then
430 if ( len(trim(c1)) > len(trim(invalid)) )
then
434 if ( trim(c1) /= invalid(:len(trim(c1))) )
then
440 if (
present(c2) )
then
441 if ( len(trim(c2)) > len(trim(invalid)) )
then
445 if ( trim(c2) /= invalid(:len(trim(c2))) )
then
451 if (
present(c3) )
then
452 if ( len(trim(c3)) > len(trim(invalid)) )
then
456 if ( trim(c3) /= invalid(:len(trim(c3))) )
then
462 if (
present(c4) )
then
463 if ( len(trim(c4)) > len(trim(invalid)) )
then
467 if ( trim(c4) /= invalid(:len(trim(c4))) )
then
473 if (
present(c5) )
then
474 if ( len(trim(c5)) > len(trim(invalid)) )
then
478 if ( trim(c5) /= invalid(:len(trim(c5))) )
then
484 if (
present(c6) )
then
485 if ( len(trim(c6)) > len(trim(invalid)) )
then
489 if ( trim(c6) /= invalid(:len(trim(c6))) )
then
495 if (
present(c7) )
then
496 if ( len(trim(c7)) > len(trim(invalid)) )
then
500 if ( trim(c7) /= invalid(:len(trim(c7))) )
then
506 if (
present(c8) )
then
507 if ( len(trim(c8)) > len(trim(invalid)) )
then
511 if ( trim(c8) /= invalid(:len(trim(c8))) )
then
517 if (
present(c9) )
then
518 if ( len(trim(c9)) > len(trim(invalid)) )
then
522 if ( trim(c9) /= invalid(:len(trim(c9))) )
then
528 if (.not. specified)
then
531 end function present_select_char
555 function present_select_char_auto( &
556 & invalid, default, &
557 & c0,c1,c2,c3,c4,c5,c6,c7,c8,c9 &
560 logical ,
intent(in) :: invalid
561 character(*) ,
intent(in) :: default
562 character(*) ,
intent(in),
optional :: c0,c1,c2,c3,c4,c5,c6,c7,c8,c9
563 character(STRING) :: result
571 if (
present(c0) )
then
572 if ( trim(c0) /=
'' )
then
580 if (
present(c1) )
then
581 if ( trim(c1) /=
'' )
then
589 if (
present(c2) )
then
590 if ( trim(c2) /=
'' )
then
598 if (
present(c3) )
then
599 if ( trim(c3) /=
'' )
then
607 if (
present(c4) )
then
608 if ( trim(c4) /=
'' )
then
616 if (
present(c5) )
then
617 if ( trim(c5) /=
'' )
then
625 if (
present(c6) )
then
626 if ( trim(c6) /=
'' )
then
634 if (
present(c7) )
then
635 if ( trim(c7) /=
'' )
then
643 if (
present(c8) )
then
644 if ( trim(c8) /=
'' )
then
652 if (
present(c9) )
then
653 if ( trim(c9) /=
'' )
then
658 if (.not. specified)
then
661 end function present_select_char_auto
685 function present_select_int( &
686 & invalid, default, &
687 & i0,i1,i2,i3,i4,i5,i6,i7,i8,i9 &
690 integer ,
intent(in) :: invalid
691 integer ,
intent(in) :: default
692 integer ,
intent(in),
optional :: i0,i1,i2,i3,
i4,i5,i6,i7,
i8,i9
698 if (
present(i0) )
then
699 if ( i0 /= invalid )
then
704 if (
present(i1) )
then
705 if ( i1 /= invalid )
then
710 if (
present(i2) )
then
711 if ( i2 /= invalid )
then
716 if (
present(i3) )
then
717 if ( i3 /= invalid )
then
722 if (
present(
i4) )
then
723 if (
i4 /= invalid )
then
728 if (
present(i5) )
then
729 if ( i5 /= invalid )
then
734 if (
present(i6) )
then
735 if ( i6 /= invalid )
then
740 if (
present(i7) )
then
741 if ( i7 /= invalid )
then
746 if (
present(
i8) )
then
747 if (
i8 /= invalid )
then
752 if (
present(i9) )
then
753 if ( i9 /= invalid )
then
758 if (.not. specified)
then
761 end function present_select_int
785 function present_select_int_auto( &
786 & invalid, default, &
787 & i0,i1,i2,i3,i4,i5,i6,i7,i8,i9 &
790 logical ,
intent(in) :: invalid
791 integer ,
intent(in) :: default
792 integer ,
intent(in),
optional :: i0,i1,i2,i3,
i4,i5,i6,i7,
i8,i9
798 if (
present(i0) )
then
799 if ( .not. invalid )
then
802 elseif ( i0 .ne. 0 )
then
807 if (
present(i1) )
then
808 if ( .not. invalid )
then
811 elseif ( i1 .ne. 0 )
then
816 if (
present(i2) )
then
817 if ( .not. invalid )
then
820 elseif ( i2 .ne. 0 )
then
825 if (
present(i3) )
then
826 if ( .not. invalid )
then
829 elseif ( i3 .ne. 0 )
then
834 if (
present(
i4) )
then
835 if ( .not. invalid )
then
838 elseif (
i4 .ne. 0 )
then
843 if (
present(i5) )
then
844 if ( .not. invalid )
then
847 elseif ( i5 .ne. 0 )
then
852 if (
present(i6) )
then
853 if ( .not. invalid )
then
856 elseif ( i6 .ne. 0 )
then
861 if (
present(i7) )
then
862 if ( .not. invalid )
then
865 elseif ( i7 .ne. 0 )
then
870 if (
present(
i8) )
then
871 if ( .not. invalid )
then
874 elseif (
i8 .ne. 0 )
then
879 if (
present(i9) )
then
880 if ( .not. invalid )
then
883 elseif ( i9 .ne. 0 )
then
888 if (.not. specified)
then
891 end function present_select_int_auto
915 function present_select_real( &
916 & invalid, default, &
917 & r0,r1,r2,r3,r4,r5,r6,r7,r8,r9 &
920 real(
sp) ,
intent(in) :: invalid
921 real(
sp) ,
intent(in) :: default
922 real(
sp) ,
intent(in),
optional :: r0,r1,r2,r3,r4,r5,r6,r7,r8,r9
928 if (
present(r0) )
then
929 if ( abs(r0 - invalid) .gt.
sp_eps )
then
934 if (
present(r1) )
then
935 if ( abs(r1 - invalid) .gt.
sp_eps )
then
940 if (
present(r2) )
then
941 if ( abs(r2 - invalid) .gt.
sp_eps )
then
946 if (
present(r3) )
then
947 if ( abs(r3 - invalid) .gt.
sp_eps )
then
952 if (
present(r4) )
then
953 if ( abs(r4 - invalid) .gt.
sp_eps )
then
958 if (
present(r5) )
then
959 if ( abs(r5 - invalid) .gt.
sp_eps )
then
964 if (
present(r6) )
then
965 if ( abs(r6 - invalid) .gt.
sp_eps )
then
970 if (
present(r7) )
then
971 if ( abs(r7 - invalid) .gt.
sp_eps )
then
976 if (
present(r8) )
then
977 if ( abs(r8 - invalid) .gt.
sp_eps )
then
982 if (
present(r9) )
then
983 if ( abs(r9 - invalid) .gt.
sp_eps )
then
988 if (.not. specified)
then
991 end function present_select_real
1015 function present_select_real_auto( &
1016 & invalid, default, &
1017 & r0,r1,r2,r3,r4,r5,r6,r7,r8,r9 &
1020 logical ,
intent(in) :: invalid
1021 real(
sp) ,
intent(in) :: default
1022 real(
sp) ,
intent(in),
optional :: r0,r1,r2,r3,r4,r5,r6,r7,r8,r9
1025 logical :: specified
1028 if (
present(r0) )
then
1029 if ( .not. invalid )
then
1032 elseif ( abs(r0 - 0.0_dp) .lt.
sp_eps)
then
1037 if (
present(r1) )
then
1038 if ( .not. invalid )
then
1041 elseif ( abs(r1 - 0.0_dp) .lt.
sp_eps)
then
1046 if (
present(r2) )
then
1047 if ( .not. invalid )
then
1050 elseif ( abs(r2 - 0.0_dp) .lt.
sp_eps)
then
1055 if (
present(r3) )
then
1056 if ( .not. invalid )
then
1059 elseif ( abs(r3 - 0.0_dp) .lt.
sp_eps)
then
1064 if (
present(r4) )
then
1065 if ( .not. invalid )
then
1068 elseif ( abs(r4 - 0.0_dp) .lt.
sp_eps)
then
1073 if (
present(r5) )
then
1074 if ( .not. invalid )
then
1077 elseif ( abs(r5 - 0.0_dp) .lt.
sp_eps)
then
1082 if (
present(r6) )
then
1083 if ( .not. invalid )
then
1086 elseif ( abs(r6 - 0.0_dp) .lt.
sp_eps)
then
1091 if (
present(r7) )
then
1092 if ( .not. invalid )
then
1095 elseif ( abs(r7 - 0.0_dp) .lt.
sp_eps)
then
1100 if (
present(r8) )
then
1101 if ( .not. invalid )
then
1104 elseif ( abs(r8 - 0.0_dp) .lt.
sp_eps)
then
1109 if (
present(r9) )
then
1110 if ( .not. invalid )
then
1113 elseif ( abs(r9 - 0.0_dp) .lt.
sp_eps)
then
1118 if (.not. specified)
then
1121 end function present_select_real_auto
1145 function present_select_double( &
1146 & invalid, default, &
1147 & d0,d1,d2,d3,d4,d5,d6,d7,d8,d9 &
1150 real(
dp) ,
intent(in) :: invalid
1151 real(
dp) ,
intent(in) :: default
1152 real(
dp) ,
intent(in),
optional :: d0,d1,d2,d3,d4,d5,d6,d7,d8,d9
1155 logical :: specified
1158 if (
present(d0) )
then
1159 if ( abs(d0 - invalid) .gt.
dp_eps )
then
1164 if (
present(d1) )
then
1165 if ( abs(d1 - invalid) .gt.
dp_eps )
then
1170 if (
present(d2) )
then
1171 if ( abs(d2 - invalid) .gt.
dp_eps )
then
1176 if (
present(d3) )
then
1177 if ( abs(d3 - invalid) .gt.
dp_eps )
then
1182 if (
present(d4) )
then
1183 if ( abs(d4 - invalid) .gt.
dp_eps )
then
1188 if (
present(d5) )
then
1189 if ( abs(d5 - invalid) .gt.
dp_eps )
then
1194 if (
present(d6) )
then
1195 if ( abs(d6 - invalid) .gt.
dp_eps )
then
1200 if (
present(d7) )
then
1201 if ( abs(d7 - invalid) .gt.
dp_eps )
then
1206 if (
present(d8) )
then
1207 if ( abs(d8 - invalid) .gt.
dp_eps )
then
1212 if (
present(d9) )
then
1213 if ( abs(d9 - invalid) .gt.
dp_eps )
then
1218 if (.not. specified)
then
1221 end function present_select_double
1245 function present_select_double_auto( &
1246 & invalid, default, &
1247 & d0,d1,d2,d3,d4,d5,d6,d7,d8,d9 &
1250 logical ,
intent(in) :: invalid
1251 real(
dp) ,
intent(in) :: default
1252 real(
dp) ,
intent(in),
optional :: d0,d1,d2,d3,d4,d5,d6,d7,d8,d9
1255 logical :: specified
1258 if (
present(d0) )
then
1259 if ( .not. invalid )
then
1262 elseif ( abs(d0 - 0.0_dp) .lt.
dp_eps)
then
1267 if (
present(d1) )
then
1268 if ( .not. invalid )
then
1271 elseif ( abs(d1 - 0.0_dp) .lt.
dp_eps)
then
1276 if (
present(d2) )
then
1277 if ( .not. invalid )
then
1280 elseif ( abs(d2 - 0.0_dp) .lt.
dp_eps)
then
1285 if (
present(d3) )
then
1286 if ( .not. invalid )
then
1289 elseif ( abs(d3 - 0.0_dp) .lt.
dp_eps)
then
1294 if (
present(d4) )
then
1295 if ( .not. invalid )
then
1298 elseif ( abs(d4 - 0.0_dp) .lt.
dp_eps)
then
1303 if (
present(d5) )
then
1304 if ( .not. invalid )
then
1307 elseif ( abs(d5 - 0.0_dp) .lt.
dp_eps)
then
1312 if (
present(d6) )
then
1313 if ( .not. invalid )
then
1316 elseif ( abs(d6 - 0.0_dp) .lt.
dp_eps)
then
1321 if (
present(d7) )
then
1322 if ( .not. invalid )
then
1325 elseif ( abs(d7 - 0.0_dp) .lt.
dp_eps)
then
1330 if (
present(d8) )
then
1331 if ( .not. invalid )
then
1334 elseif ( abs(d8 - 0.0_dp) .lt.
dp_eps)
then
1339 if (
present(d9) )
then
1340 if ( .not. invalid )
then
1343 elseif ( abs(d9 - 0.0_dp) .lt.
dp_eps)
then
1348 if (.not. specified)
then
1351 end function present_select_double_auto
Judge optional control parameters.
logical function, public present_and_false(arg)
logical function, public present_and_nonzero(arg)
logical function, public present_and_not_empty(arg)
logical function, public present_and_true(arg)
logical function, public present_and_zero(arg)
Provides kind type parameter values.
integer, parameter, public sp
Single Precision Real number.
real(sp), parameter, public sp_eps
Machine epsilon for single precision real number.
integer, parameter, public i8
Double Precision Ineger, same as 'integer(8)'
integer, parameter, public i4
Single Precision Ineger, same as 'integer'
integer, parameter, public token
Character length for word, token
integer, parameter, public dp
Double Precision Real number
integer, parameter, public string
Character length for string
real(dp), parameter, public dp_eps
Machine epsilon for dobule precision real number.