diff --git a/Modules/bz_form.f90 b/Modules/bz_form.f90 index b6464c2d0..618a4bc28 100644 --- a/Modules/bz_form.f90 +++ b/Modules/bz_form.f90 @@ -237,14 +237,54 @@ END SUBROUTINE SUBROUTINE init_bz(bz_struc) IMPLICIT NONE TYPE(bz), INTENT(INOUT) :: bz_struc -INTEGER :: n1(6), n2(6), i -INTEGER :: ibz, idir, idir1 +INTEGER :: ibz bz_struc%letter_list(1)='gG ' bz_struc%letter_coord(:,1)=0.0_DP ibz=bz_struc%ind IF ( ibz ==1) THEN + CALL init_bz_1(bz_struc) +ELSEIF (ibz==2) THEN + CALL init_bz_2(bz_struc) +ELSEIF (ibz==3) THEN + CALL init_bz_3(bz_struc) +ELSEIF (ibz==4) THEN + CALL init_bz_4(bz_struc) +ELSEIF (ibz==5) THEN + CALL init_bz_5(bz_struc) +ELSEIF (ibz==6) THEN + CALL init_bz_6(bz_struc) +ELSEIF (ibz==7) THEN + CALL init_bz_7(bz_struc) +ELSEIF (ibz==8) THEN + CALL init_bz_8(bz_struc) +ELSEIF (ibz==9) THEN + CALL init_bz_9(bz_struc) +ELSEIF (ibz==10) THEN + CALL init_bz_10(bz_struc) +ELSEIF (ibz==11) THEN + CALL init_bz_11(bz_struc) +ELSEIF (ibz==12) THEN + CALL init_bz_12(bz_struc) +ELSEIF (ibz==13) THEN + CALL init_bz_13(bz_struc) +ELSEIF (ibz==14) THEN + CALL init_bz_14(bz_struc) +ELSEIF (ibz==15) THEN + CALL init_bz_15(bz_struc) +ELSEIF (ibz==16) THEN + CALL init_bz_16(bz_struc) +ELSE + CALL errore('init_bz','Brillouin zone type not available',1) +ENDIF + +RETURN +END SUBROUTINE init_bz + +SUBROUTINE init_bz_1(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! simple cubic bz ! @@ -286,7 +326,11 @@ IF ( ibz ==1) THEN CALL find_axis_coordinates(bz_struc) -ELSEIF (ibz==2) THEN +END SUBROUTINE init_bz_1 + +SUBROUTINE init_bz_2(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! fcc bz ! @@ -384,7 +428,12 @@ ELSEIF (ibz==2) THEN CALL find_axis_coordinates(bz_struc) -ELSEIF (ibz==3) THEN +END SUBROUTINE init_bz_2 + +SUBROUTINE init_bz_3(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc + ! ! bcc bz ! @@ -452,8 +501,12 @@ ELSEIF (ibz==3) THEN CALL find_axis_coordinates(bz_struc) +END SUBROUTINE init_bz_3 + +SUBROUTINE init_bz_4(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc -ELSEIF (ibz==4) THEN ! ! simple tetragonal bz ! @@ -489,7 +542,12 @@ ELSEIF (ibz==4) THEN CALL find_axis_coordinates(bz_struc) -ELSEIF (ibz==5) THEN +END SUBROUTINE init_bz_4 + +SUBROUTINE init_bz_5(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc + ! ! centered tetragonal (ca) bz ! @@ -627,7 +689,11 @@ ELSEIF (ibz==6) THEN CALL find_axis_coordinates(bz_struc) -ELSEIF (ibz==7) THEN +END SUBROUTINE init_bz_6 + +SUBROUTINE init_bz_7(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! simple orthorombic bz ! @@ -667,7 +733,11 @@ ELSEIF (ibz==7) THEN CALL find_axis_coordinates(bz_struc) -ELSEIF (ibz==8) THEN +END SUBROUTINE init_bz_7 + +SUBROUTINE init_bz_8(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! face centered orthorombic (1/a^2 > 1/b^2 + 1/c^2) bz ! @@ -764,7 +834,11 @@ ELSEIF (ibz==8) THEN CALL adjust_orthorombic(bz_struc) -ELSEIF (ibz==9) THEN +END SUBROUTINE init_bz_8 + +SUBROUTINE init_bz_9(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! face centered orthorombic (1/a^2 < 1/b^2 + 1/c^2) bz case 2 ! @@ -886,7 +960,12 @@ ELSEIF (ibz==9) THEN CALL adjust_orthorombic(bz_struc) -ELSEIF (ibz==10) THEN +END SUBROUTINE init_bz_9 + +SUBROUTINE init_bz_10(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc + ! ! face centered orthorombic (1/a^2 = 1/b^2 + 1/c^2) bz ! @@ -980,7 +1059,11 @@ ELSEIF (ibz==10) THEN CALL find_axis_coordinates(bz_struc) CALL adjust_orthorombic(bz_struc) -ELSEIF (ibz==11) THEN +END SUBROUTINE init_bz_10 + +SUBROUTINE init_bz_11(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! body centered orthorombic bz ! @@ -1174,7 +1257,12 @@ ELSEIF (ibz==11) THEN CALL find_axis_coordinates(bz_struc) CALL adjust_orthorombic(bz_struc) -ELSEIF (ibz==12) THEN +END SUBROUTINE init_bz_11 + +SUBROUTINE init_bz_12(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc + ! ! one face centered orthorombic bz ! @@ -1260,7 +1348,11 @@ ELSEIF (ibz==12) THEN CALL adjust_one_face_centered_orthorombic(bz_struc) -ELSEIF (ibz==13) THEN +END SUBROUTINE init_bz_12 + +SUBROUTINE init_bz_13(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! hexagonal ! @@ -1299,8 +1391,12 @@ ELSEIF (ibz==13) THEN bz_struc%letter_coord(:,6) = bz_struc%vertex_coord(:,1) CALL find_axis_coordinates(bz_struc) -! -ELSEIF (ibz==14) THEN + +END SUBROUTINE init_bz_13 + +SUBROUTINE init_bz_14(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc ! ! trigonal alpha < 90 bz ! @@ -1369,7 +1465,12 @@ ELSEIF (ibz==14) THEN bz_struc%vertex_coord(:,14)) CALL find_axis_coordinates(bz_struc) -ELSEIF (ibz==15) THEN +END SUBROUTINE init_bz_14 + +SUBROUTINE init_bz_15(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc + ! ! trigonal alpha > 90 bz ! @@ -1429,8 +1530,13 @@ ELSEIF (ibz==15) THEN bz_struc%letter_coord(:,8) = bz_struc%vertex_coord(:,7) CALL find_axis_coordinates(bz_struc) -! -ELSEIF (ibz==16) THEN + +END SUBROUTINE init_bz_15 + +SUBROUTINE init_bz_16(bz_struc) + IMPLICIT NONE + TYPE(bz), INTENT(INOUT) :: bz_struc + INTEGER :: n1(6), n2(6), i, idir, idir1 ! ! Simple monoclinic lattice ! @@ -1489,12 +1595,7 @@ ELSEIF (ibz==16) THEN CALL find_axis_coordinates(bz_struc) -ELSE - CALL errore('init_bz','Brillouin zone type not available',1) -ENDIF - -RETURN -END SUBROUTINE init_bz +END SUBROUTINE init_bz_16 SUBROUTINE compute_vertices(bz_struc) ! diff --git a/Modules/wypos.f90 b/Modules/wypos.f90 index fd6e9e547..3fc7240a3 100644 --- a/Modules/wypos.f90 +++ b/Modules/wypos.f90 @@ -29,14 +29,466 @@ CONTAINS REAL(DP), INTENT(IN) :: inp(3) CHARACTER(LEN=*), INTENT (IN) :: wp - INTEGER, INTENT(IN) :: space_group_number + INTEGER, INTENT(IN) :: space_group_number LOGICAL, INTENT(IN) :: uniqueb, rhombohedral INTEGER, INTENT(IN) :: origin_choice - - tau=1.d5 + + tau=1.d5 SELECT CASE (space_group_number) CASE (2) !P-1 + CALL wypos_2 ( wp, tau ) + CASE (3) !P2 + CALL wypos_3 ( wp, inp, uniqueb, tau ) + CASE (5) !C2 + CALL wypos_5 ( wp, inp, uniqueb, tau ) + CASE (6) !Pm + CALL wypos_6 ( wp, inp, uniqueb, tau ) + CASE (8) !Cm + CALL wypos_8 ( wp, inp, uniqueb, tau ) + CASE (10) !P2/m + CALL wypos_10 ( wp, inp, uniqueb, tau ) + CASE (11) !P2(1)/m + CALL wypos_11 ( wp, inp, uniqueb, tau ) + CASE (12) !C2/m + CALL wypos_12 ( wp, inp, uniqueb, tau ) + CASE (13) !P2/c + CALL wypos_13 ( wp, inp, uniqueb, tau ) + CASE (14) !-P2(1)/c + CALL wypos_14 ( wp, inp, uniqueb, tau ) + CASE (15) !C2/c + CALL wypos_15 ( wp, inp, uniqueb, tau ) + CASE (16) !P222 + CALL wypos_16 ( wp, inp, tau ) + CASE (17) !P222(1) + CALL wypos_17 ( wp, inp, tau ) + CASE (18) !P2(1)2(1)2 + CALL wypos_18 ( wp, inp, tau ) + CASE (20) !C222(1) + CALL wypos_20 ( wp, inp, tau ) + CASE (21) !C222 + CALL wypos_21 ( wp, inp, tau ) + CASE (22) !F222 + CALL wypos_22 ( wp, inp, tau ) + CASE (23) !I222 + CALL wypos_23 ( wp, inp, tau ) + CASE (24) !I2(1)2(1)2(1) + CALL wypos_24 ( wp, inp, tau ) + CASE (25) !Pmm2 + CALL wypos_25 ( wp, inp, tau ) + CASE (26) !Pmc2(1) + CALL wypos_26 ( wp, inp, tau ) + CASE (27) !Pcc2 + CALL wypos_27 ( wp, inp, tau ) + CASE (28) !Pma2 + CALL wypos_28 ( wp, inp, tau ) + CASE (30) !Pca2(1) + CALL wypos_30 ( wp, inp, tau ) + CASE (31) !Pmn2(1) + CALL wypos_31 ( wp, inp, tau ) + CASE (32) !Pba2 + CALL wypos_32 ( wp, inp, tau ) + CASE (34) !Pnn2 + CALL wypos_34 ( wp, inp, tau ) + CASE (35) !Cmm2 + CALL wypos_35 ( wp, inp, tau ) + CASE (36) !Cmc2(1) + CALL wypos_36 ( wp, inp, tau ) + CASE (37) !Ccc2 + CALL wypos_37 ( wp, inp, tau ) + CASE (38) !Amm2 + CALL wypos_38 ( wp, inp, tau ) + CASE (39) !Aem2 + CALL wypos_39 ( wp, inp, tau ) + CASE (40) !Ama2 + CALL wypos_40 ( wp, inp, tau ) + CASE (41) !Aea2 + CALL wypos_41 ( wp, inp, tau ) + CASE (42) !Fmm2 + CALL wypos_42 ( wp, inp, tau ) + CASE (43) !Fdd2 + CALL wypos_43 ( wp, inp, tau ) + CASE (44) !Imm2 + CALL wypos_44 ( wp, inp, tau ) + CASE (45) !Iba2 + CALL wypos_45 ( wp, inp, tau ) + CASE (46) !Ima2 + CALL wypos_46 ( wp, inp, tau ) + CASE (47) !Pmmm + CALL wypos_47 ( wp, inp, tau ) + CASE (48) !Pnnn + CALL wypos_48 ( wp, inp, origin_choice, tau ) + CASE (49) !Pccm + CALL wypos_49 ( wp, inp, tau ) + CASE (50) !Pban + CALL wypos_50 ( wp, inp, origin_choice, tau ) + CASE (51) !Pmma + CALL wypos_51 ( wp, inp, tau ) + CASE (52) !Pnna + CALL wypos_52 ( wp, inp, tau ) + CASE (53) !Pmna + CALL wypos_53 ( wp, inp, tau ) + CASE (54) !Pcca + CALL wypos_54 ( wp, inp, tau ) + CASE (55) !Pbam + CALL wypos_55 ( wp, inp, tau ) + CASE (56) !Pccn + CALL wypos_56 ( wp, inp, tau ) + CASE (57) !Pbcm + CALL wypos_57 ( wp, inp, tau ) + CASE (58) !Pnnm + CALL wypos_58 ( wp, inp, tau ) + CASE (59) !Pmmn + CALL wypos_59 ( wp, inp, origin_choice, tau ) + CASE (60) !Pbcn + CALL wypos_60 ( wp, inp, tau ) + CASE (61) !Pbca + CALL wypos_61 ( wp, inp, tau ) + CASE (62) !Pnma + CALL wypos_62 ( wp, inp, tau ) + CASE (63) !Cmcm + CALL wypos_63 ( wp, inp, tau ) + CASE (64) !Cmce + CALL wypos_64 ( wp, inp, tau ) + CASE (65) !Cmmm + CALL wypos_65 ( wp, inp, tau ) + CASE (66) !Cccm + CALL wypos_66 ( wp, inp, tau ) + CASE (67) !Cmma + CALL wypos_67 ( wp, inp, tau ) + CASE (68) !Ccce + CALL wypos_68 ( wp, inp, origin_choice, tau ) + CASE (69) !Fmmm + CALL wypos_69 ( wp, inp, tau ) + CASE (70) !Fddd + CALL wypos_70 ( wp, inp, origin_choice, tau ) + CASE (71) !Immm + CALL wypos_71 ( wp, inp, tau ) + CASE (72) !Ibam + CALL wypos_72 ( wp, inp, tau ) + CASE (73) !Ibca + CALL wypos_73 ( wp, inp, tau ) + CASE (74) !Imma + CALL wypos_74 ( wp, inp, tau ) + CASE (75) !P4 + CALL wypos_75 ( wp, inp, tau ) + CASE (77) !P4(2) + CALL wypos_77 ( wp, inp, tau ) + CASE (79) !I4(2) + CALL wypos_79 ( wp, inp, tau ) + CASE (80) !I4(1) + CALL wypos_80 ( wp, inp, tau ) + CASE (81) !P-4 + CALL wypos_81 ( wp, inp, tau ) + CASE (82) !I-4 + CALL wypos_82 ( wp, inp, tau ) + CASE (83) !P4/m + CALL wypos_83 ( wp, inp, tau ) + CASE (84) + CALL wypos_84 ( wp, inp, tau ) + CASE (85) + CALL wypos_85 ( wp, inp, origin_choice, tau ) + CASE (86) + CALL wypos_86 ( wp, inp, origin_choice, tau ) + CASE (87) !I4/m + CALL wypos_87 ( wp, inp, tau ) + CASE (88) !I4(1)/a + CALL wypos_88 ( wp, inp, origin_choice, tau ) + CASE (89) !P422 + CALL wypos_89 ( wp, inp, tau ) + CASE (90) !P42(1)2 + CALL wypos_90 ( wp, inp, tau ) + CASE (91) !P4(1)22 + CALL wypos_91 ( wp, inp, tau ) + CASE (92) !P4(1)2(1)2 + CALL wypos_92 ( wp, inp, tau ) + CASE (93) !P4(2)22 + CALL wypos_93 ( wp, inp, tau ) + CASE (94) !P4(2)2(1)2 + CALL wypos_94 ( wp, inp, tau ) + CASE (95) !P4(3)22 + CALL wypos_95 ( wp, inp, tau ) + CASE (96) !P4(2)2(1)2 + CALL wypos_96 ( wp, inp, tau ) + CASE (97) !I422 + CALL wypos_97 ( wp, inp, tau ) + CASE (98) !I4(1)22 + CALL wypos_98 ( wp, inp, tau ) + CASE (99) !P4mm + CALL wypos_99 ( wp, inp, tau ) + CASE (100) !P4bm + CALL wypos_100( wp, inp, tau ) + CASE (101) !P4(2)cm + CALL wypos_101( wp, inp, tau ) + CASE (102) !P4(2)nm + CALL wypos_102( wp, inp, tau ) + CASE (103) !P4cc + CALL wypos_103( wp, inp, tau ) + CASE (104) !P4nc + CALL wypos_104( wp, inp, tau ) + CASE (105) !P4(2)mc + CALL wypos_105( wp, inp, tau ) + CASE (106) !P4(2)bc + CALL wypos_106( wp, inp, tau ) + CASE (107) !I4mm + CALL wypos_107( wp, inp, tau ) + CASE (108) !I4cm + CALL wypos_108( wp, inp, tau ) + CASE (109) !I4(1)md + CALL wypos_109( wp, inp, tau ) + CASE (110) !I4(1)cd + CALL wypos_110( wp, inp, tau ) + CASE (111) !P-42m + CALL wypos_111( wp, inp, tau ) + CASE (112) !P-42c + CALL wypos_112( wp, inp, tau ) + CASE (113) !P-42(1)m + CALL wypos_113( wp, inp, tau ) + CASE (114) !P-42(1)c + CALL wypos_114( wp, inp, tau ) + CASE (115) !P-4m2 + CALL wypos_115( wp, inp, tau ) + CASE (116) !P4c2 + CALL wypos_116( wp, inp, tau ) + CASE (117) !P-4b2 + CALL wypos_117( wp, inp, tau ) + CASE (118) !P-4n2 + CALL wypos_118( wp, inp, tau ) + CASE (119) !I-4m2 + CALL wypos_119( wp, inp, tau ) + CASE (120) !I-4c2 + CALL wypos_120( wp, inp, tau ) + CASE (121) !I-42m + CALL wypos_121( wp, inp, tau ) + CASE (122) !I-42d + CALL wypos_122( wp, inp, tau ) + CASE (123) !P4/mmm + CALL wypos_123( wp, inp, tau ) + CASE (124) !P4/mmc + CALL wypos_124( wp, inp, tau ) + CASE (125) !P/nbm + CALL wypos_125( wp, inp, origin_choice, tau ) + CASE (126) + CALL wypos_126( wp, inp, origin_choice, tau ) + CASE (127) !P4/mbm + CALL wypos_127( wp, inp, tau ) + CASE (128) !P4/mnc + CALL wypos_128( wp, inp, tau ) + CASE (129) !P4/nmm + CALL wypos_129( wp, inp, origin_choice, tau ) + CASE (130) !P4/ncc + CALL wypos_130( wp, inp, origin_choice, tau ) + CASE (131) !P4(2)/mmc + CALL wypos_131( wp, inp, tau ) + CASE (132) !P4(2)mcm + CALL wypos_132( wp, inp, tau ) + CASE (133) !P4(2)/nbc + CALL wypos_133( wp, inp, origin_choice, tau ) + CASE (134) !P4(2)/nnm + CALL wypos_134( wp, inp, origin_choice, tau ) + CASE (135) !P3(2)/mbc + CALL wypos_135( wp, inp, tau ) + CASE (136) !P4(2)/mnm + CALL wypos_136( wp, inp, tau ) + CASE (137) !P4(2)/nmc + CALL wypos_137( wp, inp, origin_choice, tau ) + CASE (138) !P4(2)/ncm + CALL wypos_138( wp, inp, origin_choice, tau ) + CASE (139) !I4/mmm + CALL wypos_139( wp, inp, tau ) + CASE (140) !I4/mcm + CALL wypos_140( wp, inp, tau ) + CASE (141) !I4(1)/amd + CALL wypos_141( wp, inp, origin_choice, tau ) + CASE (142) !I4(1)/acd + CALL wypos_142( wp, inp, origin_choice, tau ) + CASE(143) !P3 + CALL wypos_143( wp, inp, tau ) + CASE (146) !R3 + CALL wypos_146( wp, inp, rhombohedral, tau ) + CASE(147) !P-3 + CALL wypos_147( wp, inp, tau ) + CASE (148) !R-3 + CALL wypos_148( wp, inp, rhombohedral, tau ) + CASE (149) !P312 + CALL wypos_149( wp, inp, tau ) + CASE (150) !P321 + CALL wypos_150( wp, inp, tau ) + CASE (151) !P3(1)12 + CALL wypos_151( wp, inp, tau ) + CASE (152) !P3(1)21 + CALL wypos_152( wp, inp, tau ) + CASE (153) !P3(2)12 + CALL wypos_153( wp, inp, tau ) + CASE (154) !3(2)21 + CALL wypos_154( wp, inp, tau ) + CASE (155) !R32 + CALL wypos_155( wp, inp, rhombohedral, tau ) + CASE (156) !P-3m1 + CALL wypos_156( wp, inp, tau ) + CASE (157) !P31m + CALL wypos_157( wp, inp, tau ) + CASE (158) !P3c1 + CALL wypos_158( wp, inp, tau ) + CASE (159) !P31c + CALL wypos_159( wp, inp, tau ) + CASE (160) !R3m + CALL wypos_160( wp, inp, rhombohedral, tau ) + CASE (161) !R3c + CALL wypos_161( wp, inp, rhombohedral, tau ) + CASE (162) !P-31m + CALL wypos_162( wp, inp, tau ) + CASE (163) !P-31c + CALL wypos_163( wp, inp, tau ) + CASE (164) !P-3m1 + CALL wypos_164( wp, inp, tau ) + CASE (165) !P-3c1 + CALL wypos_165( wp, inp, tau ) + CASE (166) !R-3m + CALL wypos_166( wp, inp, rhombohedral, tau ) + CASE (167) !R-3c + CALL wypos_167( wp, inp, rhombohedral, tau ) + CASE (168) !P6 + CALL wypos_168( wp, inp, tau ) + CASE (171) !P6/m + CALL wypos_171( wp, inp, tau ) + CASE (172) !P6(4) + CALL wypos_172( wp, inp, tau ) + CASE (173) !P6(3) + CALL wypos_173( wp, inp, tau ) + CASE (174) !P-6 + CALL wypos_174( wp, inp, tau ) + CASE (175) !P6/m + CALL wypos_175( wp, inp, tau ) + CASE (176) !P6(3)/m + CALL wypos_176( wp, inp, tau ) + CASE (177) !P622 + CALL wypos_177( wp, inp, tau ) + CASE (178) !P6(1)22 + CALL wypos_178( wp, inp, tau ) + CASE (179) !P6(5)22 + CALL wypos_179( wp, inp, tau ) + CASE (180) !P6(2)22 + CALL wypos_180( wp, inp, tau ) + CASE (181) !P6(4)22 + CALL wypos_181( wp, inp, tau ) + CASE (182) !P6(3)22 + CALL wypos_182( wp, inp, tau ) + CASE (183) !P6mm + CALL wypos_183( wp, inp, tau ) + CASE (184) !P6cc + CALL wypos_184( wp, inp, tau ) + CASE (185) !P6(3)cm + CALL wypos_185( wp, inp, tau ) + CASE (186) !P6(3)mc + CALL wypos_186( wp, inp, tau ) + CASE (187) !P-6m2 + CALL wypos_187( wp, inp, tau ) + CASE (188) !P-6c2 + CALL wypos_188( wp, inp, tau ) + CASE (189) !P-62m + CALL wypos_189( wp, inp, tau ) + CASE (190) !P-62c + CALL wypos_190( wp, inp, tau ) + CASE (191) !P6/mmm + CALL wypos_191( wp, inp, tau ) + CASE (192) !P6/mcc + CALL wypos_192( wp, inp, tau ) + CASE (193) !P6(3)/mcm + CALL wypos_193( wp, inp, tau ) + CASE (194) !P6(3)mmc + CALL wypos_194( wp, inp, tau ) + CASE (195) !P23 + CALL wypos_195( wp, inp, tau ) + CASE (196) !F23 + CALL wypos_196( wp, inp, tau ) + CASE (197) !I23 + CALL wypos_197( wp, inp, tau ) + CASE (198) !P2(1)3 + CALL wypos_198( wp, inp, tau ) + CASE (199) !I2(1)3 + CALL wypos_199( wp, inp, tau ) + CASE (200) !Pm-3 + CALL wypos_200( wp, inp, tau ) + CASE (201) !Pn-3 + CALL wypos_201( wp, inp, origin_choice, tau ) + CASE (202) !Fm-3 + CALL wypos_202( wp, inp, tau ) + CASE (203) !Fd-3 + CALL wypos_203( wp, inp, origin_choice, tau ) + CASE (204) ! Im-3 + CALL wypos_204( wp, inp, tau ) + CASE (205) !Pa-3 + CALL wypos_205( wp, inp, tau ) + CASE (206) !Ia-3 + CALL wypos_206( wp, inp, tau ) + CASE (207) !P432 + CALL wypos_207( wp, inp, tau ) + CASE (208) !P4(2)32 + CALL wypos_208( wp, inp, tau ) + CASE (209) !F432 + CALL wypos_209( wp, inp, tau ) + CASE (210) !F4(1)32 + CALL wypos_210( wp, inp, tau ) + CASE (211) !I432 + CALL wypos_211( wp, inp, tau ) + CASE (212) !P4(3)32 + CALL wypos_212( wp, inp, tau ) + CASE (213) !P4(1)32 + CALL wypos_213( wp, inp, tau ) + CASE (214) !I4(I)32 + CALL wypos_214( wp, inp, tau ) + CASE (215) !P-43m + CALL wypos_215( wp, inp, tau ) + CASE (216) !F-43m + CALL wypos_216( wp, inp, tau ) + CASE (217) !I-43m + CALL wypos_217( wp, inp, tau ) + CASE (218) !P-43n + CALL wypos_218( wp, inp, tau ) + CASE (219) !F-43c + CALL wypos_219( wp, inp, tau ) + CASE (220) !I-43d + CALL wypos_220( wp, inp, tau ) + CASE (221) !Pm-3m + CALL wypos_221( wp, inp, tau ) + CASE (222) !Pn-3n + CALL wypos_222( wp, inp, origin_choice, tau ) + CASE (223) !Pm-3n + CALL wypos_223( wp, inp, tau ) + CASE (224) !Pn-3m + CALL wypos_224( wp, inp, origin_choice, tau ) + CASE (225) !Fm-3m + CALL wypos_225( wp, inp, tau ) + CASE (226) !Fm-3c + CALL wypos_226( wp, inp, tau ) + CASE (227) !Fd-3m + CALL wypos_227( wp, inp, origin_choice, tau ) + CASE (228) !Fd-3c + CALL wypos_228( wp, inp, origin_choice, tau ) + CASE (229) !Im-3m + CALL wypos_229( wp, inp, tau ) + CASE (230) !Ia-3d + CALL wypos_230( wp, inp, tau ) + CASE DEFAULT + CALL errore('wypos','group not recognized',1) + END SELECT + + IF (tau(1)==1.d5.OR.tau(2)==1.d5.OR.tau(3)==1.d5) THEN + IF (inp(1)==1.d5.OR.inp(2)==1.d5.OR.inp(3)==1.d5) THEN + CALL errore('wypos','wyckoff position not found',1) + ELSE + CALL infomsg('wypos','wyckoff position not found, assuming x y z') + tau(:)=inp(:) + END IF + END IF + + END SUBROUTINE wypos + +SUBROUTINE wypos_2 ( wp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -71,8 +523,15 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (3) !P2 - IF (uniqueb) THEN + END SUBROUTINE wypos_2 + +SUBROUTINE wypos_3 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + + IF (uniqueb) THEN IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=inp(1) @@ -90,7 +549,7 @@ CONTAINS tau(2)=inp(1) tau(3)=0.5_DP ENDIF - + ELSEIF (.NOT.uniqueb) THEN IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP @@ -111,131 +570,158 @@ CONTAINS ENDIF ENDIF - CASE (5) !C2 - IF (uniqueb) THEN - IF (TRIM(wp)=='2a') THEN - tau(1)=0.0_DP - tau(2)=inp(1) - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='2b') THEN - tau(1)=0.0_DP - tau(2)=inp(1) - tau(3)=0.5_DP - ENDIF - - ELSEIF (.NOT.uniqueb) THEN - IF (TRIM(wp)=='2a') THEN - tau(1)=0.0_DP - tau(2)=0.0_DP - tau(3)=inp(1) - ELSEIF (TRIM(wp)=='2b') THEN - tau(1)=0.5_DP - tau(2)=0.0_DP - tau(3)=inp(1) - ENDIF - ENDIF + END SUBROUTINE wypos_3 - CASE (6) !Pm - IF (uniqueb) THEN - IF (TRIM(wp)=='1a') THEN - tau(1)=inp(1) - tau(2)=0.0_DP - tau(3)=inp(2) - ELSEIF (TRIM(wp)=='1b') THEN - tau(1)=inp(1) - tau(2)=0.5_DP - tau(3)=inp(2) - ENDIF - - ELSEIF (.NOT.uniqueb) THEN - IF (TRIM(wp)=='1a') THEN - tau(1)=inp(1) - tau(2)=inp(2) - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='1b') THEN - tau(1)=inp(1) - tau(2)=inp(2) - tau(3)=0.5_DP - ENDIF - ENDIF - - CASE (8) !Cm - IF (uniqueb) THEN - IF (TRIM(wp)=='2a') THEN - tau(1)=inp(1) - tau(2)=0.0_DP - tau(3)=inp(2) - ENDIF - - ELSEIF (.NOT.uniqueb) THEN - IF (TRIM(wp)=='2a') THEN - tau(1)=inp(1) - tau(2)=inp(2) - tau(3)=0.0_DP - ENDIF - ENDIF - - CASE (10) !P2/m - IF (uniqueb) THEN - IF (TRIM(wp)=='1a') THEN - tau(1)=0.0_DP - tau(2)=0.0_DP - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='1b') THEN - tau(1)=0.0_DP - tau(2)=0.5_DP - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='1c') THEN - tau(1)=0.0_DP - tau(2)=0.0_DP - tau(3)=0.5_DP - ELSEIF (TRIM(wp)=='1d') THEN - tau(1)=0.5_DP - tau(2)=0.0_DP - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='1e') THEN - tau(1)=0.5_DP - tau(2)=0.5_DP - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='1f') THEN - tau(1)=0.0_DP - tau(2)=0.5_DP - tau(3)=0.5_DP - ELSEIF (TRIM(wp)=='1g') THEN - tau(1)=0.5_DP - tau(2)=0.0_DP - tau(3)=0.5_DP - ELSEIF (TRIM(wp)=='1h') THEN - tau(1)=0.5_DP - tau(2)=0.5_DP - tau(3)=0.5_DP - ELSEIF (TRIM(wp)=='2i') THEN - tau(1)=0.0_DP - tau(2)=inp(1) - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='2j') THEN - tau(1)=0.5_DP - tau(2)=inp(1) - tau(3)=0.0_DP - ELSEIF (TRIM(wp)=='2k') THEN - tau(1)=0.0_DP - tau(2)=inp(1) - tau(3)=0.5_DP - ELSEIF (TRIM(wp)=='2l') THEN - tau(1)=0.5_DP - tau(2)=inp(1) - tau(3)=0.5_DP - ELSEIF (TRIM(wp)=='2m') THEN - tau(1)=inp(1) - tau(2)=0.0_DP - tau(3)=inp(2) - ELSEIF (TRIM(wp)=='2n') THEN - tau(1)=inp(1) - tau(2)=0.5_DP - tau(3)=inp(2) - ENDIF - +SUBROUTINE wypos_5 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + IF (uniqueb) THEN + IF (TRIM(wp)=='2a') THEN + tau(1)=0.0_DP + tau(2)=inp(1) + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='2b') THEN + tau(1)=0.0_DP + tau(2)=inp(1) + tau(3)=0.5_DP + ENDIF + + ELSEIF (.NOT.uniqueb) THEN + IF (TRIM(wp)=='2a') THEN + tau(1)=0.0_DP + tau(2)=0.0_DP + tau(3)=inp(1) + ELSEIF (TRIM(wp)=='2b') THEN + tau(1)=0.5_DP + tau(2)=0.0_DP + tau(3)=inp(1) + ENDIF + ENDIF + + END SUBROUTINE wypos_5 + +SUBROUTINE wypos_6 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + + IF (uniqueb) THEN + IF (TRIM(wp)=='1a') THEN + tau(1)=inp(1) + tau(2)=0.0_DP + tau(3)=inp(2) + ELSEIF (TRIM(wp)=='1b') THEN + tau(1)=inp(1) + tau(2)=0.5_DP + tau(3)=inp(2) + ENDIF + + ELSEIF (.NOT.uniqueb) THEN + IF (TRIM(wp)=='1a') THEN + tau(1)=inp(1) + tau(2)=inp(2) + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='1b') THEN + tau(1)=inp(1) + tau(2)=inp(2) + tau(3)=0.5_DP + ENDIF + ENDIF + + END SUBROUTINE wypos_6 + +SUBROUTINE wypos_8 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + + IF (uniqueb) THEN + IF (TRIM(wp)=='2a') THEN + tau(1)=inp(1) + tau(2)=0.0_DP + tau(3)=inp(2) + ENDIF + + ELSEIF (.NOT.uniqueb) THEN + IF (TRIM(wp)=='2a') THEN + tau(1)=inp(1) + tau(2)=inp(2) + tau(3)=0.0_DP + ENDIF + ENDIF + + END SUBROUTINE wypos_8 + +SUBROUTINE wypos_10 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + + IF (uniqueb) THEN + IF (TRIM(wp)=='1a') THEN + tau(1)=0.0_DP + tau(2)=0.0_DP + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='1b') THEN + tau(1)=0.0_DP + tau(2)=0.5_DP + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='1c') THEN + tau(1)=0.0_DP + tau(2)=0.0_DP + tau(3)=0.5_DP + ELSEIF (TRIM(wp)=='1d') THEN + tau(1)=0.5_DP + tau(2)=0.0_DP + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='1e') THEN + tau(1)=0.5_DP + tau(2)=0.5_DP + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='1f') THEN + tau(1)=0.0_DP + tau(2)=0.5_DP + tau(3)=0.5_DP + ELSEIF (TRIM(wp)=='1g') THEN + tau(1)=0.5_DP + tau(2)=0.0_DP + tau(3)=0.5_DP + ELSEIF (TRIM(wp)=='1h') THEN + tau(1)=0.5_DP + tau(2)=0.5_DP + tau(3)=0.5_DP + ELSEIF (TRIM(wp)=='2i') THEN + tau(1)=0.0_DP + tau(2)=inp(1) + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='2j') THEN + tau(1)=0.5_DP + tau(2)=inp(1) + tau(3)=0.0_DP + ELSEIF (TRIM(wp)=='2k') THEN + tau(1)=0.0_DP + tau(2)=inp(1) + tau(3)=0.5_DP + ELSEIF (TRIM(wp)=='2l') THEN + tau(1)=0.5_DP + tau(2)=inp(1) + tau(3)=0.5_DP + ELSEIF (TRIM(wp)=='2m') THEN + tau(1)=inp(1) + tau(2)=0.0_DP + tau(3)=inp(2) + ELSEIF (TRIM(wp)=='2n') THEN + tau(1)=inp(1) + tau(2)=0.5_DP + tau(3)=inp(2) + ENDIF + ELSEIF (.NOT.uniqueb) THEN IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP @@ -295,8 +781,15 @@ CONTAINS tau(3)=0.5_DP ENDIF ENDIF - - CASE (11) !P2(1)/m + + END SUBROUTINE wypos_10 + +SUBROUTINE wypos_11 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + IF (uniqueb) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -317,9 +810,9 @@ CONTAINS ELSEIF (TRIM(wp)=='2e') THEN tau(1)=inp(1) tau(2)=0.25_DP - tau(3)=inp(2) + tau(3)=inp(2) ENDIF - + ELSEIF (.NOT.uniqueb) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -341,10 +834,17 @@ CONTAINS tau(1)=inp(1) tau(2)=inp(2) tau(3)=0.25_DP - ENDIF + ENDIF ENDIF - CASE (12) !C2/m + END SUBROUTINE wypos_11 + +SUBROUTINE wypos_12 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + IF (uniqueb) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -383,11 +883,9 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(2) ENDIF - ELSEIF (.NOT.uniqueb) THEN - IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -424,13 +922,19 @@ CONTAINS tau(1)=inp(1) tau(2)=inp(2) tau(3)=0.0_DP - ENDIF + ENDIF ENDIF - CASE (13) !P2/c + END SUBROUTINE wypos_12 + +SUBROUTINE wypos_13 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + IF (uniqueb) THEN - IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -456,11 +960,9 @@ CONTAINS tau(2)=inp(1) tau(3)=0.25_DP ENDIF - ELSEIF (.NOT.uniqueb) THEN - IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -486,13 +988,19 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - + ENDIF - CASE (14) !-P2(1)/c + END SUBROUTINE wypos_13 + +SUBROUTINE wypos_14 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + IF (uniqueb) THEN - IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -510,11 +1018,9 @@ CONTAINS tau(2)=0.0_DP tau(3)=0.5_DP ENDIF - ELSEIF (.NOT.uniqueb) THEN - IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -532,13 +1038,19 @@ CONTAINS tau(2)=0.5_DP tau(3)=0.0_DP ENDIF - + ENDIF - CASE (15) !C2/c + END SUBROUTINE wypos_14 + +SUBROUTINE wypos_15 ( wp, inp, uniqueb, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: uniqueb + REAL(dp), INTENT(out) :: tau (3) + IF (uniqueb) THEN - IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -560,11 +1072,9 @@ CONTAINS tau(2)=inp(1) tau(3)=0.25 ENDIF - ELSEIF (.NOT.uniqueb) THEN - IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -586,10 +1096,16 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(1) ENDIF - + ENDIF - CASE (16) !P222 + END SUBROUTINE wypos_15 + +SUBROUTINE wypos_16 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -671,9 +1187,15 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (17) !P222(1) + + END SUBROUTINE wypos_16 + +SUBROUTINE wypos_17 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=inp(1) tau(2)=0.0_DP @@ -692,7 +1214,13 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (18) !P2(1)2(1)2 + END SUBROUTINE wypos_17 + +SUBROUTINE wypos_18 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -703,7 +1231,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (20) !C222(1) + END SUBROUTINE wypos_18 + +SUBROUTINE wypos_20 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=inp(1) tau(2)=0.0_DP @@ -714,9 +1248,13 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (21) !C222 - - + END SUBROUTINE wypos_20 + +SUBROUTINE wypos_21 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -762,9 +1300,14 @@ CONTAINS tau(2)=0.25_DP tau(3)=inp(1) ENDIF - - - CASE (22) !F222 + + END SUBROUTINE wypos_21 + +SUBROUTINE wypos_22 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -806,9 +1349,14 @@ CONTAINS tau(2)=0.25_DP tau(3)=0.25_DP ENDIF - - CASE (23) !I222 + END SUBROUTINE wypos_22 + +SUBROUTINE wypos_23 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -850,8 +1398,14 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (24) !I2(1)2(1)2(1) + + END SUBROUTINE wypos_23 + +SUBROUTINE wypos_24 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=inp(1) tau(2)=0.0_DP @@ -866,7 +1420,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (25) !Pmm2 + END SUBROUTINE wypos_24 + +SUBROUTINE wypos_25 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -901,7 +1461,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (26) !Pmc2(1) + END SUBROUTINE wypos_25 + +SUBROUTINE wypos_26 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=inp(1) @@ -912,7 +1478,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (27) !Pcc2 + END SUBROUTINE wypos_26 + +SUBROUTINE wypos_27 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -931,7 +1503,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (28) !Pma2 + END SUBROUTINE wypos_27 + +SUBROUTINE wypos_28 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -946,7 +1524,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (30) !Pca2(1) + END SUBROUTINE wypos_28 + +SUBROUTINE wypos_30 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -957,14 +1541,25 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (31) !Pmn2(1) + END SUBROUTINE wypos_30 + +SUBROUTINE wypos_31 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=inp(1) tau(3)=inp(2) ENDIF + END SUBROUTINE wypos_31 - CASE (32) !Pba2 +SUBROUTINE wypos_32 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -975,7 +1570,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (34) !Pnn2 + END SUBROUTINE wypos_32 + +SUBROUTINE wypos_34 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -984,9 +1585,15 @@ CONTAINS tau(1)=0.0_DP tau(2)=0.5_DP tau(3)=inp(1) - ENDIF - - CASE (35) !Cmm2 + ENDIF + + END SUBROUTINE wypos_34 + +SUBROUTINE wypos_35 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1009,14 +1616,26 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (36) !Cmc2(1) + END SUBROUTINE wypos_35 + +SUBROUTINE wypos_36 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=inp(1) tau(3)=inp(2) ENDIF - CASE (37) !Ccc2 + END SUBROUTINE wypos_36 + +SUBROUTINE wypos_37 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1031,7 +1650,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (38) !Amm2 +END SUBROUTINE wypos_37 + +SUBROUTINE wypos_38 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1054,7 +1679,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (39) !Aem2 +END SUBROUTINE wypos_38 + +SUBROUTINE wypos_39 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1069,7 +1700,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (40) !Ama2 +END SUBROUTINE wypos_39 + +SUBROUTINE wypos_40 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1080,14 +1717,26 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (41) !Aea2 +END SUBROUTINE wypos_40 + +SUBROUTINE wypos_41 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP tau(3)=inp(1) ENDIF - CASE (42) !Fmm2 +END SUBROUTINE wypos_41 + +SUBROUTINE wypos_42 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1106,14 +1755,26 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (43) !Fdd2 +END SUBROUTINE wypos_42 + +SUBROUTINE wypos_43 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP tau(2)=0.0_DP tau(3)=inp(1) ENDIF - CASE (44) !Imm2 +END SUBROUTINE wypos_43 + +SUBROUTINE wypos_44 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1132,7 +1793,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (45) !Iba2 +END SUBROUTINE wypos_44 + +SUBROUTINE wypos_45 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1143,7 +1810,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (46) !Ima2 +END SUBROUTINE wypos_45 + +SUBROUTINE wypos_46 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1154,7 +1827,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (47) !Pmmm +END SUBROUTINE wypos_46 + +SUBROUTINE wypos_47 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1261,8 +1940,15 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (48) !Pnnn - IF (origin_choice==1) THEN +END SUBROUTINE wypos_47 + +SUBROUTINE wypos_48 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1362,10 +2048,16 @@ CONTAINS tau(1)=0.25_DP tau(2)=0.75_DP tau(3)=inp(1) - ENDIF + ENDIF ENDIF - - CASE (49) !Pccm + +END SUBROUTINE wypos_48 + +SUBROUTINE wypos_49 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1435,9 +2127,16 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (50) !Pban - IF (origin_choice==1) THEN + +END SUBROUTINE wypos_49 + +SUBROUTINE wypos_50 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1487,7 +2186,7 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -1540,7 +2239,13 @@ CONTAINS ENDIF ENDIF - CASE (51) !Pmma +END SUBROUTINE wypos_50 + +SUBROUTINE wypos_51 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1586,8 +2291,13 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (52) !Pnna + +END SUBROUTINE wypos_51 + +SUBROUTINE wypos_52 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1605,8 +2315,13 @@ CONTAINS tau(2)=0.25_DP tau(3)=0.25_DP ENDIF - - CASE (53) !Pmna + +END SUBROUTINE wypos_52 + +SUBROUTINE wypos_53 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1640,9 +2355,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (54) !Pcca + +END SUBROUTINE wypos_53 + +SUBROUTINE wypos_54 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1664,8 +2384,14 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (55) !Pbam + +END SUBROUTINE wypos_54 + +SUBROUTINE wypos_55 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1700,7 +2426,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (56) !Pccn +END SUBROUTINE wypos_55 + +SUBROUTINE wypos_56 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1719,7 +2451,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (57) !Pbcm +END SUBROUTINE wypos_56 + +SUBROUTINE wypos_57 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1737,8 +2475,14 @@ CONTAINS tau(2)=inp(2) tau(3)=0.25_DP ENDIF - - CASE (58) !Pnnm + +END SUBROUTINE wypos_57 + +SUBROUTINE wypos_58 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1770,9 +2514,16 @@ CONTAINS ENDIF - - CASE (59) !Pmmn - IF (origin_choice==1) THEN + +END SUBROUTINE wypos_58 + +SUBROUTINE wypos_59 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1798,7 +2549,7 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(2) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -1826,8 +2577,14 @@ CONTAINS tau(3)=inp(2) ENDIF ENDIF - - CASE (60) !Pbcn + +END SUBROUTINE wypos_59 + +SUBROUTINE wypos_60 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1841,9 +2598,15 @@ CONTAINS tau(2)=inp(1) tau(3)=0.25_DP ENDIF - - CASE (61) !Pbca + +END SUBROUTINE wypos_60 + +SUBROUTINE wypos_61 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1853,9 +2616,15 @@ CONTAINS tau(2)=0.0_DP tau(3)=0.5_DP ENDIF - - CASE (62) !Pnma + +END SUBROUTINE wypos_61 + +SUBROUTINE wypos_62 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1869,9 +2638,15 @@ CONTAINS tau(2)=0.25_DP tau(3)=inp(2) ENDIF - - CASE (63) !Cmcm + +END SUBROUTINE wypos_62 + +SUBROUTINE wypos_63 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1901,8 +2676,14 @@ CONTAINS tau(2)=inp(2) tau(3)=0.25_DP ENDIF - - CASE (64) !Cmce + +END SUBROUTINE wypos_63 + +SUBROUTINE wypos_64 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1928,8 +2709,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (65) !Cmmm + +END SUBROUTINE wypos_64 + +SUBROUTINE wypos_65 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -1999,9 +2786,15 @@ CONTAINS tau(2)=inp(2) tau(3)=0.5_DP ENDIF - - CASE (66) !Cccm + +END SUBROUTINE wypos_65 + +SUBROUTINE wypos_66 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2050,9 +2843,15 @@ CONTAINS tau(1)=inp(1) tau(2)=inp(2) tau(3)=0.0_DP - ENDIF + ENDIF - CASE (67) !Cmma +END SUBROUTINE wypos_66 + +SUBROUTINE wypos_67 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.25_DP tau(2)=0.0_DP @@ -2110,9 +2909,16 @@ CONTAINS tau(2)=0.25_DP tau(3)=inp(2) ENDIF - - CASE (68) !Ccce - IF (origin_choice==1) THEN + +END SUBROUTINE wypos_67 + +SUBROUTINE wypos_68 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + + IF (origin_choice==1) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2146,7 +2952,7 @@ CONTAINS tau(2)=0.25_DP tau(3)=inp(1) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP @@ -2183,7 +2989,13 @@ CONTAINS ENDIF ENDIF - CASE (69) !Fmmm +END SUBROUTINE wypos_68 + +SUBROUTINE wypos_69 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2245,8 +3057,15 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (70) !Fddd + +END SUBROUTINE wypos_69 + +SUBROUTINE wypos_70 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP @@ -2277,9 +3096,9 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(1) ENDIF - - ELSEIF (origin_choice==2) THEN + + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='8a') THEN tau(1)=0.125_DP tau(2)=0.125_DP @@ -2311,7 +3130,13 @@ CONTAINS ENDIF ENDIF - CASE (71) !Immm +END SUBROUTINE wypos_70 + +SUBROUTINE wypos_71 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2369,8 +3194,14 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (72) !Ibam + +END SUBROUTINE wypos_71 + +SUBROUTINE wypos_72 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2412,8 +3243,14 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (73) !Ibca + +END SUBROUTINE wypos_72 + +SUBROUTINE wypos_73 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2435,9 +3272,15 @@ CONTAINS tau(2)=0.25_DP tau(3)=inp(1) ENDIF - - CASE (74) !Imma + +END SUBROUTINE wypos_73 + +SUBROUTINE wypos_74 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2476,7 +3319,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (75) !P4 +END SUBROUTINE wypos_74 + +SUBROUTINE wypos_75 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2491,7 +3340,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (77) !P4(2) +END SUBROUTINE wypos_75 + +SUBROUTINE wypos_77 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2506,7 +3361,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (79) !I4(2) +END SUBROUTINE wypos_77 + +SUBROUTINE wypos_79 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2517,14 +3378,26 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (80) !I4(1) +END SUBROUTINE wypos_79 + +SUBROUTINE wypos_80 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP tau(3)=inp(1) ENDIF - CASE (81) !P-4 +END SUBROUTINE wypos_80 + +SUBROUTINE wypos_81 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2554,8 +3427,14 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (82) !I-4 + +END SUBROUTINE wypos_81 + +SUBROUTINE wypos_82 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2581,8 +3460,14 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (83) !P4/m + +END SUBROUTINE wypos_82 + +SUBROUTINE wypos_83 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2629,7 +3514,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (84) +END SUBROUTINE wypos_83 + +SUBROUTINE wypos_84 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2671,8 +3562,15 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (85) + +END SUBROUTINE wypos_84 + +SUBROUTINE wypos_85 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -2699,7 +3597,7 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(1) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -2728,7 +3626,14 @@ CONTAINS ENDIF ENDIF - CASE (86) +END SUBROUTINE wypos_85 + +SUBROUTINE wypos_86 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -2755,7 +3660,7 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(1) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -2784,7 +3689,13 @@ CONTAINS ENDIF ENDIF - CASE (87) !I4/m +END SUBROUTINE wypos_86 + +SUBROUTINE wypos_87 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2818,9 +3729,16 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (88) !I4(1)/a + +END SUBROUTINE wypos_87 + +SUBROUTINE wypos_88 ( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP @@ -2843,8 +3761,8 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(1) ENDIF - - ELSEIF (origin_choice==2) THEN + + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.25_DP @@ -2868,7 +3786,13 @@ CONTAINS ENDIF ENDIF - CASE (89) !P422 +END SUBROUTINE wypos_88 + +SUBROUTINE wypos_89 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2930,8 +3854,14 @@ CONTAINS tau(2)=0.5_DP tau(3)=0.0_DP ENDIF - - CASE (90) !P42(1)2 + +END SUBROUTINE wypos_89 + +SUBROUTINE wypos_90 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -2957,8 +3887,14 @@ CONTAINS tau(2)=inp(1) tau(3)=0.5_DP ENDIF - - CASE (91) !P4(1)22 + +END SUBROUTINE wypos_90 + +SUBROUTINE wypos_91 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=inp(1) @@ -2973,14 +3909,26 @@ CONTAINS tau(3)=0.375_DP ENDIF - CASE (92) !P4(1)2(1)2 +END SUBROUTINE wypos_91 + +SUBROUTINE wypos_92 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=inp(1) tau(2)=inp(1) tau(3)=0.0_DP ENDIF - CASE (93) !P4(2)22 +END SUBROUTINE wypos_92 + +SUBROUTINE wypos_93 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3042,8 +3990,14 @@ CONTAINS tau(2)=inp(1) tau(3)=0.75_DP ENDIF - - CASE (94) !P4(2)2(1)2 + +END SUBROUTINE wypos_93 + +SUBROUTINE wypos_94 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3070,7 +4024,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (95) !P4(3)22 +END SUBROUTINE wypos_94 + +SUBROUTINE wypos_95 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=inp(1) @@ -3085,14 +4045,26 @@ CONTAINS tau(3)=0.625_DP ENDIF - CASE (96) !P4(2)2(1)2 +END SUBROUTINE wypos_95 + +SUBROUTINE wypos_96 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=inp(1) tau(2)=inp(1) tau(3)=0.0_DP ENDIF - CASE (97) !I422 +END SUBROUTINE wypos_96 + +SUBROUTINE wypos_97 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3134,8 +4106,14 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=0.25_DP ENDIF - - CASE (98) !I4(1)22 + +END SUBROUTINE wypos_97 + +SUBROUTINE wypos_98 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3162,7 +4140,13 @@ CONTAINS tau(3)=0.125_DP ENDIF - CASE (99) !P4mm +END SUBROUTINE wypos_98 + +SUBROUTINE wypos_99 ( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3187,9 +4171,15 @@ CONTAINS tau(1)=inp(1) tau(2)=0.5_DP tau(3)=inp(2) - ENDIF + ENDIF - CASE (100) !P4bm +END SUBROUTINE wypos_99 + +SUBROUTINE wypos_100( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3204,7 +4194,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (101) !P4(2)cm +END SUBROUTINE wypos_100 + +SUBROUTINE wypos_101( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3223,7 +4219,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (102) !P4(2)nm +END SUBROUTINE wypos_101 + +SUBROUTINE wypos_102( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3238,7 +4240,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (103) !P4cc +END SUBROUTINE wypos_102 + +SUBROUTINE wypos_103( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3253,7 +4261,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (104) !P4nc +END SUBROUTINE wypos_103 + +SUBROUTINE wypos_104( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3264,7 +4278,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (105) !P4(2)mc +END SUBROUTINE wypos_104 + +SUBROUTINE wypos_105( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3287,7 +4307,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (106) !P4(2)bc +END SUBROUTINE wypos_105 + +SUBROUTINE wypos_106( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3298,7 +4324,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (107) !I4mm +END SUBROUTINE wypos_106 + +SUBROUTINE wypos_107( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3317,7 +4349,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (108) !I4cm +END SUBROUTINE wypos_107 + +SUBROUTINE wypos_108( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3332,7 +4370,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (109) !I4(1)md +END SUBROUTINE wypos_108 + +SUBROUTINE wypos_109( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3343,14 +4387,26 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (110) !I4(1)cd +END SUBROUTINE wypos_109 + +SUBROUTINE wypos_110( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP tau(2)=0.0_DP tau(3)=inp(1) ENDIF - CASE (111) !P-42m +END SUBROUTINE wypos_110 + +SUBROUTINE wypos_111( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3408,8 +4464,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (112) !P-42c + +END SUBROUTINE wypos_111 + +SUBROUTINE wypos_112( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3463,9 +4525,15 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (113) !P-42(1)m + +END SUBROUTINE wypos_112 + +SUBROUTINE wypos_113( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3487,8 +4555,14 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=inp(2) ENDIF - - CASE (114) !P-42(1)c + +END SUBROUTINE wypos_113 + +SUBROUTINE wypos_114( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3506,9 +4580,15 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (115) !P-4m2 + +END SUBROUTINE wypos_114 + +SUBROUTINE wypos_115( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3554,9 +4634,15 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(2) ENDIF - - CASE (116) !P4c2 + +END SUBROUTINE wypos_115 + +SUBROUTINE wypos_116( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3594,9 +4680,15 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (117) !P-4b2 + +END SUBROUTINE wypos_116 + +SUBROUTINE wypos_117( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3630,9 +4722,15 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=0.5_DP ENDIF - - CASE (118) !P-4n2 + +END SUBROUTINE wypos_117 + +SUBROUTINE wypos_118( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3666,8 +4764,14 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(1) ENDIF - - CASE (119) !I-4m2 + +END SUBROUTINE wypos_118 + +SUBROUTINE wypos_119( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3705,9 +4809,15 @@ CONTAINS tau(2)=0.0_DP tau(3)=inp(2) ENDIF - - CASE (120) !I-4c2 + +END SUBROUTINE wypos_119 + +SUBROUTINE wypos_120( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3741,8 +4851,14 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=0.0_DP ENDIF - - CASE (121) !I-42m + +END SUBROUTINE wypos_120 + +SUBROUTINE wypos_121( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3780,8 +4896,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (122) !I-42d + +END SUBROUTINE wypos_121 + +SUBROUTINE wypos_122( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3799,11 +4921,15 @@ CONTAINS tau(2)=0.25_DP tau(3)=0.125_DP ENDIF - - - CASE (123) !P4/mmm - - + + +END SUBROUTINE wypos_122 + +SUBROUTINE wypos_123( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3885,9 +5011,15 @@ CONTAINS tau(2)=0.5_DP tau(3)=inp(2) ENDIF - - CASE (124) !P4/mmc + +END SUBROUTINE wypos_123 + +SUBROUTINE wypos_124( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3911,7 +5043,7 @@ CONTAINS ELSEIF (TRIM(wp)=='4f') THEN tau(1)=0.0_DP tau(2)=0.5_DP - tau(3)=0.25_DP + tau(3)=0.25_DP ELSEIF (TRIM(wp)=='4g') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -3941,9 +5073,16 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (125) !P/nbm + +END SUBROUTINE wypos_124 + +SUBROUTINE wypos_125( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -3998,7 +5137,7 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=inp(2) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -4055,10 +5194,16 @@ CONTAINS ENDIF ENDIF - CASE (126) - IF (origin_choice==1) THEN +END SUBROUTINE wypos_125 + +SUBROUTINE wypos_126( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + + IF (origin_choice==1) THEN - IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4100,7 +5245,7 @@ CONTAINS tau(2)=0.0_DP tau(3)=0.5_DP ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -4145,7 +5290,13 @@ CONTAINS ENDIF ENDIF - CASE (127) !P4/mbm +END SUBROUTINE wypos_126 + +SUBROUTINE wypos_127( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4191,9 +5342,15 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=inp(2) ENDIF - - CASE (128) !P4/mnc + +END SUBROUTINE wypos_127 + +SUBROUTINE wypos_128( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4227,9 +5384,16 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (129) !P4/nmm - IF (origin_choice==1) THEN + +END SUBROUTINE wypos_128 + +SUBROUTINE wypos_129( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4271,11 +5435,11 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=inp(2) ENDIF - + ELSEIF (origin_choice==2) THEN - + IF (TRIM(wp)=='2a') THEN tau(1)=0.75_DP tau(2)=0.25_DP @@ -4318,8 +5482,15 @@ CONTAINS tau(3)=inp(2) ENDIF ENDIF - - CASE (130) !P4/ncc + +END SUBROUTINE wypos_129 + +SUBROUTINE wypos_130( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP @@ -4346,7 +5517,7 @@ CONTAINS tau(2)=inp(1) tau(3)=0.25_DP ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.75_DP @@ -4375,7 +5546,13 @@ CONTAINS ENDIF ENDIF - CASE (131) !P4(2)/mmc +END SUBROUTINE wypos_130 + +SUBROUTINE wypos_131( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4445,9 +5622,15 @@ CONTAINS tau(2)=inp(2) tau(3)=0.0_DP ENDIF - - CASE (132) !P4(2)mcm + +END SUBROUTINE wypos_131 + +SUBROUTINE wypos_132( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4509,8 +5692,15 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (133) !P4(2)/nbc + +END SUBROUTINE wypos_132 + +SUBROUTINE wypos_133( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP @@ -4598,7 +5788,14 @@ CONTAINS ENDIF ENDIF - CASE (134) !P4(2)/nnm +END SUBROUTINE wypos_133 + +SUBROUTINE wypos_134( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -4708,10 +5905,16 @@ CONTAINS tau(2)=-inp(1) tau(3)=inp(2) ENDIF - + ENDIF - CASE (135) !P3(2)/mbc +END SUBROUTINE wypos_134 + +SUBROUTINE wypos_135( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4746,7 +5949,13 @@ CONTAINS tau(3)=0.0_DP ENDIF - CASE (136) !P4(2)/mnm +END SUBROUTINE wypos_135 + +SUBROUTINE wypos_136( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4789,7 +5998,14 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (137) !P4(2)/nmc +END SUBROUTINE wypos_136 + +SUBROUTINE wypos_137( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -4820,7 +6036,7 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -4850,10 +6066,17 @@ CONTAINS tau(1)=0.25_DP tau(2)=inp(1) tau(3)=inp(2) - ENDIF + ENDIF ENDIF - CASE (138) !P4(2)/ncm +END SUBROUTINE wypos_137 + +SUBROUTINE wypos_138( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP @@ -4892,7 +6115,7 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=inp(2) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.75_DP @@ -4930,10 +6153,16 @@ CONTAINS tau(1)=inp(1) tau(2)=inp(1) tau(3)=inp(2) - ENDIF + ENDIF ENDIF - CASE (139) !I4/mmm +END SUBROUTINE wypos_138 + +SUBROUTINE wypos_139( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -4991,8 +6220,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (140) !I4/mcm + +END SUBROUTINE wypos_139 + +SUBROUTINE wypos_140( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5038,8 +6273,15 @@ CONTAINS tau(2)=inp(1)+0.5_DP tau(3)=inp(2) ENDIF - - CASE (141) !I4(1)/amd + +END SUBROUTINE wypos_140 + +SUBROUTINE wypos_141( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP @@ -5074,7 +6316,7 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP @@ -5109,10 +6351,17 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - + ENDIF - CASE (142) !I4(1)/acd +END SUBROUTINE wypos_141 + +SUBROUTINE wypos_142( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP @@ -5139,7 +6388,7 @@ CONTAINS tau(2)=inp(1) tau(3)=0.25_DP ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP @@ -5166,10 +6415,16 @@ CONTAINS tau(2)=inp(1)+0.25_DP tau(3)=0.125_DP ENDIF - + ENDIF - CASE(143) !P3 +END SUBROUTINE wypos_142 + +SUBROUTINE wypos_143( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5184,7 +6439,14 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (146) !R3 +END SUBROUTINE wypos_143 + +SUBROUTINE wypos_146( wp, inp, rhombohedral, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: rhombohedral + REAL(dp), INTENT(out) :: tau (3) + IF (rhombohedral) THEN IF (TRIM(wp)=='1a') THEN tau(1)=inp(1) @@ -5199,7 +6461,13 @@ CONTAINS ENDIF ENDIF - CASE(147) !P-3 +END SUBROUTINE wypos_146 + +SUBROUTINE wypos_147( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5225,10 +6493,17 @@ CONTAINS tau(2)=0.0_DP tau(3)=0.5_DP ENDIF - - CASE (148) !R-3 - IF (rhombohedral) THEN + +END SUBROUTINE wypos_147 + +SUBROUTINE wypos_148( wp, inp, rhombohedral, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: rhombohedral + REAL(dp), INTENT(out) :: tau (3) + + IF (rhombohedral) THEN IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5275,7 +6550,13 @@ CONTAINS ENDIF ENDIF - CASE (149) !P312 +END SUBROUTINE wypos_148 + +SUBROUTINE wypos_149( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5321,8 +6602,14 @@ CONTAINS tau(2)=-inp(1) tau(3)=0.5_DP ENDIF - - CASE (150) !P321 + +END SUBROUTINE wypos_149 + +SUBROUTINE wypos_150( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5349,7 +6636,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (151) !P3(1)12 +END SUBROUTINE wypos_150 + +SUBROUTINE wypos_151( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=inp(1) tau(2)=-inp(1) @@ -5360,7 +6653,13 @@ CONTAINS tau(3)=5.0_DP/6.0_DP ENDIF - CASE (152) !P3(1)21 +END SUBROUTINE wypos_151 + +SUBROUTINE wypos_152( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=inp(1) tau(2)=0.0_DP @@ -5371,7 +6670,13 @@ CONTAINS tau(3)=5.0_DP/6.0_DP ENDIF - CASE (153) !P3(2)12 +END SUBROUTINE wypos_152 + +SUBROUTINE wypos_153( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=inp(1) tau(2)=-inp(1) @@ -5382,7 +6687,13 @@ CONTAINS tau(3)=1.0_DP/6.0_DP ENDIF - CASE (154) !3(2)21 +END SUBROUTINE wypos_153 + +SUBROUTINE wypos_154( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=inp(1) tau(2)=0.0_DP @@ -5393,7 +6704,14 @@ CONTAINS tau(3)=1.0_DP/6.0_DP ENDIF - CASE (155) !R32 +END SUBROUTINE wypos_154 + +SUBROUTINE wypos_155( wp, inp, rhombohedral, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: rhombohedral + REAL(dp), INTENT(out) :: tau (3) + IF (rhombohedral) THEN IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP @@ -5438,10 +6756,16 @@ CONTAINS tau(1)=inp(1) tau(2)=0.0_DP tau(3)=0.5_DP - ENDIF + ENDIF ENDIF - CASE (156) !P-3m1 +END SUBROUTINE wypos_155 + +SUBROUTINE wypos_156( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5460,7 +6784,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (157) !P31m +END SUBROUTINE wypos_156 + +SUBROUTINE wypos_157( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5475,7 +6805,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (158) !P3c1 +END SUBROUTINE wypos_157 + +SUBROUTINE wypos_158( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5490,7 +6826,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (159) !P31c +END SUBROUTINE wypos_158 + +SUBROUTINE wypos_159( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5499,9 +6841,16 @@ CONTAINS tau(1)=1.0_DP/3.0_DP tau(2)=2.0_DP/3.0_DP tau(3)=inp(1) - ENDIF + ENDIF - CASE (160) !R3m +END SUBROUTINE wypos_159 + +SUBROUTINE wypos_160( wp, inp, rhombohedral, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: rhombohedral + REAL(dp), INTENT(out) :: tau (3) + IF (rhombohedral) THEN IF (TRIM(wp)=='1a') THEN tau(1)=inp(1) @@ -5522,10 +6871,17 @@ CONTAINS tau(1)=inp(1) tau(2)=-inp(1) tau(3)=inp(2) - ENDIF + ENDIF ENDIF - CASE (161) !R3c +END SUBROUTINE wypos_160 + +SUBROUTINE wypos_161( wp, inp, rhombohedral, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: rhombohedral + REAL(dp), INTENT(out) :: tau (3) + IF (rhombohedral) THEN IF (TRIM(wp)=='2a') THEN tau(1)=inp(1) @@ -5538,10 +6894,16 @@ CONTAINS tau(1)=0.0_DP tau(2)=0.0_DP tau(3)=inp(1) - ENDIF + ENDIF ENDIF - CASE (162) !P-31m +END SUBROUTINE wypos_161 + +SUBROUTINE wypos_162( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5588,7 +6950,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (163) !P-31c +END SUBROUTINE wypos_162 + +SUBROUTINE wypos_163( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5623,7 +6991,13 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (164) !P-3m1 +END SUBROUTINE wypos_163 + +SUBROUTINE wypos_164( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5661,8 +7035,14 @@ CONTAINS tau(2)=-inp(1) tau(3)=inp(2) ENDIF - - CASE (165) !P-3c1 + +END SUBROUTINE wypos_164 + +SUBROUTINE wypos_165( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5689,7 +7069,14 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (166) !R-3m +END SUBROUTINE wypos_165 + +SUBROUTINE wypos_166( wp, inp, rhombohedral, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: rhombohedral + REAL(dp), INTENT(out) :: tau (3) + IF (rhombohedral) THEN IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP @@ -5725,7 +7112,7 @@ CONTAINS tau(3)=inp(2) ENDIF - ELSEIF (.NOT.rhombohedral) THEN + ELSEIF (.NOT.rhombohedral) THEN IF (TRIM(wp)=='3a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5761,7 +7148,14 @@ CONTAINS ENDIF ENDIF - CASE (167) !R-3c +END SUBROUTINE wypos_166 + +SUBROUTINE wypos_167( wp, inp, rhombohedral, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + LOGICAL, INTENT(in) :: rhombohedral + REAL(dp), INTENT(out) :: tau (3) + IF (rhombohedral) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -5784,7 +7178,7 @@ CONTAINS tau(2)=-inp(1)+0.5_DP tau(3)=0.25_DP ENDIF - + ELSEIF (.NOT.rhombohedral) THEN IF (TRIM(wp)=='6a') THEN tau(1)=0.0_DP @@ -5809,7 +7203,13 @@ CONTAINS ENDIF ENDIF - CASE (168) !P6 +END SUBROUTINE wypos_167 + +SUBROUTINE wypos_168( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5824,7 +7224,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (171) !P6/m +END SUBROUTINE wypos_168 + +SUBROUTINE wypos_171( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5835,7 +7241,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (172) !P6(4) +END SUBROUTINE wypos_171 + +SUBROUTINE wypos_172( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5846,7 +7258,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (173) !P6(3) +END SUBROUTINE wypos_172 + +SUBROUTINE wypos_173( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5857,7 +7275,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (174) !P-6 +END SUBROUTINE wypos_173 + +SUBROUTINE wypos_174( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5904,9 +7328,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (175) !P6/m - - +END SUBROUTINE wypos_174 + +SUBROUTINE wypos_175( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5953,7 +7381,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (176) !P6(3)/m +END SUBROUTINE wypos_175 + +SUBROUTINE wypos_176( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -5988,7 +7422,13 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (177) !P622 +END SUBROUTINE wypos_176 + +SUBROUTINE wypos_177( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6042,8 +7482,14 @@ CONTAINS tau(2)=-inp(1) tau(3)=0.5_DP ENDIF - - CASE (178) !P6(1)22 + +END SUBROUTINE wypos_177 + +SUBROUTINE wypos_178( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='6a') THEN tau(1)=inp(1) tau(2)=0.0_DP @@ -6054,7 +7500,12 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (179) !P6(5)22 +END SUBROUTINE wypos_178 + +SUBROUTINE wypos_179( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) IF (TRIM(wp)=='6a') THEN tau(1)=inp(1) tau(2)=0.0_DP @@ -6065,7 +7516,13 @@ CONTAINS tau(3)=0.75_DP ENDIF - CASE (180) !P6(2)22 +END SUBROUTINE wypos_179 + +SUBROUTINE wypos_180( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6108,7 +7565,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (181) !P6(4)22 +END SUBROUTINE wypos_180 + +SUBROUTINE wypos_181( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='3a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6151,7 +7614,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (182) !P6(3)22 +END SUBROUTINE wypos_181 + +SUBROUTINE wypos_182( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6186,7 +7655,13 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (183) !P6mm +END SUBROUTINE wypos_182 + +SUBROUTINE wypos_183( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6209,7 +7684,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (184) !P6cc +END SUBROUTINE wypos_183 + +SUBROUTINE wypos_184( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6224,7 +7705,13 @@ CONTAINS tau(3)=inp(1) ENDIF - CASE (185) !P6(3)cm +END SUBROUTINE wypos_184 + +SUBROUTINE wypos_185( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6239,7 +7726,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (186) !P6(3)mc +END SUBROUTINE wypos_185 + +SUBROUTINE wypos_186( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6254,7 +7747,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (187) !P-6m2 +END SUBROUTINE wypos_186 + +SUBROUTINE wypos_187( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6312,8 +7811,14 @@ CONTAINS tau(2)=-inp(1) tau(3)=inp(2) ENDIF - - CASE (188) !P-6c2 + +END SUBROUTINE wypos_187 + +SUBROUTINE wypos_188( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6360,7 +7865,13 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (189) !P-62m +END SUBROUTINE wypos_188 + +SUBROUTINE wypos_189( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6407,7 +7918,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (190) !P-62c +END SUBROUTINE wypos_189 + +SUBROUTINE wypos_190( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6441,9 +7958,15 @@ CONTAINS tau(2)=inp(2) tau(3)=0.25_DP ENDIF - - CASE (191) !P6/mmm + +END SUBROUTINE wypos_190 + +SUBROUTINE wypos_191( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6513,8 +8036,14 @@ CONTAINS tau(2)=inp(2) tau(3)=0.5_DP ENDIF - - CASE (192) !P6/mcc + +END SUBROUTINE wypos_191 + +SUBROUTINE wypos_192( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6562,10 +8091,17 @@ CONTAINS ELSEIF (TRIM(wp)=='12l') THEN tau(1)=inp(1) tau(2)=inp(2) - tau(3)=0.0_DP + tau(3)=0.0_DP ENDIF - - CASE (193) !P6(3)/mcm + +END SUBROUTINE wypos_192 + +SUBROUTINE wypos_193( wp, inp, tau ) + + REAL(dp), INTENT(in) :: inp(3) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6613,7 +8149,13 @@ CONTAINS ENDIF - CASE (194) !P6(3)mmc +END SUBROUTINE wypos_193 + +SUBROUTINE wypos_194( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6660,7 +8202,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (195) !P23 +END SUBROUTINE wypos_194 + +SUBROUTINE wypos_195( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6699,7 +8247,13 @@ CONTAINS tau(3)=0.5_DP ENDIF - CASE (196) !F23 +END SUBROUTINE wypos_195 + +SUBROUTINE wypos_196( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6729,8 +8283,14 @@ CONTAINS tau(2)=0.25_DP tau(3)=0.25_DP ENDIF - - CASE (197) !I23 + +END SUBROUTINE wypos_196 + +SUBROUTINE wypos_197( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6753,14 +8313,26 @@ CONTAINS tau(3)=0.0_DP ENDIF - CASE (198) !P2(1)3 +END SUBROUTINE wypos_197 + +SUBROUTINE wypos_198( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=inp(1) tau(2)=inp(1) tau(3)=inp(1) ENDIF - CASE (199) !I2(1)3 +END SUBROUTINE wypos_198 + +SUBROUTINE wypos_199( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=inp(1) tau(2)=inp(1) @@ -6771,7 +8343,13 @@ CONTAINS tau(3)=0.25_DP ENDIF - CASE (200) !Pm-3 +END SUBROUTINE wypos_199 + +SUBROUTINE wypos_200( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6818,7 +8396,14 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (201) !Pn-3 +END SUBROUTINE wypos_200 + +SUBROUTINE wypos_201( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -6849,7 +8434,7 @@ CONTAINS tau(2)=0.5_DP tau(3)=0.0_DP ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.25_DP @@ -6882,7 +8467,13 @@ CONTAINS ENDIF ENDIF - CASE (202) !Fm-3 +END SUBROUTINE wypos_201 + +SUBROUTINE wypos_202( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -6917,7 +8508,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (203) !Fd-3 +END SUBROUTINE wypos_202 + +SUBROUTINE wypos_203( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) IF (origin_choice==1) THEN IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP @@ -6973,7 +8570,13 @@ CONTAINS ENDIF ENDIF - CASE (204) ! Im-3 +END SUBROUTINE wypos_203 + +SUBROUTINE wypos_204( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7004,7 +8607,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (205) !Pa-3 +END SUBROUTINE wypos_204 + +SUBROUTINE wypos_205( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7018,8 +8627,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(1) ENDIF - - CASE (206) !Ia-3 + +END SUBROUTINE wypos_205 + +SUBROUTINE wypos_206( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7037,8 +8652,14 @@ CONTAINS tau(2)=0.0_DP tau(3)=0.25_DP ENDIF - - CASE (207) !P432 + +END SUBROUTINE wypos_206 + +SUBROUTINE wypos_207( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7080,9 +8701,15 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(1) ENDIF - - CASE (208) !P4(2)32 + +END SUBROUTINE wypos_207 + +SUBROUTINE wypos_208( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7132,8 +8759,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(1)+0.5_DP ENDIF - - CASE (209) !F432 + +END SUBROUTINE wypos_208 + +SUBROUTINE wypos_209( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7171,8 +8804,14 @@ CONTAINS tau(2)=0.25_DP tau(3)=0.25_DP ENDIF - - CASE (210) !F4(1)32 + +END SUBROUTINE wypos_209 + +SUBROUTINE wypos_210( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7202,8 +8841,14 @@ CONTAINS tau(2)=inp(1) tau(3)=-inp(1)+0.25_DP ENDIF - - CASE (211) !I432 + +END SUBROUTINE wypos_210 + +SUBROUTINE wypos_211( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7241,8 +8886,14 @@ CONTAINS tau(2)=inp(1) tau(3)=-inp(1)+0.5_DP ENDIF - - CASE (212) !P4(3)32 + +END SUBROUTINE wypos_211 + +SUBROUTINE wypos_212( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.125_DP tau(2)=0.125_DP @@ -7260,8 +8911,14 @@ CONTAINS tau(2)=inp(1) tau(3)=-inp(1)+0.25_DP ENDIF - - CASE (213) !P4(1)32 + +END SUBROUTINE wypos_212 + +SUBROUTINE wypos_213( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.375_DP tau(2)=0.375_DP @@ -7280,7 +8937,13 @@ CONTAINS tau(3)=inp(1)+0.25_DP ENDIF - CASE (214) !I4(I)32 +END SUBROUTINE wypos_213 + +SUBROUTINE wypos_214( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.125_DP tau(2)=0.125_DP @@ -7314,9 +8977,15 @@ CONTAINS tau(2)=inp(1) tau(3)=-inp(1)+0.25_DP ENDIF - - CASE (215) !P-43m + +END SUBROUTINE wypos_214 + +SUBROUTINE wypos_215( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7354,8 +9023,14 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (216) !F-43m + +END SUBROUTINE wypos_215 + +SUBROUTINE wypos_216( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7390,7 +9065,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (217) !I-43m +END SUBROUTINE wypos_216 + +SUBROUTINE wypos_217( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7421,7 +9102,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (218) !P-43n +END SUBROUTINE wypos_217 + +SUBROUTINE wypos_218( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7455,8 +9142,14 @@ CONTAINS tau(2)=0.0_DP tau(3)=0.5_DP ENDIF - - CASE (219) !F-43c + +END SUBROUTINE wypos_218 + +SUBROUTINE wypos_219( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7486,8 +9179,14 @@ CONTAINS tau(2)=0.25_DP tau(3)=0.25_DP ENDIF - - CASE (220) !I-43d + +END SUBROUTINE wypos_219 + +SUBROUTINE wypos_220( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='12a') THEN tau(1)=0.375_DP tau(2)=0.0_DP @@ -7505,8 +9204,14 @@ CONTAINS tau(2)=0.0_DP tau(3)=0.25_DP ENDIF - - CASE (221) !Pm-3m + +END SUBROUTINE wypos_220 + +SUBROUTINE wypos_221( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='1a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7560,10 +9265,17 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (222) !Pn-3n - IF (origin_choice==1) THEN + +END SUBROUTINE wypos_221 + +SUBROUTINE wypos_222( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7634,7 +9346,13 @@ CONTAINS ENDIF ENDIF - CASE (223) !Pm-3n +END SUBROUTINE wypos_222 + +SUBROUTINE wypos_223( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7681,7 +9399,14 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (224) !Pn-3m +END SUBROUTINE wypos_223 + +SUBROUTINE wypos_224( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP @@ -7777,7 +9502,13 @@ CONTAINS ENDIF ENDIF - CASE (225) !Fm-3m +END SUBROUTINE wypos_224 + +SUBROUTINE wypos_225( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='4a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -7824,7 +9555,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (226) !Fm-3c +END SUBROUTINE wypos_225 + +SUBROUTINE wypos_226( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='8a') THEN tau(1)=0.25_DP tau(2)=0.25_DP @@ -7862,8 +9599,15 @@ CONTAINS tau(2)=inp(1) tau(3)=inp(2) ENDIF - - CASE (227) !Fd-3m + +END SUBROUTINE wypos_226 + +SUBROUTINE wypos_227( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='8a') THEN tau(1)=0.0_DP @@ -7898,7 +9642,7 @@ CONTAINS tau(2)=inp(1) tau(3)=-inp(1)+0.25_DP ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='8a') THEN tau(1)=0.125_DP @@ -7935,7 +9679,14 @@ CONTAINS ENDIF ENDIF - CASE (228) !Fd-3c +END SUBROUTINE wypos_227 + +SUBROUTINE wypos_228( wp, inp, origin_choice, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + INTEGER, INTENT(in) :: origin_choice + REAL(dp), INTENT(out) :: tau (3) + IF (origin_choice==1) THEN IF (TRIM(wp)=='16a') THEN tau(1)=0.0_DP @@ -7966,7 +9717,7 @@ CONTAINS tau(2)=inp(1) tau(3)=-inp(1)+0.25_DP ENDIF - + ELSEIF (origin_choice==2) THEN IF (TRIM(wp)=='16a') THEN tau(1)=0.125_DP @@ -7999,7 +9750,13 @@ CONTAINS ENDIF ENDIF - CASE (229) !Im-3m +END SUBROUTINE wypos_228 + +SUBROUTINE wypos_229( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='2a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -8046,7 +9803,13 @@ CONTAINS tau(3)=inp(2) ENDIF - CASE (230) !Ia-3d +END SUBROUTINE wypos_229 + +SUBROUTINE wypos_230( wp, inp, tau ) + CHARACTER(LEN=*), INTENT(in) :: wp + REAL(dp), INTENT(in) :: inp(3) + REAL(dp), INTENT(out) :: tau (3) + IF (TRIM(wp)=='16a') THEN tau(1)=0.0_DP tau(2)=0.0_DP @@ -8076,19 +9839,5 @@ CONTAINS tau(2)=inp(1) tau(3)=-inp(1)+0.25_DP ENDIF - - CASE DEFAULT - CALL errore('wypos','group not recognized',1) - END SELECT - - IF (tau(1)==1.d5.OR.tau(2)==1.d5.OR.tau(3)==1.d5) THEN - IF (inp(1)==1.d5.OR.inp(2)==1.d5.OR.inp(3)==1.d5) THEN - CALL errore('wypos','wyckoff position not found',1) - ELSE - CALL infomsg('wypos','wyckoff position not found, assuming x y z') - tau(:)=inp(:) - END IF - END IF - - END SUBROUTINE wypos + END SUBROUTINE wypos_230 END MODULE