lukasplevac/easyconfigs-it4i
1
0
Fork 0
mirror of https://code.it4i.cz/sccs/easyconfigs-it4i.git synced 2025-04-16 03:38:05 +01:00
Code Issues Packages Projects Releases Wiki Activity
easyconfigs-it4i/m/MRCC/mrcc_files/rearrsubs.f
Lukas Krupcik eb1ea94130 merge master
2024-07-25 10:27:17 +02:00

8223 lines
241 KiB
Fortran
Executable File
Raw Blame History

************************************************************************
* Rearrange ERI derivatives for sphersubs.f subroutines
************************************************************************
************************************************************************
subroutine rearrdummy(to,from)
************************************************************************
* Called when no rearrange is necessary for ERI derivatives befor th
* e solid harmonic trf. of the differentiated function
************************************************************************
implicit none
real*8 to(*),from(*)
end
************************************************************************
************************************************************************
subroutine pp_to_pp_5_1(to,from)
************************************************************************
* Rearrange pp_to_pp_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(9),from(9)
do ii=1,3
do kk=1,3
to(kk+(ii-1)*3)=from(ii+(kk-1)*3)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dp_to_pd_5_1(to,from)
************************************************************************
* Rearrange dp_to_pd_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(15),from(15)
do ii=1,3
do kk=1,5
to(kk+(ii-1)*5)=from(ii+(kk-1)*3)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fp_to_pf_5_1(to,from)
************************************************************************
* Rearrange fp_to_pf_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(21),from(21)
do ii=1,3
do kk=1,7
to(kk+(ii-1)*7)=from(ii+(kk-1)*3)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gp_to_pg_5_1(to,from)
************************************************************************
* Rearrange gp_to_pg_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(27),from(27)
do ii=1,3
do kk=1,9
to(kk+(ii-1)*9)=from(ii+(kk-1)*3)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hp_to_ph_5_1(to,from)
************************************************************************
* Rearrange hp_to_ph_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(33),from(33)
do ii=1,3
do kk=1,11
to(kk+(ii-1)*11)=from(ii+(kk-1)*3)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ip_to_pi_5_1(to,from)
************************************************************************
* Rearrange ip_to_pi_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(39),from(39)
do ii=1,3
do kk=1,13
to(kk+(ii-1)*13)=from(ii+(kk-1)*3)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pd_to_dp_5_1(to,from)
************************************************************************
* Rearrange pd_to_dp_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(18),from(18)
do ii=1,6
do kk=1,3
to(kk+(ii-1)*3)=from(ii+(kk-1)*6)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dd_to_dd_5_1(to,from)
************************************************************************
* Rearrange dd_to_dd_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(30),from(30)
do ii=1,6
do kk=1,5
to(kk+(ii-1)*5)=from(ii+(kk-1)*6)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fd_to_df_5_1(to,from)
************************************************************************
* Rearrange fd_to_df_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(42),from(42)
do ii=1,6
do kk=1,7
to(kk+(ii-1)*7)=from(ii+(kk-1)*6)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gd_to_dg_5_1(to,from)
************************************************************************
* Rearrange gd_to_dg_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(54),from(54)
do ii=1,6
do kk=1,9
to(kk+(ii-1)*9)=from(ii+(kk-1)*6)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hd_to_dh_5_1(to,from)
************************************************************************
* Rearrange hd_to_dh_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(66),from(66)
do ii=1,6
do kk=1,11
to(kk+(ii-1)*11)=from(ii+(kk-1)*6)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine id_to_di_5_1(to,from)
************************************************************************
* Rearrange id_to_di_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(78),from(78)
do ii=1,6
do kk=1,13
to(kk+(ii-1)*13)=from(ii+(kk-1)*6)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pd_to_dp_3_1(to,from)
************************************************************************
* Rearrange pd_to_dp_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(18),from(18)
do ii=1,6
do jj=1,3
to(1+(ii-1)*3+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pdp_to_dpp_3_1(to,from)
************************************************************************
* Rearrange pdp_to_dpp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(54),from(54)
do ii=1,6
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from((ii-1)*3+(jj-1)*18+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pdd_to_dpd_3_1(to,from)
************************************************************************
* Rearrange pdd_to_dpd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(90),from(90)
do ii=1,6
do jj=1,3
do kk=1,5
to(kk+(ii-1)*15+(jj-1)*5)=from((ii-1)*5+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pdf_to_dpf_3_1(to,from)
************************************************************************
* Rearrange pdf_to_dpf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(126),from(126)
do ii=1,6
do jj=1,3
do kk=1,7
to(kk+(ii-1)*21+(jj-1)*7)=from((ii-1)*7+(jj-1)*42+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pdg_to_dpg_3_1(to,from)
************************************************************************
* Rearrange pdg_to_dpg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(162),from(162)
do ii=1,6
do jj=1,3
do kk=1,9
to(kk+(ii-1)*27+(jj-1)*9)=from((ii-1)*9+(jj-1)*54+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pdh_to_dph_3_1(to,from)
************************************************************************
* Rearrange pdh_to_dph_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(198),from(198)
do ii=1,6
do jj=1,3
do kk=1,11
to(kk+(ii-1)*33+(jj-1)*11)=from((ii-1)*11+(jj-1)*66+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pdi_to_dpi_3_1(to,from)
************************************************************************
* Rearrange pdi_to_dpi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(234),from(234)
do ii=1,6
do jj=1,3
do kk=1,13
to(kk+(ii-1)*39+(jj-1)*13)=from((ii-1)*13+(jj-1)*78+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pf_to_fp_5_1(to,from)
************************************************************************
* Rearrange pf_to_fp_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(30),from(30)
do ii=1,10
do kk=1,3
to(kk+(ii-1)*3)=from(ii+(kk-1)*10)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine df_to_fd_5_1(to,from)
************************************************************************
* Rearrange df_to_fd_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(50),from(50)
do ii=1,10
do kk=1,5
to(kk+(ii-1)*5)=from(ii+(kk-1)*10)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ff_to_ff_5_1(to,from)
************************************************************************
* Rearrange ff_to_ff_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(70),from(70)
do ii=1,10
do kk=1,7
to(kk+(ii-1)*7)=from(ii+(kk-1)*10)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gf_to_fg_5_1(to,from)
************************************************************************
* Rearrange gf_to_fg_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(90),from(90)
do ii=1,10
do kk=1,9
to(kk+(ii-1)*9)=from(ii+(kk-1)*10)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hf_to_fh_5_1(to,from)
************************************************************************
* Rearrange hf_to_fh_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(110),from(110)
do ii=1,10
do kk=1,11
to(kk+(ii-1)*11)=from(ii+(kk-1)*10)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine if_to_fi_5_1(to,from)
************************************************************************
* Rearrange if_to_fi_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(130),from(130)
do ii=1,10
do kk=1,13
to(kk+(ii-1)*13)=from(ii+(kk-1)*10)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pf_to_fp_3_1(to,from)
************************************************************************
* Rearrange pf_to_fp_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(30),from(30)
do ii=1,10
do jj=1,3
to(1+(ii-1)*3+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pfp_to_fpp_3_1(to,from)
************************************************************************
* Rearrange pfp_to_fpp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(90),from(90)
do ii=1,10
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from((ii-1)*3+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pfd_to_fpd_3_1(to,from)
************************************************************************
* Rearrange pfd_to_fpd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(150),from(150)
do ii=1,10
do jj=1,3
do kk=1,5
to(kk+(ii-1)*15+(jj-1)*5)=from((ii-1)*5+(jj-1)*50+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pff_to_fpf_3_1(to,from)
************************************************************************
* Rearrange pff_to_fpf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(210),from(210)
do ii=1,10
do jj=1,3
do kk=1,7
to(kk+(ii-1)*21+(jj-1)*7)=from((ii-1)*7+(jj-1)*70+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pfg_to_fpg_3_1(to,from)
************************************************************************
* Rearrange pfg_to_fpg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(270),from(270)
do ii=1,10
do jj=1,3
do kk=1,9
to(kk+(ii-1)*27+(jj-1)*9)=from((ii-1)*9+(jj-1)*90+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pfh_to_fph_3_1(to,from)
************************************************************************
* Rearrange pfh_to_fph_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(330),from(330)
do ii=1,10
do jj=1,3
do kk=1,11
to(kk+(ii-1)*33+(jj-1)*11)=from((ii-1)*11+(jj-1)*110+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pfi_to_fpi_3_1(to,from)
************************************************************************
* Rearrange pfi_to_fpi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(390),from(390)
do ii=1,10
do jj=1,3
do kk=1,13
to(kk+(ii-1)*39+(jj-1)*13)=from((ii-1)*13+(jj-1)*130+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine df_to_fd_3_1(to,from)
************************************************************************
* Rearrange df_to_fd_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(50),from(50)
do ii=1,10
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfp_to_fdp_3_1(to,from)
************************************************************************
* Rearrange dfp_to_fdp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(150),from(150)
do ii=1,10
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from((ii-1)*3+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfd_to_fdd_3_1(to,from)
************************************************************************
* Rearrange dfd_to_fdd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(250),from(250)
do ii=1,10
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from((ii-1)*5+(jj-1)*50+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dff_to_fdf_3_1(to,from)
************************************************************************
* Rearrange dff_to_fdf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(350),from(350)
do ii=1,10
do jj=1,5
do kk=1,7
to(kk+(ii-1)*35+(jj-1)*7)=from((ii-1)*7+(jj-1)*70+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfg_to_fdg_3_1(to,from)
************************************************************************
* Rearrange dfg_to_fdg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(450),from(450)
do ii=1,10
do jj=1,5
do kk=1,9
to(kk+(ii-1)*45+(jj-1)*9)=from((ii-1)*9+(jj-1)*90+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfh_to_fdh_3_1(to,from)
************************************************************************
* Rearrange dfh_to_fdh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(550),from(550)
do ii=1,10
do jj=1,5
do kk=1,11
to(kk+(ii-1)*55+(jj-1)*11)=from((ii-1)*11+(jj-1)*110+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfi_to_fdi_3_1(to,from)
************************************************************************
* Rearrange dfi_to_fdi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(650),from(650)
do ii=1,10
do jj=1,5
do kk=1,13
to(kk+(ii-1)*65+(jj-1)*13)=from((ii-1)*13+(jj-1)*130+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pg_to_gp_5_1(to,from)
************************************************************************
* Rearrange pg_to_gp_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(45),from(45)
do ii=1,15
do kk=1,3
to(kk+(ii-1)*3)=from(ii+(kk-1)*15)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dg_to_gd_5_1(to,from)
************************************************************************
* Rearrange dg_to_gd_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(75),from(75)
do ii=1,15
do kk=1,5
to(kk+(ii-1)*5)=from(ii+(kk-1)*15)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fg_to_gf_5_1(to,from)
************************************************************************
* Rearrange fg_to_gf_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(105),from(105)
do ii=1,15
do kk=1,7
to(kk+(ii-1)*7)=from(ii+(kk-1)*15)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gg_to_gg_5_1(to,from)
************************************************************************
* Rearrange gg_to_gg_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(135),from(135)
do ii=1,15
do kk=1,9
to(kk+(ii-1)*9)=from(ii+(kk-1)*15)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hg_to_gh_5_1(to,from)
************************************************************************
* Rearrange hg_to_gh_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(165),from(165)
do ii=1,15
do kk=1,11
to(kk+(ii-1)*11)=from(ii+(kk-1)*15)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ig_to_gi_5_1(to,from)
************************************************************************
* Rearrange ig_to_gi_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(195),from(195)
do ii=1,15
do kk=1,13
to(kk+(ii-1)*13)=from(ii+(kk-1)*15)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pg_to_gp_3_1(to,from)
************************************************************************
* Rearrange pg_to_gp_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(45),from(45)
do ii=1,15
do jj=1,3
to(1+(ii-1)*3+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pgp_to_gpp_3_1(to,from)
************************************************************************
* Rearrange pgp_to_gpp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(135),from(135)
do ii=1,15
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from((ii-1)*3+(jj-1)*45+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pgd_to_gpd_3_1(to,from)
************************************************************************
* Rearrange pgd_to_gpd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(225),from(225)
do ii=1,15
do jj=1,3
do kk=1,5
to(kk+(ii-1)*15+(jj-1)*5)=from((ii-1)*5+(jj-1)*75+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pgf_to_gpf_3_1(to,from)
************************************************************************
* Rearrange pgf_to_gpf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(315),from(315)
do ii=1,15
do jj=1,3
do kk=1,7
to(kk+(ii-1)*21+(jj-1)*7)=from((ii-1)*7+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pgg_to_gpg_3_1(to,from)
************************************************************************
* Rearrange pgg_to_gpg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(405),from(405)
do ii=1,15
do jj=1,3
do kk=1,9
to(kk+(ii-1)*27+(jj-1)*9)=from((ii-1)*9+(jj-1)*135+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pgh_to_gph_3_1(to,from)
************************************************************************
* Rearrange pgh_to_gph_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(495),from(495)
do ii=1,15
do jj=1,3
do kk=1,11
to(kk+(ii-1)*33+(jj-1)*11)=from((ii-1)*11+(jj-1)*165+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pgi_to_gpi_3_1(to,from)
************************************************************************
* Rearrange pgi_to_gpi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(585),from(585)
do ii=1,15
do jj=1,3
do kk=1,13
to(kk+(ii-1)*39+(jj-1)*13)=from((ii-1)*13+(jj-1)*195+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dg_to_gd_3_1(to,from)
************************************************************************
* Rearrange dg_to_gd_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(75),from(75)
do ii=1,15
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dgp_to_gdp_3_1(to,from)
************************************************************************
* Rearrange dgp_to_gdp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(225),from(225)
do ii=1,15
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from((ii-1)*3+(jj-1)*45+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dgd_to_gdd_3_1(to,from)
************************************************************************
* Rearrange dgd_to_gdd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(375),from(375)
do ii=1,15
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from((ii-1)*5+(jj-1)*75+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dgf_to_gdf_3_1(to,from)
************************************************************************
* Rearrange dgf_to_gdf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(525),from(525)
do ii=1,15
do jj=1,5
do kk=1,7
to(kk+(ii-1)*35+(jj-1)*7)=from((ii-1)*7+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dgg_to_gdg_3_1(to,from)
************************************************************************
* Rearrange dgg_to_gdg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(675),from(675)
do ii=1,15
do jj=1,5
do kk=1,9
to(kk+(ii-1)*45+(jj-1)*9)=from((ii-1)*9+(jj-1)*135+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dgh_to_gdh_3_1(to,from)
************************************************************************
* Rearrange dgh_to_gdh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(825),from(825)
do ii=1,15
do jj=1,5
do kk=1,11
to(kk+(ii-1)*55+(jj-1)*11)=from((ii-1)*11+(jj-1)*165+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dgi_to_gdi_3_1(to,from)
************************************************************************
* Rearrange dgi_to_gdi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(975),from(975)
do ii=1,15
do jj=1,5
do kk=1,13
to(kk+(ii-1)*65+(jj-1)*13)=from((ii-1)*13+(jj-1)*195+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fg_to_gf_3_1(to,from)
************************************************************************
* Rearrange fg_to_gf_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(105),from(105)
do ii=1,15
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgp_to_gfp_3_1(to,from)
************************************************************************
* Rearrange fgp_to_gfp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(315),from(315)
do ii=1,15
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from((ii-1)*3+(jj-1)*45+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgd_to_gfd_3_1(to,from)
************************************************************************
* Rearrange fgd_to_gfd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(525),from(525)
do ii=1,15
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from((ii-1)*5+(jj-1)*75+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgf_to_gff_3_1(to,from)
************************************************************************
* Rearrange fgf_to_gff_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(735),from(735)
do ii=1,15
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from((ii-1)*7+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgg_to_gfg_3_1(to,from)
************************************************************************
* Rearrange fgg_to_gfg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,15
do jj=1,7
do kk=1,9
to(kk+(ii-1)*63+(jj-1)*9)=from((ii-1)*9+(jj-1)*135+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgh_to_gfh_3_1(to,from)
************************************************************************
* Rearrange fgh_to_gfh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1155),from(1155)
do ii=1,15
do jj=1,7
do kk=1,11
to(kk+(ii-1)*77+(jj-1)*11)=from((ii-1)*11+(jj-1)*165+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgi_to_gfi_3_1(to,from)
************************************************************************
* Rearrange fgi_to_gfi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1365),from(1365)
do ii=1,15
do jj=1,7
do kk=1,13
to(kk+(ii-1)*91+(jj-1)*13)=from((ii-1)*13+(jj-1)*195+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ph_to_hp_5_1(to,from)
************************************************************************
* Rearrange ph_to_hp_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(63),from(63)
do ii=1,21
do kk=1,3
to(kk+(ii-1)*3)=from(ii+(kk-1)*21)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dh_to_hd_5_1(to,from)
************************************************************************
* Rearrange dh_to_hd_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(105),from(105)
do ii=1,21
do kk=1,5
to(kk+(ii-1)*5)=from(ii+(kk-1)*21)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fh_to_hf_5_1(to,from)
************************************************************************
* Rearrange fh_to_hf_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(147),from(147)
do ii=1,21
do kk=1,7
to(kk+(ii-1)*7)=from(ii+(kk-1)*21)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gh_to_hg_5_1(to,from)
************************************************************************
* Rearrange gh_to_hg_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(189),from(189)
do ii=1,21
do kk=1,9
to(kk+(ii-1)*9)=from(ii+(kk-1)*21)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hh_to_hh_5_1(to,from)
************************************************************************
* Rearrange hh_to_hh_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(231),from(231)
do ii=1,21
do kk=1,11
to(kk+(ii-1)*11)=from(ii+(kk-1)*21)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ih_to_hi_5_1(to,from)
************************************************************************
* Rearrange ih_to_hi_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(273),from(273)
do ii=1,21
do kk=1,13
to(kk+(ii-1)*13)=from(ii+(kk-1)*21)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ph_to_hp_3_1(to,from)
************************************************************************
* Rearrange ph_to_hp_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(63),from(63)
do ii=1,21
do jj=1,3
to(1+(ii-1)*3+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine php_to_hpp_3_1(to,from)
************************************************************************
* Rearrange php_to_hpp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(189),from(189)
do ii=1,21
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from((ii-1)*3+(jj-1)*63+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine phd_to_hpd_3_1(to,from)
************************************************************************
* Rearrange phd_to_hpd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(315),from(315)
do ii=1,21
do jj=1,3
do kk=1,5
to(kk+(ii-1)*15+(jj-1)*5)=from((ii-1)*5+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine phf_to_hpf_3_1(to,from)
************************************************************************
* Rearrange phf_to_hpf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(441),from(441)
do ii=1,21
do jj=1,3
do kk=1,7
to(kk+(ii-1)*21+(jj-1)*7)=from((ii-1)*7+(jj-1)*147+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine phg_to_hpg_3_1(to,from)
************************************************************************
* Rearrange phg_to_hpg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(567),from(567)
do ii=1,21
do jj=1,3
do kk=1,9
to(kk+(ii-1)*27+(jj-1)*9)=from((ii-1)*9+(jj-1)*189+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine phh_to_hph_3_1(to,from)
************************************************************************
* Rearrange phh_to_hph_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(693),from(693)
do ii=1,21
do jj=1,3
do kk=1,11
to(kk+(ii-1)*33+(jj-1)*11)=from((ii-1)*11+(jj-1)*231+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine phi_to_hpi_3_1(to,from)
************************************************************************
* Rearrange phi_to_hpi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(819),from(819)
do ii=1,21
do jj=1,3
do kk=1,13
to(kk+(ii-1)*39+(jj-1)*13)=from((ii-1)*13+(jj-1)*273+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dh_to_hd_3_1(to,from)
************************************************************************
* Rearrange dh_to_hd_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(105),from(105)
do ii=1,21
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dhp_to_hdp_3_1(to,from)
************************************************************************
* Rearrange dhp_to_hdp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(315),from(315)
do ii=1,21
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from((ii-1)*3+(jj-1)*63+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dhd_to_hdd_3_1(to,from)
************************************************************************
* Rearrange dhd_to_hdd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(525),from(525)
do ii=1,21
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from((ii-1)*5+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dhf_to_hdf_3_1(to,from)
************************************************************************
* Rearrange dhf_to_hdf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(735),from(735)
do ii=1,21
do jj=1,5
do kk=1,7
to(kk+(ii-1)*35+(jj-1)*7)=from((ii-1)*7+(jj-1)*147+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dhg_to_hdg_3_1(to,from)
************************************************************************
* Rearrange dhg_to_hdg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,21
do jj=1,5
do kk=1,9
to(kk+(ii-1)*45+(jj-1)*9)=from((ii-1)*9+(jj-1)*189+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dhh_to_hdh_3_1(to,from)
************************************************************************
* Rearrange dhh_to_hdh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1155),from(1155)
do ii=1,21
do jj=1,5
do kk=1,11
to(kk+(ii-1)*55+(jj-1)*11)=from((ii-1)*11+(jj-1)*231+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dhi_to_hdi_3_1(to,from)
************************************************************************
* Rearrange dhi_to_hdi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1365),from(1365)
do ii=1,21
do jj=1,5
do kk=1,13
to(kk+(ii-1)*65+(jj-1)*13)=from((ii-1)*13+(jj-1)*273+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fh_to_hf_3_1(to,from)
************************************************************************
* Rearrange fh_to_hf_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(147),from(147)
do ii=1,21
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fhp_to_hfp_3_1(to,from)
************************************************************************
* Rearrange fhp_to_hfp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(441),from(441)
do ii=1,21
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from((ii-1)*3+(jj-1)*63+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fhd_to_hfd_3_1(to,from)
************************************************************************
* Rearrange fhd_to_hfd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(735),from(735)
do ii=1,21
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from((ii-1)*5+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fhf_to_hff_3_1(to,from)
************************************************************************
* Rearrange fhf_to_hff_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1029),from(1029)
do ii=1,21
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from((ii-1)*7+(jj-1)*147+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fhg_to_hfg_3_1(to,from)
************************************************************************
* Rearrange fhg_to_hfg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1323),from(1323)
do ii=1,21
do jj=1,7
do kk=1,9
to(kk+(ii-1)*63+(jj-1)*9)=from((ii-1)*9+(jj-1)*189+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fhh_to_hfh_3_1(to,from)
************************************************************************
* Rearrange fhh_to_hfh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1617),from(1617)
do ii=1,21
do jj=1,7
do kk=1,11
to(kk+(ii-1)*77+(jj-1)*11)=from((ii-1)*11+(jj-1)*231+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fhi_to_hfi_3_1(to,from)
************************************************************************
* Rearrange fhi_to_hfi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1911),from(1911)
do ii=1,21
do jj=1,7
do kk=1,13
to(kk+(ii-1)*91+(jj-1)*13)=from((ii-1)*13+(jj-1)*273+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gh_to_hg_3_1(to,from)
************************************************************************
* Rearrange gh_to_hg_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(189),from(189)
do ii=1,21
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghp_to_hgp_3_1(to,from)
************************************************************************
* Rearrange ghp_to_hgp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(567),from(567)
do ii=1,21
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from((ii-1)*3+(jj-1)*63+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghd_to_hgd_3_1(to,from)
************************************************************************
* Rearrange ghd_to_hgd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,21
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from((ii-1)*5+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghf_to_hgf_3_1(to,from)
************************************************************************
* Rearrange ghf_to_hgf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1323),from(1323)
do ii=1,21
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from((ii-1)*7+(jj-1)*147+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghg_to_hgg_3_1(to,from)
************************************************************************
* Rearrange ghg_to_hgg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1701),from(1701)
do ii=1,21
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from((ii-1)*9+(jj-1)*189+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghh_to_hgh_3_1(to,from)
************************************************************************
* Rearrange ghh_to_hgh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2079),from(2079)
do ii=1,21
do jj=1,9
do kk=1,11
to(kk+(ii-1)*99+(jj-1)*11)=from((ii-1)*11+(jj-1)*231+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghi_to_hgi_3_1(to,from)
************************************************************************
* Rearrange ghi_to_hgi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2457),from(2457)
do ii=1,21
do jj=1,9
do kk=1,13
to(kk+(ii-1)*117+(jj-1)*13)=from((ii-1)*13+(jj-1)*273+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pi_to_ip_5_1(to,from)
************************************************************************
* Rearrange pi_to_ip_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(84),from(84)
do ii=1,28
do kk=1,3
to(kk+(ii-1)*3)=from(ii+(kk-1)*28)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine di_to_id_5_1(to,from)
************************************************************************
* Rearrange di_to_id_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(140),from(140)
do ii=1,28
do kk=1,5
to(kk+(ii-1)*5)=from(ii+(kk-1)*28)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fi_to_if_5_1(to,from)
************************************************************************
* Rearrange fi_to_if_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(196),from(196)
do ii=1,28
do kk=1,7
to(kk+(ii-1)*7)=from(ii+(kk-1)*28)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gi_to_ig_5_1(to,from)
************************************************************************
* Rearrange gi_to_ig_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(252),from(252)
do ii=1,28
do kk=1,9
to(kk+(ii-1)*9)=from(ii+(kk-1)*28)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hi_to_ih_5_1(to,from)
************************************************************************
* Rearrange hi_to_ih_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(308),from(308)
do ii=1,28
do kk=1,11
to(kk+(ii-1)*11)=from(ii+(kk-1)*28)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ii_to_ii_5_1(to,from)
************************************************************************
* Rearrange ii_to_ii_5_1
************************************************************************
implicit none
integer ii,kk
real*8 to(364),from(364)
do ii=1,28
do kk=1,13
to(kk+(ii-1)*13)=from(ii+(kk-1)*28)
enddo ! kk
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pi_to_ip_3_1(to,from)
************************************************************************
* Rearrange pi_to_ip_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(84),from(84)
do ii=1,28
do jj=1,3
to(1+(ii-1)*3+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pip_to_ipp_3_1(to,from)
************************************************************************
* Rearrange pip_to_ipp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(252),from(252)
do ii=1,28
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from((ii-1)*3+(jj-1)*84+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pid_to_ipd_3_1(to,from)
************************************************************************
* Rearrange pid_to_ipd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(420),from(420)
do ii=1,28
do jj=1,3
do kk=1,5
to(kk+(ii-1)*15+(jj-1)*5)=from((ii-1)*5+(jj-1)*140+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pif_to_ipf_3_1(to,from)
************************************************************************
* Rearrange pif_to_ipf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(588),from(588)
do ii=1,28
do jj=1,3
do kk=1,7
to(kk+(ii-1)*21+(jj-1)*7)=from((ii-1)*7+(jj-1)*196+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pig_to_ipg_3_1(to,from)
************************************************************************
* Rearrange pig_to_ipg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(756),from(756)
do ii=1,28
do jj=1,3
do kk=1,9
to(kk+(ii-1)*27+(jj-1)*9)=from((ii-1)*9+(jj-1)*252+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pih_to_iph_3_1(to,from)
************************************************************************
* Rearrange pih_to_iph_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(924),from(924)
do ii=1,28
do jj=1,3
do kk=1,11
to(kk+(ii-1)*33+(jj-1)*11)=from((ii-1)*11+(jj-1)*308+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pii_to_ipi_3_1(to,from)
************************************************************************
* Rearrange pii_to_ipi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1092),from(1092)
do ii=1,28
do jj=1,3
do kk=1,13
to(kk+(ii-1)*39+(jj-1)*13)=from((ii-1)*13+(jj-1)*364+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine di_to_id_3_1(to,from)
************************************************************************
* Rearrange di_to_id_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(140),from(140)
do ii=1,28
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dip_to_idp_3_1(to,from)
************************************************************************
* Rearrange dip_to_idp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(420),from(420)
do ii=1,28
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from((ii-1)*3+(jj-1)*84+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine did_to_idd_3_1(to,from)
************************************************************************
* Rearrange did_to_idd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(700),from(700)
do ii=1,28
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from((ii-1)*5+(jj-1)*140+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dif_to_idf_3_1(to,from)
************************************************************************
* Rearrange dif_to_idf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(980),from(980)
do ii=1,28
do jj=1,5
do kk=1,7
to(kk+(ii-1)*35+(jj-1)*7)=from((ii-1)*7+(jj-1)*196+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dig_to_idg_3_1(to,from)
************************************************************************
* Rearrange dig_to_idg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1260),from(1260)
do ii=1,28
do jj=1,5
do kk=1,9
to(kk+(ii-1)*45+(jj-1)*9)=from((ii-1)*9+(jj-1)*252+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dih_to_idh_3_1(to,from)
************************************************************************
* Rearrange dih_to_idh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1540),from(1540)
do ii=1,28
do jj=1,5
do kk=1,11
to(kk+(ii-1)*55+(jj-1)*11)=from((ii-1)*11+(jj-1)*308+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dii_to_idi_3_1(to,from)
************************************************************************
* Rearrange dii_to_idi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1820),from(1820)
do ii=1,28
do jj=1,5
do kk=1,13
to(kk+(ii-1)*65+(jj-1)*13)=from((ii-1)*13+(jj-1)*364+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fi_to_if_3_1(to,from)
************************************************************************
* Rearrange fi_to_if_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(196),from(196)
do ii=1,28
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fip_to_ifp_3_1(to,from)
************************************************************************
* Rearrange fip_to_ifp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(588),from(588)
do ii=1,28
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from((ii-1)*3+(jj-1)*84+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fid_to_ifd_3_1(to,from)
************************************************************************
* Rearrange fid_to_ifd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(980),from(980)
do ii=1,28
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from((ii-1)*5+(jj-1)*140+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fif_to_iff_3_1(to,from)
************************************************************************
* Rearrange fif_to_iff_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1372),from(1372)
do ii=1,28
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from((ii-1)*7+(jj-1)*196+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fig_to_ifg_3_1(to,from)
************************************************************************
* Rearrange fig_to_ifg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1764),from(1764)
do ii=1,28
do jj=1,7
do kk=1,9
to(kk+(ii-1)*63+(jj-1)*9)=from((ii-1)*9+(jj-1)*252+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fih_to_ifh_3_1(to,from)
************************************************************************
* Rearrange fih_to_ifh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2156),from(2156)
do ii=1,28
do jj=1,7
do kk=1,11
to(kk+(ii-1)*77+(jj-1)*11)=from((ii-1)*11+(jj-1)*308+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fii_to_ifi_3_1(to,from)
************************************************************************
* Rearrange fii_to_ifi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2548),from(2548)
do ii=1,28
do jj=1,7
do kk=1,13
to(kk+(ii-1)*91+(jj-1)*13)=from((ii-1)*13+(jj-1)*364+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gi_to_ig_3_1(to,from)
************************************************************************
* Rearrange gi_to_ig_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(252),from(252)
do ii=1,28
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gip_to_igp_3_1(to,from)
************************************************************************
* Rearrange gip_to_igp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(756),from(756)
do ii=1,28
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from((ii-1)*3+(jj-1)*84+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gid_to_igd_3_1(to,from)
************************************************************************
* Rearrange gid_to_igd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1260),from(1260)
do ii=1,28
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from((ii-1)*5+(jj-1)*140+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gif_to_igf_3_1(to,from)
************************************************************************
* Rearrange gif_to_igf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1764),from(1764)
do ii=1,28
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from((ii-1)*7+(jj-1)*196+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gig_to_igg_3_1(to,from)
************************************************************************
* Rearrange gig_to_igg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2268),from(2268)
do ii=1,28
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from((ii-1)*9+(jj-1)*252+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gih_to_igh_3_1(to,from)
************************************************************************
* Rearrange gih_to_igh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2772),from(2772)
do ii=1,28
do jj=1,9
do kk=1,11
to(kk+(ii-1)*99+(jj-1)*11)=from((ii-1)*11+(jj-1)*308+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gii_to_igi_3_1(to,from)
************************************************************************
* Rearrange gii_to_igi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(3276),from(3276)
do ii=1,28
do jj=1,9
do kk=1,13
to(kk+(ii-1)*117+(jj-1)*13)=from((ii-1)*13+(jj-1)*364+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hi_to_ih_3_1(to,from)
************************************************************************
* Rearrange hi_to_ih_3_1
************************************************************************
implicit none
integer ii,jj
real*8 to(308),from(308)
do ii=1,28
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hip_to_ihp_3_1(to,from)
************************************************************************
* Rearrange hip_to_ihp_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(924),from(924)
do ii=1,28
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from((ii-1)*3+(jj-1)*84+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hid_to_ihd_3_1(to,from)
************************************************************************
* Rearrange hid_to_ihd_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1540),from(1540)
do ii=1,28
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from((ii-1)*5+(jj-1)*140+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hif_to_ihf_3_1(to,from)
************************************************************************
* Rearrange hif_to_ihf_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2156),from(2156)
do ii=1,28
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from((ii-1)*7+(jj-1)*196+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hig_to_ihg_3_1(to,from)
************************************************************************
* Rearrange hig_to_ihg_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2772),from(2772)
do ii=1,28
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from((ii-1)*9+(jj-1)*252+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hih_to_ihh_3_1(to,from)
************************************************************************
* Rearrange hih_to_ihh_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(3388),from(3388)
do ii=1,28
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from((ii-1)*11+(jj-1)*308+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hii_to_ihi_3_1(to,from)
************************************************************************
* Rearrange hii_to_ihi_3_1
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(4004),from(4004)
do ii=1,28
do jj=1,11
do kk=1,13
to(kk+(ii-1)*143+(jj-1)*13)=from((ii-1)*13+(jj-1)*364+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dp_to_pd_1_3(to,from)
************************************************************************
* Rearrange dp_to_pd_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(15),from(15)
do ii=1,3
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpp_to_pdp_1_3(to,from)
************************************************************************
* Rearrange dpp_to_pdp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(45),from(45)
do ii=1,3
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from((ii-1)*3+(jj-1)*9+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpd_to_pdd_1_3(to,from)
************************************************************************
* Rearrange dpd_to_pdd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(75),from(75)
do ii=1,3
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from((ii-1)*5+(jj-1)*15+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpf_to_pdf_1_3(to,from)
************************************************************************
* Rearrange dpf_to_pdf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(105),from(105)
do ii=1,3
do jj=1,5
do kk=1,7
to(kk+(ii-1)*35+(jj-1)*7)=from((ii-1)*7+(jj-1)*21+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpg_to_pdg_1_3(to,from)
************************************************************************
* Rearrange dpg_to_pdg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(135),from(135)
do ii=1,3
do jj=1,5
do kk=1,9
to(kk+(ii-1)*45+(jj-1)*9)=from((ii-1)*9+(jj-1)*27+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dph_to_pdh_1_3(to,from)
************************************************************************
* Rearrange dph_to_pdh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(165),from(165)
do ii=1,3
do jj=1,5
do kk=1,11
to(kk+(ii-1)*55+(jj-1)*11)=from((ii-1)*11+(jj-1)*33+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpi_to_pdi_1_3(to,from)
************************************************************************
* Rearrange dpi_to_pdi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(195),from(195)
do ii=1,3
do jj=1,5
do kk=1,13
to(kk+(ii-1)*65+(jj-1)*13)=from((ii-1)*13+(jj-1)*39+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dd_to_dd_1_3(to,from)
************************************************************************
* Rearrange dd_to_dd_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(30),from(30)
do ii=1,6
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddp_to_ddp_1_3(to,from)
************************************************************************
* Rearrange ddp_to_ddp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(90),from(90)
do ii=1,6
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from((ii-1)*3+(jj-1)*18+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddd_to_ddd_1_3(to,from)
************************************************************************
* Rearrange ddd_to_ddd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(150),from(150)
do ii=1,6
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from((ii-1)*5+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddf_to_ddf_1_3(to,from)
************************************************************************
* Rearrange ddf_to_ddf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(210),from(210)
do ii=1,6
do jj=1,5
do kk=1,7
to(kk+(ii-1)*35+(jj-1)*7)=from((ii-1)*7+(jj-1)*42+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddg_to_ddg_1_3(to,from)
************************************************************************
* Rearrange ddg_to_ddg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(270),from(270)
do ii=1,6
do jj=1,5
do kk=1,9
to(kk+(ii-1)*45+(jj-1)*9)=from((ii-1)*9+(jj-1)*54+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddh_to_ddh_1_3(to,from)
************************************************************************
* Rearrange ddh_to_ddh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(330),from(330)
do ii=1,6
do jj=1,5
do kk=1,11
to(kk+(ii-1)*55+(jj-1)*11)=from((ii-1)*11+(jj-1)*66+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddi_to_ddi_1_3(to,from)
************************************************************************
* Rearrange ddi_to_ddi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(390),from(390)
do ii=1,6
do jj=1,5
do kk=1,13
to(kk+(ii-1)*65+(jj-1)*13)=from((ii-1)*13+(jj-1)*78+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine df_to_fd_1_3(to,from)
************************************************************************
* Rearrange df_to_fd_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(50),from(50)
do ii=1,10
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfp_to_fdp_1_3(to,from)
************************************************************************
* Rearrange dfp_to_fdp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(150),from(150)
do ii=1,10
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from((ii-1)*3+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfd_to_fdd_1_3(to,from)
************************************************************************
* Rearrange dfd_to_fdd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(250),from(250)
do ii=1,10
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from((ii-1)*5+(jj-1)*50+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dff_to_fdf_1_3(to,from)
************************************************************************
* Rearrange dff_to_fdf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(350),from(350)
do ii=1,10
do jj=1,5
do kk=1,7
to(kk+(ii-1)*35+(jj-1)*7)=from((ii-1)*7+(jj-1)*70+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfg_to_fdg_1_3(to,from)
************************************************************************
* Rearrange dfg_to_fdg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(450),from(450)
do ii=1,10
do jj=1,5
do kk=1,9
to(kk+(ii-1)*45+(jj-1)*9)=from((ii-1)*9+(jj-1)*90+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfh_to_fdh_1_3(to,from)
************************************************************************
* Rearrange dfh_to_fdh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(550),from(550)
do ii=1,10
do jj=1,5
do kk=1,11
to(kk+(ii-1)*55+(jj-1)*11)=from((ii-1)*11+(jj-1)*110+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dfi_to_fdi_1_3(to,from)
************************************************************************
* Rearrange dfi_to_fdi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(650),from(650)
do ii=1,10
do jj=1,5
do kk=1,13
to(kk+(ii-1)*65+(jj-1)*13)=from((ii-1)*13+(jj-1)*130+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fp_to_pf_1_3(to,from)
************************************************************************
* Rearrange fp_to_pf_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(21),from(21)
do ii=1,3
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpp_to_pfp_1_3(to,from)
************************************************************************
* Rearrange fpp_to_pfp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(63),from(63)
do ii=1,3
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from((ii-1)*3+(jj-1)*9+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpd_to_pfd_1_3(to,from)
************************************************************************
* Rearrange fpd_to_pfd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(105),from(105)
do ii=1,3
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from((ii-1)*5+(jj-1)*15+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpf_to_pff_1_3(to,from)
************************************************************************
* Rearrange fpf_to_pff_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(147),from(147)
do ii=1,3
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from((ii-1)*7+(jj-1)*21+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpg_to_pfg_1_3(to,from)
************************************************************************
* Rearrange fpg_to_pfg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(189),from(189)
do ii=1,3
do jj=1,7
do kk=1,9
to(kk+(ii-1)*63+(jj-1)*9)=from((ii-1)*9+(jj-1)*27+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fph_to_pfh_1_3(to,from)
************************************************************************
* Rearrange fph_to_pfh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(231),from(231)
do ii=1,3
do jj=1,7
do kk=1,11
to(kk+(ii-1)*77+(jj-1)*11)=from((ii-1)*11+(jj-1)*33+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpi_to_pfi_1_3(to,from)
************************************************************************
* Rearrange fpi_to_pfi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(273),from(273)
do ii=1,3
do jj=1,7
do kk=1,13
to(kk+(ii-1)*91+(jj-1)*13)=from((ii-1)*13+(jj-1)*39+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fd_to_df_1_3(to,from)
************************************************************************
* Rearrange fd_to_df_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(42),from(42)
do ii=1,6
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdp_to_dfp_1_3(to,from)
************************************************************************
* Rearrange fdp_to_dfp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(126),from(126)
do ii=1,6
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from((ii-1)*3+(jj-1)*18+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdd_to_dfd_1_3(to,from)
************************************************************************
* Rearrange fdd_to_dfd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(210),from(210)
do ii=1,6
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from((ii-1)*5+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdf_to_dff_1_3(to,from)
************************************************************************
* Rearrange fdf_to_dff_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(294),from(294)
do ii=1,6
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from((ii-1)*7+(jj-1)*42+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdg_to_dfg_1_3(to,from)
************************************************************************
* Rearrange fdg_to_dfg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(378),from(378)
do ii=1,6
do jj=1,7
do kk=1,9
to(kk+(ii-1)*63+(jj-1)*9)=from((ii-1)*9+(jj-1)*54+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdh_to_dfh_1_3(to,from)
************************************************************************
* Rearrange fdh_to_dfh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(462),from(462)
do ii=1,6
do jj=1,7
do kk=1,11
to(kk+(ii-1)*77+(jj-1)*11)=from((ii-1)*11+(jj-1)*66+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdi_to_dfi_1_3(to,from)
************************************************************************
* Rearrange fdi_to_dfi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(546),from(546)
do ii=1,6
do jj=1,7
do kk=1,13
to(kk+(ii-1)*91+(jj-1)*13)=from((ii-1)*13+(jj-1)*78+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ff_to_ff_1_3(to,from)
************************************************************************
* Rearrange ff_to_ff_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(70),from(70)
do ii=1,10
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffp_to_ffp_1_3(to,from)
************************************************************************
* Rearrange ffp_to_ffp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(210),from(210)
do ii=1,10
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from((ii-1)*3+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffd_to_ffd_1_3(to,from)
************************************************************************
* Rearrange ffd_to_ffd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(350),from(350)
do ii=1,10
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from((ii-1)*5+(jj-1)*50+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fff_to_fff_1_3(to,from)
************************************************************************
* Rearrange fff_to_fff_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(490),from(490)
do ii=1,10
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from((ii-1)*7+(jj-1)*70+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffg_to_ffg_1_3(to,from)
************************************************************************
* Rearrange ffg_to_ffg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(630),from(630)
do ii=1,10
do jj=1,7
do kk=1,9
to(kk+(ii-1)*63+(jj-1)*9)=from((ii-1)*9+(jj-1)*90+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffh_to_ffh_1_3(to,from)
************************************************************************
* Rearrange ffh_to_ffh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(770),from(770)
do ii=1,10
do jj=1,7
do kk=1,11
to(kk+(ii-1)*77+(jj-1)*11)=from((ii-1)*11+(jj-1)*110+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffi_to_ffi_1_3(to,from)
************************************************************************
* Rearrange ffi_to_ffi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(910),from(910)
do ii=1,10
do jj=1,7
do kk=1,13
to(kk+(ii-1)*91+(jj-1)*13)=from((ii-1)*13+(jj-1)*130+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fg_to_gf_1_3(to,from)
************************************************************************
* Rearrange fg_to_gf_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(105),from(105)
do ii=1,15
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgp_to_gfp_1_3(to,from)
************************************************************************
* Rearrange fgp_to_gfp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(315),from(315)
do ii=1,15
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from((ii-1)*3+(jj-1)*45+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgd_to_gfd_1_3(to,from)
************************************************************************
* Rearrange fgd_to_gfd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(525),from(525)
do ii=1,15
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from((ii-1)*5+(jj-1)*75+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgf_to_gff_1_3(to,from)
************************************************************************
* Rearrange fgf_to_gff_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(735),from(735)
do ii=1,15
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from((ii-1)*7+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgg_to_gfg_1_3(to,from)
************************************************************************
* Rearrange fgg_to_gfg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,15
do jj=1,7
do kk=1,9
to(kk+(ii-1)*63+(jj-1)*9)=from((ii-1)*9+(jj-1)*135+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgh_to_gfh_1_3(to,from)
************************************************************************
* Rearrange fgh_to_gfh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1155),from(1155)
do ii=1,15
do jj=1,7
do kk=1,11
to(kk+(ii-1)*77+(jj-1)*11)=from((ii-1)*11+(jj-1)*165+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fgi_to_gfi_1_3(to,from)
************************************************************************
* Rearrange fgi_to_gfi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1365),from(1365)
do ii=1,15
do jj=1,7
do kk=1,13
to(kk+(ii-1)*91+(jj-1)*13)=from((ii-1)*13+(jj-1)*195+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gp_to_pg_1_3(to,from)
************************************************************************
* Rearrange gp_to_pg_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(27),from(27)
do ii=1,3
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpp_to_pgp_1_3(to,from)
************************************************************************
* Rearrange gpp_to_pgp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(81),from(81)
do ii=1,3
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from((ii-1)*3+(jj-1)*9+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpd_to_pgd_1_3(to,from)
************************************************************************
* Rearrange gpd_to_pgd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(135),from(135)
do ii=1,3
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from((ii-1)*5+(jj-1)*15+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpf_to_pgf_1_3(to,from)
************************************************************************
* Rearrange gpf_to_pgf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(189),from(189)
do ii=1,3
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from((ii-1)*7+(jj-1)*21+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpg_to_pgg_1_3(to,from)
************************************************************************
* Rearrange gpg_to_pgg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(243),from(243)
do ii=1,3
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from((ii-1)*9+(jj-1)*27+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gph_to_pgh_1_3(to,from)
************************************************************************
* Rearrange gph_to_pgh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(297),from(297)
do ii=1,3
do jj=1,9
do kk=1,11
to(kk+(ii-1)*99+(jj-1)*11)=from((ii-1)*11+(jj-1)*33+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpi_to_pgi_1_3(to,from)
************************************************************************
* Rearrange gpi_to_pgi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(351),from(351)
do ii=1,3
do jj=1,9
do kk=1,13
to(kk+(ii-1)*117+(jj-1)*13)=from((ii-1)*13+(jj-1)*39+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gd_to_dg_1_3(to,from)
************************************************************************
* Rearrange gd_to_dg_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(54),from(54)
do ii=1,6
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdp_to_dgp_1_3(to,from)
************************************************************************
* Rearrange gdp_to_dgp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(162),from(162)
do ii=1,6
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from((ii-1)*3+(jj-1)*18+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdd_to_dgd_1_3(to,from)
************************************************************************
* Rearrange gdd_to_dgd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(270),from(270)
do ii=1,6
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from((ii-1)*5+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdf_to_dgf_1_3(to,from)
************************************************************************
* Rearrange gdf_to_dgf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(378),from(378)
do ii=1,6
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from((ii-1)*7+(jj-1)*42+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdg_to_dgg_1_3(to,from)
************************************************************************
* Rearrange gdg_to_dgg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(486),from(486)
do ii=1,6
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from((ii-1)*9+(jj-1)*54+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdh_to_dgh_1_3(to,from)
************************************************************************
* Rearrange gdh_to_dgh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(594),from(594)
do ii=1,6
do jj=1,9
do kk=1,11
to(kk+(ii-1)*99+(jj-1)*11)=from((ii-1)*11+(jj-1)*66+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdi_to_dgi_1_3(to,from)
************************************************************************
* Rearrange gdi_to_dgi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(702),from(702)
do ii=1,6
do jj=1,9
do kk=1,13
to(kk+(ii-1)*117+(jj-1)*13)=from((ii-1)*13+(jj-1)*78+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gf_to_fg_1_3(to,from)
************************************************************************
* Rearrange gf_to_fg_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(90),from(90)
do ii=1,10
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfp_to_fgp_1_3(to,from)
************************************************************************
* Rearrange gfp_to_fgp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(270),from(270)
do ii=1,10
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from((ii-1)*3+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfd_to_fgd_1_3(to,from)
************************************************************************
* Rearrange gfd_to_fgd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(450),from(450)
do ii=1,10
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from((ii-1)*5+(jj-1)*50+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gff_to_fgf_1_3(to,from)
************************************************************************
* Rearrange gff_to_fgf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(630),from(630)
do ii=1,10
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from((ii-1)*7+(jj-1)*70+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfg_to_fgg_1_3(to,from)
************************************************************************
* Rearrange gfg_to_fgg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(810),from(810)
do ii=1,10
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from((ii-1)*9+(jj-1)*90+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfh_to_fgh_1_3(to,from)
************************************************************************
* Rearrange gfh_to_fgh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(990),from(990)
do ii=1,10
do jj=1,9
do kk=1,11
to(kk+(ii-1)*99+(jj-1)*11)=from((ii-1)*11+(jj-1)*110+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfi_to_fgi_1_3(to,from)
************************************************************************
* Rearrange gfi_to_fgi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1170),from(1170)
do ii=1,10
do jj=1,9
do kk=1,13
to(kk+(ii-1)*117+(jj-1)*13)=from((ii-1)*13+(jj-1)*130+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gg_to_gg_1_3(to,from)
************************************************************************
* Rearrange gg_to_gg_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(135),from(135)
do ii=1,15
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggp_to_ggp_1_3(to,from)
************************************************************************
* Rearrange ggp_to_ggp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(405),from(405)
do ii=1,15
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from((ii-1)*3+(jj-1)*45+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggd_to_ggd_1_3(to,from)
************************************************************************
* Rearrange ggd_to_ggd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(675),from(675)
do ii=1,15
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from((ii-1)*5+(jj-1)*75+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggf_to_ggf_1_3(to,from)
************************************************************************
* Rearrange ggf_to_ggf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,15
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from((ii-1)*7+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggg_to_ggg_1_3(to,from)
************************************************************************
* Rearrange ggg_to_ggg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1215),from(1215)
do ii=1,15
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from((ii-1)*9+(jj-1)*135+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggh_to_ggh_1_3(to,from)
************************************************************************
* Rearrange ggh_to_ggh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1485),from(1485)
do ii=1,15
do jj=1,9
do kk=1,11
to(kk+(ii-1)*99+(jj-1)*11)=from((ii-1)*11+(jj-1)*165+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggi_to_ggi_1_3(to,from)
************************************************************************
* Rearrange ggi_to_ggi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1755),from(1755)
do ii=1,15
do jj=1,9
do kk=1,13
to(kk+(ii-1)*117+(jj-1)*13)=from((ii-1)*13+(jj-1)*195+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gh_to_hg_1_3(to,from)
************************************************************************
* Rearrange gh_to_hg_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(189),from(189)
do ii=1,21
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghp_to_hgp_1_3(to,from)
************************************************************************
* Rearrange ghp_to_hgp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(567),from(567)
do ii=1,21
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from((ii-1)*3+(jj-1)*63+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghd_to_hgd_1_3(to,from)
************************************************************************
* Rearrange ghd_to_hgd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,21
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from((ii-1)*5+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghf_to_hgf_1_3(to,from)
************************************************************************
* Rearrange ghf_to_hgf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1323),from(1323)
do ii=1,21
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from((ii-1)*7+(jj-1)*147+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghg_to_hgg_1_3(to,from)
************************************************************************
* Rearrange ghg_to_hgg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1701),from(1701)
do ii=1,21
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from((ii-1)*9+(jj-1)*189+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghh_to_hgh_1_3(to,from)
************************************************************************
* Rearrange ghh_to_hgh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2079),from(2079)
do ii=1,21
do jj=1,9
do kk=1,11
to(kk+(ii-1)*99+(jj-1)*11)=from((ii-1)*11+(jj-1)*231+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ghi_to_hgi_1_3(to,from)
************************************************************************
* Rearrange ghi_to_hgi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2457),from(2457)
do ii=1,21
do jj=1,9
do kk=1,13
to(kk+(ii-1)*117+(jj-1)*13)=from((ii-1)*13+(jj-1)*273+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hp_to_ph_1_3(to,from)
************************************************************************
* Rearrange hp_to_ph_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(33),from(33)
do ii=1,3
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpp_to_php_1_3(to,from)
************************************************************************
* Rearrange hpp_to_php_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(99),from(99)
do ii=1,3
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from((ii-1)*3+(jj-1)*9+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpd_to_phd_1_3(to,from)
************************************************************************
* Rearrange hpd_to_phd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(165),from(165)
do ii=1,3
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from((ii-1)*5+(jj-1)*15+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpf_to_phf_1_3(to,from)
************************************************************************
* Rearrange hpf_to_phf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(231),from(231)
do ii=1,3
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from((ii-1)*7+(jj-1)*21+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpg_to_phg_1_3(to,from)
************************************************************************
* Rearrange hpg_to_phg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(297),from(297)
do ii=1,3
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from((ii-1)*9+(jj-1)*27+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hph_to_phh_1_3(to,from)
************************************************************************
* Rearrange hph_to_phh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(363),from(363)
do ii=1,3
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from((ii-1)*11+(jj-1)*33+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpi_to_phi_1_3(to,from)
************************************************************************
* Rearrange hpi_to_phi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(429),from(429)
do ii=1,3
do jj=1,11
do kk=1,13
to(kk+(ii-1)*143+(jj-1)*13)=from((ii-1)*13+(jj-1)*39+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hd_to_dh_1_3(to,from)
************************************************************************
* Rearrange hd_to_dh_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(66),from(66)
do ii=1,6
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdp_to_dhp_1_3(to,from)
************************************************************************
* Rearrange hdp_to_dhp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(198),from(198)
do ii=1,6
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from((ii-1)*3+(jj-1)*18+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdd_to_dhd_1_3(to,from)
************************************************************************
* Rearrange hdd_to_dhd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(330),from(330)
do ii=1,6
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from((ii-1)*5+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdf_to_dhf_1_3(to,from)
************************************************************************
* Rearrange hdf_to_dhf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(462),from(462)
do ii=1,6
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from((ii-1)*7+(jj-1)*42+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdg_to_dhg_1_3(to,from)
************************************************************************
* Rearrange hdg_to_dhg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(594),from(594)
do ii=1,6
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from((ii-1)*9+(jj-1)*54+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdh_to_dhh_1_3(to,from)
************************************************************************
* Rearrange hdh_to_dhh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(726),from(726)
do ii=1,6
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from((ii-1)*11+(jj-1)*66+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdi_to_dhi_1_3(to,from)
************************************************************************
* Rearrange hdi_to_dhi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(858),from(858)
do ii=1,6
do jj=1,11
do kk=1,13
to(kk+(ii-1)*143+(jj-1)*13)=from((ii-1)*13+(jj-1)*78+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hf_to_fh_1_3(to,from)
************************************************************************
* Rearrange hf_to_fh_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(110),from(110)
do ii=1,10
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfp_to_fhp_1_3(to,from)
************************************************************************
* Rearrange hfp_to_fhp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(330),from(330)
do ii=1,10
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from((ii-1)*3+(jj-1)*30+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfd_to_fhd_1_3(to,from)
************************************************************************
* Rearrange hfd_to_fhd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(550),from(550)
do ii=1,10
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from((ii-1)*5+(jj-1)*50+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hff_to_fhf_1_3(to,from)
************************************************************************
* Rearrange hff_to_fhf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(770),from(770)
do ii=1,10
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from((ii-1)*7+(jj-1)*70+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfg_to_fhg_1_3(to,from)
************************************************************************
* Rearrange hfg_to_fhg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(990),from(990)
do ii=1,10
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from((ii-1)*9+(jj-1)*90+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfh_to_fhh_1_3(to,from)
************************************************************************
* Rearrange hfh_to_fhh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1210),from(1210)
do ii=1,10
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from((ii-1)*11+(jj-1)*110+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfi_to_fhi_1_3(to,from)
************************************************************************
* Rearrange hfi_to_fhi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1430),from(1430)
do ii=1,10
do jj=1,11
do kk=1,13
to(kk+(ii-1)*143+(jj-1)*13)=from((ii-1)*13+(jj-1)*130+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hg_to_gh_1_3(to,from)
************************************************************************
* Rearrange hg_to_gh_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(165),from(165)
do ii=1,15
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgp_to_ghp_1_3(to,from)
************************************************************************
* Rearrange hgp_to_ghp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(495),from(495)
do ii=1,15
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from((ii-1)*3+(jj-1)*45+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgd_to_ghd_1_3(to,from)
************************************************************************
* Rearrange hgd_to_ghd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(825),from(825)
do ii=1,15
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from((ii-1)*5+(jj-1)*75+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgf_to_ghf_1_3(to,from)
************************************************************************
* Rearrange hgf_to_ghf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1155),from(1155)
do ii=1,15
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from((ii-1)*7+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgg_to_ghg_1_3(to,from)
************************************************************************
* Rearrange hgg_to_ghg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1485),from(1485)
do ii=1,15
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from((ii-1)*9+(jj-1)*135+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgh_to_ghh_1_3(to,from)
************************************************************************
* Rearrange hgh_to_ghh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1815),from(1815)
do ii=1,15
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from((ii-1)*11+(jj-1)*165+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgi_to_ghi_1_3(to,from)
************************************************************************
* Rearrange hgi_to_ghi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2145),from(2145)
do ii=1,15
do jj=1,11
do kk=1,13
to(kk+(ii-1)*143+(jj-1)*13)=from((ii-1)*13+(jj-1)*195+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hh_to_hh_1_3(to,from)
************************************************************************
* Rearrange hh_to_hh_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(231),from(231)
do ii=1,21
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhp_to_hhp_1_3(to,from)
************************************************************************
* Rearrange hhp_to_hhp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(693),from(693)
do ii=1,21
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from((ii-1)*3+(jj-1)*63+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhd_to_hhd_1_3(to,from)
************************************************************************
* Rearrange hhd_to_hhd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1155),from(1155)
do ii=1,21
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from((ii-1)*5+(jj-1)*105+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhf_to_hhf_1_3(to,from)
************************************************************************
* Rearrange hhf_to_hhf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1617),from(1617)
do ii=1,21
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from((ii-1)*7+(jj-1)*147+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhg_to_hhg_1_3(to,from)
************************************************************************
* Rearrange hhg_to_hhg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2079),from(2079)
do ii=1,21
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from((ii-1)*9+(jj-1)*189+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhh_to_hhh_1_3(to,from)
************************************************************************
* Rearrange hhh_to_hhh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2541),from(2541)
do ii=1,21
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from((ii-1)*11+(jj-1)*231+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhi_to_hhi_1_3(to,from)
************************************************************************
* Rearrange hhi_to_hhi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(3003),from(3003)
do ii=1,21
do jj=1,11
do kk=1,13
to(kk+(ii-1)*143+(jj-1)*13)=from((ii-1)*13+(jj-1)*273+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hi_to_ih_1_3(to,from)
************************************************************************
* Rearrange hi_to_ih_1_3
************************************************************************
implicit none
integer ii,jj
real*8 to(308),from(308)
do ii=1,28
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hip_to_ihp_1_3(to,from)
************************************************************************
* Rearrange hip_to_ihp_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(924),from(924)
do ii=1,28
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from((ii-1)*3+(jj-1)*84+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hid_to_ihd_1_3(to,from)
************************************************************************
* Rearrange hid_to_ihd_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1540),from(1540)
do ii=1,28
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from((ii-1)*5+(jj-1)*140+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hif_to_ihf_1_3(to,from)
************************************************************************
* Rearrange hif_to_ihf_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2156),from(2156)
do ii=1,28
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from((ii-1)*7+(jj-1)*196+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hig_to_ihg_1_3(to,from)
************************************************************************
* Rearrange hig_to_ihg_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2772),from(2772)
do ii=1,28
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from((ii-1)*9+(jj-1)*252+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hih_to_ihh_1_3(to,from)
************************************************************************
* Rearrange hih_to_ihh_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(3388),from(3388)
do ii=1,28
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from((ii-1)*11+(jj-1)*308+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hii_to_ihi_1_3(to,from)
************************************************************************
* Rearrange hii_to_ihi_1_3
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(4004),from(4004)
do ii=1,28
do jj=1,11
do kk=1,13
to(kk+(ii-1)*143+(jj-1)*13)=from((ii-1)*13+(jj-1)*364+kk)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ppp_to_ppp_3_5(to,from)
************************************************************************
* Rearrange ppp_to_ppp_3_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(27),from(27)
do ii=1,3
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from(ii+(jj-1)*3+(kk-1)*9)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ppd_to_dpp_3_5(to,from)
************************************************************************
* Rearrange ppd_to_dpp_3_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(54),from(54)
do ii=1,6
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from(ii+(jj-1)*6+(kk-1)*18)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ppf_to_fpp_3_5(to,from)
************************************************************************
* Rearrange ppf_to_fpp_3_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(90),from(90)
do ii=1,10
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from(ii+(jj-1)*10+(kk-1)*30)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ppg_to_gpp_3_5(to,from)
************************************************************************
* Rearrange ppg_to_gpp_3_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(135),from(135)
do ii=1,15
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from(ii+(jj-1)*15+(kk-1)*45)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine pph_to_hpp_3_5(to,from)
************************************************************************
* Rearrange pph_to_hpp_3_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(189),from(189)
do ii=1,21
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from(ii+(jj-1)*21+(kk-1)*63)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ppi_to_ipp_3_5(to,from)
************************************************************************
* Rearrange ppi_to_ipp_3_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(252),from(252)
do ii=1,28
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from(ii+(jj-1)*28+(kk-1)*84)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ppk_to_kpp_3_5(to,from)
************************************************************************
* Rearrange ppk_to_kpp_3_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(324),from(324)
do ii=1,36
do jj=1,3
do kk=1,3
to(kk+(ii-1)*9+(jj-1)*3)=from(ii+(jj-1)*36+(kk-1)*108)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dp_to_pd_2_5(to,from)
************************************************************************
* Rearrange dp_to_pd_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(15),from(15)
do ii=1,3
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dd_to_dd_2_5(to,from)
************************************************************************
* Rearrange dd_to_dd_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(30),from(30)
do ii=1,6
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine df_to_fd_2_5(to,from)
************************************************************************
* Rearrange df_to_fd_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(50),from(50)
do ii=1,10
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dg_to_gd_2_5(to,from)
************************************************************************
* Rearrange dg_to_gd_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(75),from(75)
do ii=1,15
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dh_to_hd_2_5(to,from)
************************************************************************
* Rearrange dh_to_hd_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(105),from(105)
do ii=1,21
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine di_to_id_2_5(to,from)
************************************************************************
* Rearrange di_to_id_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(140),from(140)
do ii=1,28
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dk_to_kd_2_5(to,from)
************************************************************************
* Rearrange dk_to_kd_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(180),from(180)
do ii=1,36
do jj=1,5
to(1+(ii-1)*5+(jj-1)*1)=from(ii+(jj-1)*36)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpp_to_pdp_1_5(to,from)
************************************************************************
* Rearrange dpp_to_pdp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(45),from(45)
do ii=1,3
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from(ii+(jj-1)*9+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpd_to_ddp_1_5(to,from)
************************************************************************
* Rearrange dpd_to_ddp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(90),from(90)
do ii=1,6
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from(ii+(jj-1)*18+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpf_to_fdp_1_5(to,from)
************************************************************************
* Rearrange dpf_to_fdp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(150),from(150)
do ii=1,10
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from(ii+(jj-1)*30+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpg_to_gdp_1_5(to,from)
************************************************************************
* Rearrange dpg_to_gdp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(225),from(225)
do ii=1,15
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from(ii+(jj-1)*45+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dph_to_hdp_1_5(to,from)
************************************************************************
* Rearrange dph_to_hdp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(315),from(315)
do ii=1,21
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from(ii+(jj-1)*63+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpi_to_idp_1_5(to,from)
************************************************************************
* Rearrange dpi_to_idp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(420),from(420)
do ii=1,28
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from(ii+(jj-1)*84+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine dpk_to_kdp_1_5(to,from)
************************************************************************
* Rearrange dpk_to_kdp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(540),from(540)
do ii=1,36
do jj=1,5
do kk=1,3
to(kk+(ii-1)*15+(jj-1)*3)=from(ii+(jj-1)*108+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddp_to_pdd_1_5(to,from)
************************************************************************
* Rearrange ddp_to_pdd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(75),from(75)
do ii=1,3
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from(ii+(jj-1)*15+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddd_to_ddd_1_5(to,from)
************************************************************************
* Rearrange ddd_to_ddd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(150),from(150)
do ii=1,6
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from(ii+(jj-1)*30+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddf_to_fdd_1_5(to,from)
************************************************************************
* Rearrange ddf_to_fdd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(250),from(250)
do ii=1,10
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from(ii+(jj-1)*50+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddg_to_gdd_1_5(to,from)
************************************************************************
* Rearrange ddg_to_gdd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(375),from(375)
do ii=1,15
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from(ii+(jj-1)*75+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddh_to_hdd_1_5(to,from)
************************************************************************
* Rearrange ddh_to_hdd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(525),from(525)
do ii=1,21
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from(ii+(jj-1)*105+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddi_to_idd_1_5(to,from)
************************************************************************
* Rearrange ddi_to_idd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(700),from(700)
do ii=1,28
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from(ii+(jj-1)*140+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ddk_to_kdd_1_5(to,from)
************************************************************************
* Rearrange ddk_to_kdd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(900),from(900)
do ii=1,36
do jj=1,5
do kk=1,5
to(kk+(ii-1)*25+(jj-1)*5)=from(ii+(jj-1)*180+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fp_to_pf_2_5(to,from)
************************************************************************
* Rearrange fp_to_pf_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(21),from(21)
do ii=1,3
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fd_to_df_2_5(to,from)
************************************************************************
* Rearrange fd_to_df_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(42),from(42)
do ii=1,6
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ff_to_ff_2_5(to,from)
************************************************************************
* Rearrange ff_to_ff_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(70),from(70)
do ii=1,10
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fg_to_gf_2_5(to,from)
************************************************************************
* Rearrange fg_to_gf_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(105),from(105)
do ii=1,15
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fh_to_hf_2_5(to,from)
************************************************************************
* Rearrange fh_to_hf_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(147),from(147)
do ii=1,21
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fi_to_if_2_5(to,from)
************************************************************************
* Rearrange fi_to_if_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(196),from(196)
do ii=1,28
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fk_to_kf_2_5(to,from)
************************************************************************
* Rearrange fk_to_kf_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(252),from(252)
do ii=1,36
do jj=1,7
to(1+(ii-1)*7+(jj-1)*1)=from(ii+(jj-1)*36)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpp_to_pfp_1_5(to,from)
************************************************************************
* Rearrange fpp_to_pfp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(63),from(63)
do ii=1,3
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from(ii+(jj-1)*9+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpd_to_dfp_1_5(to,from)
************************************************************************
* Rearrange fpd_to_dfp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(126),from(126)
do ii=1,6
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from(ii+(jj-1)*18+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpf_to_ffp_1_5(to,from)
************************************************************************
* Rearrange fpf_to_ffp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(210),from(210)
do ii=1,10
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from(ii+(jj-1)*30+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpg_to_gfp_1_5(to,from)
************************************************************************
* Rearrange fpg_to_gfp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(315),from(315)
do ii=1,15
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from(ii+(jj-1)*45+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fph_to_hfp_1_5(to,from)
************************************************************************
* Rearrange fph_to_hfp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(441),from(441)
do ii=1,21
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from(ii+(jj-1)*63+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpi_to_ifp_1_5(to,from)
************************************************************************
* Rearrange fpi_to_ifp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(588),from(588)
do ii=1,28
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from(ii+(jj-1)*84+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fpk_to_kfp_1_5(to,from)
************************************************************************
* Rearrange fpk_to_kfp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(756),from(756)
do ii=1,36
do jj=1,7
do kk=1,3
to(kk+(ii-1)*21+(jj-1)*3)=from(ii+(jj-1)*108+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdp_to_pfd_1_5(to,from)
************************************************************************
* Rearrange fdp_to_pfd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(105),from(105)
do ii=1,3
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from(ii+(jj-1)*15+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdd_to_dfd_1_5(to,from)
************************************************************************
* Rearrange fdd_to_dfd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(210),from(210)
do ii=1,6
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from(ii+(jj-1)*30+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdf_to_ffd_1_5(to,from)
************************************************************************
* Rearrange fdf_to_ffd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(350),from(350)
do ii=1,10
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from(ii+(jj-1)*50+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdg_to_gfd_1_5(to,from)
************************************************************************
* Rearrange fdg_to_gfd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(525),from(525)
do ii=1,15
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from(ii+(jj-1)*75+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdh_to_hfd_1_5(to,from)
************************************************************************
* Rearrange fdh_to_hfd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(735),from(735)
do ii=1,21
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from(ii+(jj-1)*105+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdi_to_ifd_1_5(to,from)
************************************************************************
* Rearrange fdi_to_ifd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(980),from(980)
do ii=1,28
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from(ii+(jj-1)*140+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fdk_to_kfd_1_5(to,from)
************************************************************************
* Rearrange fdk_to_kfd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1260),from(1260)
do ii=1,36
do jj=1,7
do kk=1,5
to(kk+(ii-1)*35+(jj-1)*5)=from(ii+(jj-1)*180+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffp_to_pff_1_5(to,from)
************************************************************************
* Rearrange ffp_to_pff_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(147),from(147)
do ii=1,3
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from(ii+(jj-1)*21+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffd_to_dff_1_5(to,from)
************************************************************************
* Rearrange ffd_to_dff_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(294),from(294)
do ii=1,6
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from(ii+(jj-1)*42+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine fff_to_fff_1_5(to,from)
************************************************************************
* Rearrange fff_to_fff_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(490),from(490)
do ii=1,10
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from(ii+(jj-1)*70+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffg_to_gff_1_5(to,from)
************************************************************************
* Rearrange ffg_to_gff_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(735),from(735)
do ii=1,15
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from(ii+(jj-1)*105+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffh_to_hff_1_5(to,from)
************************************************************************
* Rearrange ffh_to_hff_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1029),from(1029)
do ii=1,21
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from(ii+(jj-1)*147+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffi_to_iff_1_5(to,from)
************************************************************************
* Rearrange ffi_to_iff_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1372),from(1372)
do ii=1,28
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from(ii+(jj-1)*196+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ffk_to_kff_1_5(to,from)
************************************************************************
* Rearrange ffk_to_kff_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1764),from(1764)
do ii=1,36
do jj=1,7
do kk=1,7
to(kk+(ii-1)*49+(jj-1)*7)=from(ii+(jj-1)*252+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gp_to_pg_2_5(to,from)
************************************************************************
* Rearrange gp_to_pg_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(27),from(27)
do ii=1,3
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gd_to_dg_2_5(to,from)
************************************************************************
* Rearrange gd_to_dg_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(54),from(54)
do ii=1,6
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gf_to_fg_2_5(to,from)
************************************************************************
* Rearrange gf_to_fg_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(90),from(90)
do ii=1,10
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gg_to_gg_2_5(to,from)
************************************************************************
* Rearrange gg_to_gg_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(135),from(135)
do ii=1,15
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gh_to_hg_2_5(to,from)
************************************************************************
* Rearrange gh_to_hg_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(189),from(189)
do ii=1,21
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gi_to_ig_2_5(to,from)
************************************************************************
* Rearrange gi_to_ig_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(252),from(252)
do ii=1,28
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gk_to_kg_2_5(to,from)
************************************************************************
* Rearrange gk_to_kg_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(324),from(324)
do ii=1,36
do jj=1,9
to(1+(ii-1)*9+(jj-1)*1)=from(ii+(jj-1)*36)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpp_to_pgp_1_5(to,from)
************************************************************************
* Rearrange gpp_to_pgp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(81),from(81)
do ii=1,3
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from(ii+(jj-1)*9+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpd_to_dgp_1_5(to,from)
************************************************************************
* Rearrange gpd_to_dgp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(162),from(162)
do ii=1,6
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from(ii+(jj-1)*18+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpf_to_fgp_1_5(to,from)
************************************************************************
* Rearrange gpf_to_fgp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(270),from(270)
do ii=1,10
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from(ii+(jj-1)*30+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpg_to_ggp_1_5(to,from)
************************************************************************
* Rearrange gpg_to_ggp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(405),from(405)
do ii=1,15
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from(ii+(jj-1)*45+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gph_to_hgp_1_5(to,from)
************************************************************************
* Rearrange gph_to_hgp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(567),from(567)
do ii=1,21
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from(ii+(jj-1)*63+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpi_to_igp_1_5(to,from)
************************************************************************
* Rearrange gpi_to_igp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(756),from(756)
do ii=1,28
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from(ii+(jj-1)*84+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gpk_to_kgp_1_5(to,from)
************************************************************************
* Rearrange gpk_to_kgp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(972),from(972)
do ii=1,36
do jj=1,9
do kk=1,3
to(kk+(ii-1)*27+(jj-1)*3)=from(ii+(jj-1)*108+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdp_to_pgd_1_5(to,from)
************************************************************************
* Rearrange gdp_to_pgd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(135),from(135)
do ii=1,3
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from(ii+(jj-1)*15+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdd_to_dgd_1_5(to,from)
************************************************************************
* Rearrange gdd_to_dgd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(270),from(270)
do ii=1,6
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from(ii+(jj-1)*30+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdf_to_fgd_1_5(to,from)
************************************************************************
* Rearrange gdf_to_fgd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(450),from(450)
do ii=1,10
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from(ii+(jj-1)*50+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdg_to_ggd_1_5(to,from)
************************************************************************
* Rearrange gdg_to_ggd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(675),from(675)
do ii=1,15
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from(ii+(jj-1)*75+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdh_to_hgd_1_5(to,from)
************************************************************************
* Rearrange gdh_to_hgd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,21
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from(ii+(jj-1)*105+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdi_to_igd_1_5(to,from)
************************************************************************
* Rearrange gdi_to_igd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1260),from(1260)
do ii=1,28
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from(ii+(jj-1)*140+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gdk_to_kgd_1_5(to,from)
************************************************************************
* Rearrange gdk_to_kgd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1620),from(1620)
do ii=1,36
do jj=1,9
do kk=1,5
to(kk+(ii-1)*45+(jj-1)*5)=from(ii+(jj-1)*180+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfp_to_pgf_1_5(to,from)
************************************************************************
* Rearrange gfp_to_pgf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(189),from(189)
do ii=1,3
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from(ii+(jj-1)*21+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfd_to_dgf_1_5(to,from)
************************************************************************
* Rearrange gfd_to_dgf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(378),from(378)
do ii=1,6
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from(ii+(jj-1)*42+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gff_to_fgf_1_5(to,from)
************************************************************************
* Rearrange gff_to_fgf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(630),from(630)
do ii=1,10
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from(ii+(jj-1)*70+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfg_to_ggf_1_5(to,from)
************************************************************************
* Rearrange gfg_to_ggf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(945),from(945)
do ii=1,15
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from(ii+(jj-1)*105+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfh_to_hgf_1_5(to,from)
************************************************************************
* Rearrange gfh_to_hgf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1323),from(1323)
do ii=1,21
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from(ii+(jj-1)*147+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfi_to_igf_1_5(to,from)
************************************************************************
* Rearrange gfi_to_igf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1764),from(1764)
do ii=1,28
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from(ii+(jj-1)*196+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine gfk_to_kgf_1_5(to,from)
************************************************************************
* Rearrange gfk_to_kgf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2268),from(2268)
do ii=1,36
do jj=1,9
do kk=1,7
to(kk+(ii-1)*63+(jj-1)*7)=from(ii+(jj-1)*252+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggp_to_pgg_1_5(to,from)
************************************************************************
* Rearrange ggp_to_pgg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(243),from(243)
do ii=1,3
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from(ii+(jj-1)*27+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggd_to_dgg_1_5(to,from)
************************************************************************
* Rearrange ggd_to_dgg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(486),from(486)
do ii=1,6
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from(ii+(jj-1)*54+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggf_to_fgg_1_5(to,from)
************************************************************************
* Rearrange ggf_to_fgg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(810),from(810)
do ii=1,10
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from(ii+(jj-1)*90+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggg_to_ggg_1_5(to,from)
************************************************************************
* Rearrange ggg_to_ggg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1215),from(1215)
do ii=1,15
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from(ii+(jj-1)*135+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggh_to_hgg_1_5(to,from)
************************************************************************
* Rearrange ggh_to_hgg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1701),from(1701)
do ii=1,21
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from(ii+(jj-1)*189+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggi_to_igg_1_5(to,from)
************************************************************************
* Rearrange ggi_to_igg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2268),from(2268)
do ii=1,28
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from(ii+(jj-1)*252+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine ggk_to_kgg_1_5(to,from)
************************************************************************
* Rearrange ggk_to_kgg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2916),from(2916)
do ii=1,36
do jj=1,9
do kk=1,9
to(kk+(ii-1)*81+(jj-1)*9)=from(ii+(jj-1)*324+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hp_to_ph_2_5(to,from)
************************************************************************
* Rearrange hp_to_ph_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(33),from(33)
do ii=1,3
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*3)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hd_to_dh_2_5(to,from)
************************************************************************
* Rearrange hd_to_dh_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(66),from(66)
do ii=1,6
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*6)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hf_to_fh_2_5(to,from)
************************************************************************
* Rearrange hf_to_fh_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(110),from(110)
do ii=1,10
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*10)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hg_to_gh_2_5(to,from)
************************************************************************
* Rearrange hg_to_gh_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(165),from(165)
do ii=1,15
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*15)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hh_to_hh_2_5(to,from)
************************************************************************
* Rearrange hh_to_hh_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(231),from(231)
do ii=1,21
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*21)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hi_to_ih_2_5(to,from)
************************************************************************
* Rearrange hi_to_ih_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(308),from(308)
do ii=1,28
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*28)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hk_to_kh_2_5(to,from)
************************************************************************
* Rearrange hk_to_kh_2_5
************************************************************************
implicit none
integer ii,jj
real*8 to(396),from(396)
do ii=1,36
do jj=1,11
to(1+(ii-1)*11+(jj-1)*1)=from(ii+(jj-1)*36)
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpp_to_php_1_5(to,from)
************************************************************************
* Rearrange hpp_to_php_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(99),from(99)
do ii=1,3
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from(ii+(jj-1)*9+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpd_to_dhp_1_5(to,from)
************************************************************************
* Rearrange hpd_to_dhp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(198),from(198)
do ii=1,6
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from(ii+(jj-1)*18+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpf_to_fhp_1_5(to,from)
************************************************************************
* Rearrange hpf_to_fhp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(330),from(330)
do ii=1,10
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from(ii+(jj-1)*30+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpg_to_ghp_1_5(to,from)
************************************************************************
* Rearrange hpg_to_ghp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(495),from(495)
do ii=1,15
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from(ii+(jj-1)*45+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hph_to_hhp_1_5(to,from)
************************************************************************
* Rearrange hph_to_hhp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(693),from(693)
do ii=1,21
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from(ii+(jj-1)*63+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpi_to_ihp_1_5(to,from)
************************************************************************
* Rearrange hpi_to_ihp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(924),from(924)
do ii=1,28
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from(ii+(jj-1)*84+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hpk_to_khp_1_5(to,from)
************************************************************************
* Rearrange hpk_to_khp_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1188),from(1188)
do ii=1,36
do jj=1,11
do kk=1,3
to(kk+(ii-1)*33+(jj-1)*3)=from(ii+(jj-1)*108+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdp_to_phd_1_5(to,from)
************************************************************************
* Rearrange hdp_to_phd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(165),from(165)
do ii=1,3
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from(ii+(jj-1)*15+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdd_to_dhd_1_5(to,from)
************************************************************************
* Rearrange hdd_to_dhd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(330),from(330)
do ii=1,6
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from(ii+(jj-1)*30+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdf_to_fhd_1_5(to,from)
************************************************************************
* Rearrange hdf_to_fhd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(550),from(550)
do ii=1,10
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from(ii+(jj-1)*50+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdg_to_ghd_1_5(to,from)
************************************************************************
* Rearrange hdg_to_ghd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(825),from(825)
do ii=1,15
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from(ii+(jj-1)*75+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdh_to_hhd_1_5(to,from)
************************************************************************
* Rearrange hdh_to_hhd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1155),from(1155)
do ii=1,21
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from(ii+(jj-1)*105+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdi_to_ihd_1_5(to,from)
************************************************************************
* Rearrange hdi_to_ihd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1540),from(1540)
do ii=1,28
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from(ii+(jj-1)*140+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hdk_to_khd_1_5(to,from)
************************************************************************
* Rearrange hdk_to_khd_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1980),from(1980)
do ii=1,36
do jj=1,11
do kk=1,5
to(kk+(ii-1)*55+(jj-1)*5)=from(ii+(jj-1)*180+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfp_to_phf_1_5(to,from)
************************************************************************
* Rearrange hfp_to_phf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(231),from(231)
do ii=1,3
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from(ii+(jj-1)*21+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfd_to_dhf_1_5(to,from)
************************************************************************
* Rearrange hfd_to_dhf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(462),from(462)
do ii=1,6
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from(ii+(jj-1)*42+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hff_to_fhf_1_5(to,from)
************************************************************************
* Rearrange hff_to_fhf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(770),from(770)
do ii=1,10
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from(ii+(jj-1)*70+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfg_to_ghf_1_5(to,from)
************************************************************************
* Rearrange hfg_to_ghf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1155),from(1155)
do ii=1,15
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from(ii+(jj-1)*105+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfh_to_hhf_1_5(to,from)
************************************************************************
* Rearrange hfh_to_hhf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1617),from(1617)
do ii=1,21
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from(ii+(jj-1)*147+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfi_to_ihf_1_5(to,from)
************************************************************************
* Rearrange hfi_to_ihf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2156),from(2156)
do ii=1,28
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from(ii+(jj-1)*196+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hfk_to_khf_1_5(to,from)
************************************************************************
* Rearrange hfk_to_khf_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2772),from(2772)
do ii=1,36
do jj=1,11
do kk=1,7
to(kk+(ii-1)*77+(jj-1)*7)=from(ii+(jj-1)*252+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgp_to_phg_1_5(to,from)
************************************************************************
* Rearrange hgp_to_phg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(297),from(297)
do ii=1,3
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from(ii+(jj-1)*27+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgd_to_dhg_1_5(to,from)
************************************************************************
* Rearrange hgd_to_dhg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(594),from(594)
do ii=1,6
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from(ii+(jj-1)*54+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgf_to_fhg_1_5(to,from)
************************************************************************
* Rearrange hgf_to_fhg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(990),from(990)
do ii=1,10
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from(ii+(jj-1)*90+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgg_to_ghg_1_5(to,from)
************************************************************************
* Rearrange hgg_to_ghg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1485),from(1485)
do ii=1,15
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from(ii+(jj-1)*135+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgh_to_hhg_1_5(to,from)
************************************************************************
* Rearrange hgh_to_hhg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2079),from(2079)
do ii=1,21
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from(ii+(jj-1)*189+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgi_to_ihg_1_5(to,from)
************************************************************************
* Rearrange hgi_to_ihg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2772),from(2772)
do ii=1,28
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from(ii+(jj-1)*252+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hgk_to_khg_1_5(to,from)
************************************************************************
* Rearrange hgk_to_khg_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(3564),from(3564)
do ii=1,36
do jj=1,11
do kk=1,9
to(kk+(ii-1)*99+(jj-1)*9)=from(ii+(jj-1)*324+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhp_to_phh_1_5(to,from)
************************************************************************
* Rearrange hhp_to_phh_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(363),from(363)
do ii=1,3
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from(ii+(jj-1)*33+(kk-1)*3)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhd_to_dhh_1_5(to,from)
************************************************************************
* Rearrange hhd_to_dhh_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(726),from(726)
do ii=1,6
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from(ii+(jj-1)*66+(kk-1)*6)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhf_to_fhh_1_5(to,from)
************************************************************************
* Rearrange hhf_to_fhh_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1210),from(1210)
do ii=1,10
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from(ii+(jj-1)*110+(kk-1)*10)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhg_to_ghh_1_5(to,from)
************************************************************************
* Rearrange hhg_to_ghh_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(1815),from(1815)
do ii=1,15
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from(ii+(jj-1)*165+(kk-1)*15)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhh_to_hhh_1_5(to,from)
************************************************************************
* Rearrange hhh_to_hhh_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(2541),from(2541)
do ii=1,21
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from(ii+(jj-1)*231+(kk-1)*21)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhi_to_ihh_1_5(to,from)
************************************************************************
* Rearrange hhi_to_ihh_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(3388),from(3388)
do ii=1,28
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from(ii+(jj-1)*308+(kk-1)*28)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
************************************************************************
subroutine hhk_to_khh_1_5(to,from)
************************************************************************
* Rearrange hhk_to_khh_1_5
************************************************************************
implicit none
integer ii,jj,kk
real*8 to(4356),from(4356)
do ii=1,36
do jj=1,11
do kk=1,11
to(kk+(ii-1)*121+(jj-1)*11)=from(ii+(jj-1)*396+(kk-1)*36)
enddo ! kk
enddo ! jj
enddo ! ii
return
end
************************************************************************
Reference in New Issue View Git Blame Copy Permalink