[TEST]UPSTREAM: Pick some source changes from 48080d0a97
* Sync new folder structure
This commit is contained in:
3622
AMSS_NCKU_source/Shell_Patch/ShellPatch.C
Normal file
3622
AMSS_NCKU_source/Shell_Patch/ShellPatch.C
Normal file
File diff suppressed because it is too large
Load Diff
205
AMSS_NCKU_source/Shell_Patch/ShellPatch.h
Normal file
205
AMSS_NCKU_source/Shell_Patch/ShellPatch.h
Normal file
@@ -0,0 +1,205 @@
|
||||
|
||||
#ifndef SHELLPATCH_H
|
||||
#define SHELLPATCH_H
|
||||
|
||||
#include <mpi.h>
|
||||
#include "MyList.h"
|
||||
#include "Block.h"
|
||||
#include "Parallel.h"
|
||||
#include "var.h"
|
||||
#include "monitor.h"
|
||||
#include "macrodef.h" //need dim here; Vertex or Cell; ghost_width
|
||||
|
||||
#if (dim != 3)
|
||||
#error shellpatch only supports 3 dimensional stuff yet
|
||||
#endif
|
||||
|
||||
class ss_patch
|
||||
{
|
||||
|
||||
public:
|
||||
int sst; // ss_patch type: 0:zp, 1:zm, 2:xp, 3:xm, 4:yp, 5:ym
|
||||
int myrank;
|
||||
int shape[dim];
|
||||
double bbox[2 * dim]; // this bbox includes nominal points and overlap points
|
||||
MyList<Block> *blb, *ble;
|
||||
int ingfs, fngfs;
|
||||
|
||||
ss_patch() {};
|
||||
ss_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki);
|
||||
|
||||
~ss_patch();
|
||||
|
||||
virtual void setupcordtrans() {};
|
||||
void Sync(MyList<var> *VarList, int Symmetry);
|
||||
MyList<Parallel::gridseg> *build_bulk_gsl(Block *bp);
|
||||
MyList<Parallel::gridseg> *build_ghost_gsl();
|
||||
MyList<Parallel::gridseg> *build_owned_gsl0(int rank_in);
|
||||
};
|
||||
|
||||
class xp_patch : public ss_patch
|
||||
{
|
||||
public:
|
||||
xp_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 2; };
|
||||
void setupcordtrans();
|
||||
};
|
||||
|
||||
class xm_patch : public ss_patch
|
||||
{
|
||||
public:
|
||||
xm_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 3; };
|
||||
void setupcordtrans();
|
||||
};
|
||||
class yp_patch : public ss_patch
|
||||
{
|
||||
public:
|
||||
yp_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 4; };
|
||||
void setupcordtrans();
|
||||
};
|
||||
|
||||
class ym_patch : public ss_patch
|
||||
{
|
||||
public:
|
||||
ym_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 5; };
|
||||
void setupcordtrans();
|
||||
};
|
||||
class zp_patch : public ss_patch
|
||||
{
|
||||
public:
|
||||
zp_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 0; };
|
||||
void setupcordtrans();
|
||||
};
|
||||
|
||||
class zm_patch : public ss_patch
|
||||
{
|
||||
public:
|
||||
zm_patch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 1; };
|
||||
void setupcordtrans();
|
||||
};
|
||||
// Shell Patch system
|
||||
// for derivatives usage we ask 27 more double type grid functions
|
||||
// here we use **sngfs corresponding to fngfs to store them:
|
||||
// drho/dx, drho/dy, drho/dz
|
||||
// dsigma/dx, dsigma/dy, dsigma/dz
|
||||
// dR/dx, dR/dy, dR/dz
|
||||
// drho/dxdx, drho/dxdy, drho/dxdz, drho/dydy, drho/dydz, drho/dzdz
|
||||
// dsigma/dxdx, dsigma/dxdy, dsigma/dxdz, dsigma/dydy, dsigma/dydz, dsigma/dzdz
|
||||
// dR/dxdx, dR/dxdy, dR/dxdz, dR/dydy, dR/dydz, dR/dzdz
|
||||
class ShellPatch
|
||||
{
|
||||
|
||||
public:
|
||||
struct pointstru
|
||||
{
|
||||
double gpox[dim]; // global cordinate
|
||||
double lpox[dim]; // local cordinate
|
||||
Block *Bg;
|
||||
int ssst; //-1: cardisian, others as sst of ss_patch source sst
|
||||
int tsst; //-1: cardisian, others as sst of ss_patch target sst
|
||||
double *coef;
|
||||
int *sind;
|
||||
int dumyd; // the dimension which has common lines, only useful in interdata_packer
|
||||
//-1: means no dumy dimension at all; 0: means rho; 1: means sigma
|
||||
};
|
||||
|
||||
int myrank;
|
||||
int shape[dim]; // for (rho, sigma, R), for rho and sigma means number of points for every pi/2
|
||||
double Rrange[2]; // for Rmin and Rmax
|
||||
int Symmetry;
|
||||
int ingfs, fngfs;
|
||||
|
||||
MyList<ss_patch> *PatL;
|
||||
|
||||
// we use fngfs+v to reference the variable
|
||||
enum
|
||||
{
|
||||
gx = 0,
|
||||
gy,
|
||||
gz,
|
||||
drhodx,
|
||||
drhody,
|
||||
drhodz,
|
||||
dsigmadx,
|
||||
dsigmady,
|
||||
dsigmadz,
|
||||
dRdx,
|
||||
dRdy,
|
||||
dRdz,
|
||||
drhodxx,
|
||||
drhodxy,
|
||||
drhodxz,
|
||||
drhodyy,
|
||||
drhodyz,
|
||||
drhodzz,
|
||||
dsigmadxx,
|
||||
dsigmadxy,
|
||||
dsigmadxz,
|
||||
dsigmadyy,
|
||||
dsigmadyz,
|
||||
dsigmadzz,
|
||||
dRdxx,
|
||||
dRdxy,
|
||||
dRdxz,
|
||||
dRdyy,
|
||||
dRdyz,
|
||||
dRdzz
|
||||
};
|
||||
|
||||
MyList<pointstru> **ss_src, **ss_dst;
|
||||
// at means target
|
||||
MyList<pointstru> **csatc_src, **csatc_dst;
|
||||
MyList<pointstru> **csats_src, **csats_dst;
|
||||
|
||||
public:
|
||||
ShellPatch(int ingfsi, int fngfsi, char *filename, int Symmetry, int myranki, monitor *ErrorMonitor);
|
||||
|
||||
~ShellPatch();
|
||||
|
||||
MyList<Block> *compose_sh(int cpusize, int nodes = 0);
|
||||
MyList<Block> *compose_shr(int cpusize, int nodes = 0);
|
||||
void setupcordtrans();
|
||||
double getR(double r);
|
||||
double getsr(double R);
|
||||
void checkPatch();
|
||||
void checkBlock(int sst);
|
||||
void check_pointstrul(MyList<pointstru> *pp, bool first_only);
|
||||
void check_pointstrul2(MyList<pointstru> *pp, int first_last_only);
|
||||
double getdX(int dir); //(rho, sigma, R)
|
||||
void Dump_xyz(char *tag, double time, double dT);
|
||||
void Dump_Data(MyList<var> *DumpList, char *tag, double time, double dT);
|
||||
double *Collect_Data(ss_patch *PP, var *VP);
|
||||
void getlocalpoxsst(double gx, double gy, double gz, int sst, double &lx, double &ly, double &lz);
|
||||
void getlocalpox(double gx, double gy, double gz, int &sst, double &lx, double &ly, double &lz);
|
||||
void getglobalpox(double &x, double &y, double &z, int sst, double lx, double ly, double lz);
|
||||
void prolongpointstru(MyList<pointstru> *&psul, MyList<ss_patch> *sPp, double DH[dim],
|
||||
MyList<Patch> *Pp, double CDH[dim], MyList<pointstru> *pss);
|
||||
bool prolongpointstru(MyList<pointstru> *&psul, bool ssyn, int tsst, MyList<ss_patch> *sPp, double DH[dim],
|
||||
MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in);
|
||||
void setupintintstuff(int cpusize, MyList<Patch> *CPatL, int Symmetry);
|
||||
void intertransfer(MyList<pointstru> **src, MyList<pointstru> **dst,
|
||||
MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
|
||||
int Symmetry);
|
||||
int interdata_packer(double *data, MyList<pointstru> *src, MyList<pointstru> *dst,
|
||||
int rank_in, int dir,
|
||||
MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */,
|
||||
int Symmetry);
|
||||
void Synch(MyList<var> *VarList, int Symmetry);
|
||||
void CS_Inter(MyList<var> *VarList, int Symmetry);
|
||||
void destroypsuList(MyList<pointstru> *ct);
|
||||
int getdumydimension(int acsst, int posst); // -1 means no dumy dimension
|
||||
void matchcheck(MyList<Patch> *CPatL);
|
||||
void shellname(char *sn, int i);
|
||||
void Interp_Points(MyList<var> *VarList,
|
||||
int NN, double **XX, /*input global Cartesian coordinate*/
|
||||
double *Shellf, int Symmetry);
|
||||
bool Interp_One_Point(MyList<var> *VarList,
|
||||
double *XX, /*input global Cartesian coordinate*/
|
||||
double *Shellf, int Symmetry);
|
||||
void write_Pablo_file_ss(int *ext, double xmin, double xmax, double ymin, double ymax, double zmin, double zmax,
|
||||
char *filename, int sst);
|
||||
double L2Norm(var *vf);
|
||||
void L2Norm7(var **vf, double *norms);
|
||||
void Find_Maximum(MyList<var> *VarList, double *XX, double *Shellf);
|
||||
};
|
||||
|
||||
#endif /* SHELLPATCH_H */
|
||||
723
AMSS_NCKU_source/Shell_Patch/shellfunctions.f90
Normal file
723
AMSS_NCKU_source/Shell_Patch/shellfunctions.f90
Normal file
@@ -0,0 +1,723 @@
|
||||
|
||||
|
||||
!-----------------------------------------------------------------------------------
|
||||
!
|
||||
!Set up approximate puncture initial data for n black holes with lousto's
|
||||
!formula PRD 77, 024034 (2008)
|
||||
!
|
||||
!-----------------------------------------------------------------------------------
|
||||
|
||||
subroutine get_initial_nbhs_sh(ex,X,Y,Z, &
|
||||
chi, trK, &
|
||||
gxx, gxy, gxz, gyy, gyz, gzz,&
|
||||
Axx, Axy, Axz, Ayy, Ayz, Azz,&
|
||||
Gmx, Gmy, Gmz, &
|
||||
Lap, Sfx, Sfy, Sfz,&
|
||||
dtSfx,dtSfy,dtSfz,Mass,Porg,Pmom,Spin,N)
|
||||
|
||||
implicit none
|
||||
|
||||
!------= input arguments
|
||||
|
||||
integer,intent(in) :: N
|
||||
integer, dimension(3), intent(in) :: ex
|
||||
real*8, dimension(ex(1),ex(2),ex(3)), intent(in) :: X,Y,Z
|
||||
real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: chi
|
||||
real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: gxx,gxy,gxz,gyy,gyz,gzz
|
||||
real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Axx,Axy,Axz,Ayy,Ayz,Azz
|
||||
real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: trK,Lap,Sfx,Sfy,Sfz
|
||||
real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: Gmx,Gmy,Gmz
|
||||
real*8, dimension(ex(1),ex(2),ex(3)), intent(out) :: dtSfx,dtSfy,dtSfz
|
||||
real*8, dimension(N), intent(in) :: Mass
|
||||
real*8, dimension(3*N), intent(in) :: Porg,Pmom,Spin
|
||||
|
||||
!------= local variables
|
||||
real*8,dimension(ex(1),ex(2),ex(3))::psi
|
||||
integer :: i,j,k,bhi
|
||||
real*8 :: M,Px,Py,Pz,PP,Sx,Sy,Sz,SS
|
||||
real*8 :: nx,ny,nz,rr,tmp
|
||||
real*8 :: u,u1,u2,u3,u4,u5
|
||||
real*8 :: mup,mus,b,ell
|
||||
real*8, parameter :: HLF = 5.d-1, ZEO = 0.d0, ONE = 1.d0, THR = 3.d0
|
||||
real*8,parameter::TINYRR=1.d-14
|
||||
|
||||
do k = 1,ex(3)
|
||||
do j = 1,ex(2)
|
||||
do i = 1,ex(1)
|
||||
! black hole 1
|
||||
M = mass(1)
|
||||
nx = x(i,j,k) - Porg(1)
|
||||
ny = y(i,j,k) - Porg(2)
|
||||
nz = z(i,j,k) - Porg(3)
|
||||
Px = Pmom(1)
|
||||
Py = Pmom(2)
|
||||
Pz = Pmom(3)
|
||||
Sx = Spin(1)
|
||||
Sy = Spin(2)
|
||||
Sz = Spin(3)
|
||||
|
||||
rr = dsqrt(nx*nx+ny*ny+nz*nz)
|
||||
if(rr.lt.TINYRR) rr=(X(2,1,1)-X(1,1,1))/2.d0
|
||||
nx = nx / rr
|
||||
ny = ny / rr
|
||||
nz = nz / rr
|
||||
PP = dsqrt(Px**2 + Py**2 + Pz**2)
|
||||
if(PP .gt. 0.d0) then
|
||||
mup = (Px*nx+Py*ny+Pz*nz)/PP
|
||||
else
|
||||
mup = 0.0
|
||||
endif
|
||||
SS = dsqrt(Sx**2 + Sy**2 + Sz**2)
|
||||
if(SS .gt. 0.d0) then
|
||||
mus = (Sx*nx+Sy*ny+Sz*nz)/SS
|
||||
else
|
||||
mus = 0.0
|
||||
endif
|
||||
b = 2.d0*rr/M
|
||||
ell = 1.d0/(1.d0+b)
|
||||
|
||||
u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0)
|
||||
u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 &
|
||||
+8.4d1*dlog(ell)/b)/4.d1/b**2
|
||||
u3 = ell+ell**2+ell**3-4.d0*ell**4+2.d0*ell**5
|
||||
u4 = -b**2*ell**5
|
||||
u5 = b*(1.d0+5.d0*b+1.d1*b**2)*ell**5/8.d1
|
||||
|
||||
tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz
|
||||
|
||||
u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + &
|
||||
2.d0*SS**2/5.d0/M**4*(u3 + u4*(3.d0*mus**2-ONE)) + &
|
||||
u5*tmp
|
||||
|
||||
psi(i,j,k) = ONE + u + HLF*M/rr
|
||||
|
||||
tmp = Px * nx + Py * ny + Pz * nz
|
||||
|
||||
Axx(i,j,k) = (HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + &
|
||||
( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Ayy(i,j,k) = (HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + &
|
||||
( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Azz(i,j,k) = (HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + &
|
||||
( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Axy(i,j,k) = (HLF *( Px * ny + nx * Py + nx * ny * tmp ) + &
|
||||
( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Axz(i,j,k) = (HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + &
|
||||
( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Ayz(i,j,k) = (HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + &
|
||||
( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
! black hole 2 and 3, ...
|
||||
do bhi=2,N
|
||||
M = Mass(bhi)
|
||||
nx = x(i,j,k) - Porg(3*(bhi-1)+1)
|
||||
ny = y(i,j,k) - Porg(3*(bhi-1)+2)
|
||||
nz = z(i,j,k) - Porg(3*(bhi-1)+3)
|
||||
Px = Pmom(3*(bhi-1)+1)
|
||||
Py = Pmom(3*(bhi-1)+2)
|
||||
Pz = Pmom(3*(bhi-1)+3)
|
||||
Sx = Spin(3*(bhi-1)+1)
|
||||
Sy = Spin(3*(bhi-1)+2)
|
||||
Sz = Spin(3*(bhi-1)+3)
|
||||
|
||||
rr = dsqrt(nx*nx+ny*ny+nz*nz)
|
||||
if(rr.lt.TINYRR) rr=(X(2,1,1)-X(1,1,1))/2.d0
|
||||
nx = nx / rr
|
||||
ny = ny / rr
|
||||
nz = nz / rr
|
||||
PP = dsqrt(Px**2 + Py**2 + Pz**2)
|
||||
if(PP .gt. 0.d0) then
|
||||
mup = (Px*nx+Py*ny+Pz*nz)/PP
|
||||
else
|
||||
mup = 0.0
|
||||
endif
|
||||
SS = dsqrt(Sx**2 + Sy**2 + Sz**2)
|
||||
if(SS .gt. 0.d0) then
|
||||
mus = (Sx*nx+Sy*ny+Sz*nz)/SS
|
||||
else
|
||||
mus = 0.0
|
||||
endif
|
||||
b = 2.d0*rr/M
|
||||
ell = 1.d0/(1.d0+b)
|
||||
|
||||
u1 = 5.d0/8.d0*ell*(1.d0-2.d0*ell+2.d0*ell**2-ell**3+ell**4/5.d0)
|
||||
u2 = (1.5d1+1.17d2*ell-7.9d1*ell**2+4.3d1*ell**3-1.4d1*ell**4+2.d0*ell**5 &
|
||||
+8.4d1*dlog(ell)/b)/4.d1/b**2
|
||||
u3 = ell+ell**2+ell**3-4.d0*ell**4+2.d0*ell**5
|
||||
u4 = -b**2*ell**5
|
||||
u5 = b*(1.d0+5.d0*b+1.d1*b**2)*ell**5/8.d1
|
||||
|
||||
tmp = (Py*Sz-Pz*Sy)*nx + (Pz*Sx-Px*Sz)*ny + (Px*Sy-Py*Sx)*nz
|
||||
|
||||
u = PP**2/M**2*(u1 + u2*(3.d0*mup**2-ONE)) + &
|
||||
2.d0*SS**2/5.d0/M**4*(u3 + u4*(3.d0*mus**2-ONE)) + &
|
||||
u5*tmp
|
||||
|
||||
psi(i,j,k) = psi(i,j,k) + u + HLF*M/rr
|
||||
|
||||
tmp = Px * nx + Py * ny + Pz * nz
|
||||
|
||||
Axx(i,j,k) = Axx(i,j,k) + &
|
||||
(HLF *( Px * nx + nx * Px - ( ONE - nx * nx )* tmp ) + &
|
||||
( nx * Sy * nz - nx * Sz * ny + nx * Sy * nz - nx * Sz * ny ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Ayy(i,j,k) = Ayy(i,j,k) + &
|
||||
(HLF *( Py * ny + ny * Py - ( ONE - ny * ny )* tmp ) + &
|
||||
( ny * Sz * nx - ny * Sx * nz + ny * Sz * nx - ny * Sx * nz ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Azz(i,j,k) = Azz(i,j,k) + &
|
||||
(HLF *( Pz * nz + nz * Pz - ( ONE - nz * nz )* tmp ) + &
|
||||
( nz * Sx * ny - nz * Sy * nx + nz * Sx * ny - nz * Sy * nx ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Axy(i,j,k) = Axy(i,j,k) + &
|
||||
(HLF *( Px * ny + nx * Py + nx * ny * tmp ) + &
|
||||
( nx * Sz * nx - nx * Sx * nz + ny * Sy * nz - ny * Sz * ny ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Axz(i,j,k) = Axz(i,j,k) + &
|
||||
(HLF *( Px * nz + nx * Pz + nx * nz * tmp ) + &
|
||||
( nx * Sx * ny - nx * Sy * nx + nz * Sy * nz - nz * Sz * ny ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
|
||||
Ayz(i,j,k) = Ayz(i,j,k) + &
|
||||
(HLF *( Py * nz + ny * Pz + ny * nz * tmp ) + &
|
||||
( ny * Sx * ny - ny * Sy * nx + nz * Sz * nx - nz * Sx * nz ) / rr ) * &
|
||||
THR / ( rr * rr )
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
chi = ONE / psi **4 - ONE
|
||||
|
||||
Lap = ONE / ( psi * psi ) - ONE
|
||||
|
||||
!~~~~~~ tilde Aij = Aij / Psi^6
|
||||
psi = psi * psi * psi * psi * psi * psi
|
||||
|
||||
Axx = Axx / psi
|
||||
Ayy = Ayy / psi
|
||||
Azz = Azz / psi
|
||||
Axy = Axy / psi
|
||||
Axz = Axz / psi
|
||||
Ayz = Ayz / psi
|
||||
|
||||
gxx = ZEO
|
||||
gyy = ZEO
|
||||
gzz = ZEO
|
||||
gxy = ZEO
|
||||
gxz = ZEO
|
||||
gyz = ZEO
|
||||
|
||||
trK = ZEO
|
||||
|
||||
Gmx = ZEO
|
||||
Gmy = ZEO
|
||||
Gmz = ZEO
|
||||
|
||||
Sfx = ZEO
|
||||
Sfy = ZEO
|
||||
Sfz = ZEO
|
||||
|
||||
dtSfx = ZEO
|
||||
dtSfy = ZEO
|
||||
dtSfz = ZEO
|
||||
|
||||
return
|
||||
|
||||
end subroutine get_initial_nbhs_sh
|
||||
!----------------------------------------------------
|
||||
! I use this routine to unify the parameters
|
||||
subroutine shellcordpar(A,B,r0,eps)
|
||||
implicit none
|
||||
! argument variables
|
||||
double precision,intent(out)::A,B,r0,eps
|
||||
|
||||
A=1.d0
|
||||
B=0.d0
|
||||
r0=0.d0
|
||||
eps=1.d0
|
||||
|
||||
return
|
||||
|
||||
end subroutine shellcordpar
|
||||
!----------------------------------------------------
|
||||
! R = f(r)-f(0)
|
||||
subroutine getcartr(ex,R,cartr)
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,intent(in)::ex
|
||||
double precision,intent(in),dimension(ex)::R
|
||||
double precision,intent(out),dimension(ex)::cartr
|
||||
|
||||
!~~~~~~ local variables
|
||||
double precision,dimension(ex)::f
|
||||
double precision :: A,B,r0,eps
|
||||
|
||||
call shellcordpar(A,B,r0,eps)
|
||||
f = R+B
|
||||
cartr = r0+(A*f-B*dsqrt(A*A+(f*f-B*B)/eps))/(A*A-B*B/eps)
|
||||
|
||||
return
|
||||
end subroutine getcartr
|
||||
! dR/dr = ...
|
||||
subroutine getdRdcartr(ex,R,dRdcartr)
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,intent(in)::ex
|
||||
double precision,intent(in),dimension(ex)::R
|
||||
double precision,intent(out),dimension(ex)::dRdcartr
|
||||
|
||||
!~~~~~~ local variables
|
||||
double precision,dimension(ex)::cartr
|
||||
double precision :: A,B,r0,eps
|
||||
|
||||
call shellcordpar(A,B,r0,eps)
|
||||
|
||||
call getcartr(ex,R,cartr)
|
||||
dRdcartr = A + B*(cartr-r0)/dsqrt(eps*eps+eps*(cartr-r0)*(cartr-r0))
|
||||
|
||||
return
|
||||
end subroutine getdRdcartr
|
||||
! dR/drdr = ...
|
||||
subroutine getdRdcartrcartr(ex,R,dRdcartrcartr)
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,intent(in)::ex
|
||||
double precision,intent(in),dimension(ex)::R
|
||||
double precision,intent(out),dimension(ex)::dRdcartrcartr
|
||||
|
||||
!~~~~~~ local variables
|
||||
double precision,dimension(ex)::cartr
|
||||
|
||||
double precision :: A,B,r0,eps
|
||||
|
||||
call shellcordpar(A,B,r0,eps)
|
||||
|
||||
call getcartr(ex,R,cartr)
|
||||
dRdcartrcartr = B*dsqrt(eps)/(dsqrt(eps+(cartr-r0)*(cartr-r0)))**3
|
||||
|
||||
return
|
||||
|
||||
end subroutine getdRdcartrcartr
|
||||
|
||||
subroutine zp_getxyz(ex,rho,sigma,R,x,y,z)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1))::tgrho
|
||||
double precision,dimension(ex(2))::tgsigma
|
||||
integer :: i,j,k
|
||||
|
||||
call getcartr(ex(3),R,cartr)
|
||||
tgrho = dtan(rho)
|
||||
tgsigma = dtan(sigma)
|
||||
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
z(i,j,k) = cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j))
|
||||
x(i,j,k) = z(i,j,k)*tgrho(i)
|
||||
y(i,j,k) = z(i,j,k)*tgsigma(j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine zp_getxyz
|
||||
|
||||
subroutine zm_getxyz(ex,rho,sigma,R,x,y,z)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1))::tgrho
|
||||
double precision,dimension(ex(2))::tgsigma
|
||||
integer :: i,j,k
|
||||
|
||||
call getcartr(ex(3),R,cartr)
|
||||
tgrho = dtan(rho)
|
||||
tgsigma = dtan(sigma)
|
||||
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
z(i,j,k) = -cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j))
|
||||
x(i,j,k) = z(i,j,k)*tgrho(i)
|
||||
y(i,j,k) = z(i,j,k)*tgsigma(j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine zm_getxyz
|
||||
|
||||
subroutine yp_getxyz(ex,rho,sigma,R,x,y,z)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1))::tgrho
|
||||
double precision,dimension(ex(2))::tgsigma
|
||||
integer :: i,j,k
|
||||
|
||||
call getcartr(ex(3),R,cartr)
|
||||
tgrho = dtan(rho)
|
||||
tgsigma = dtan(sigma)
|
||||
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
y(i,j,k) = cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j))
|
||||
x(i,j,k) = y(i,j,k)*tgrho(i)
|
||||
z(i,j,k) = y(i,j,k)*tgsigma(j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine yp_getxyz
|
||||
|
||||
subroutine ym_getxyz(ex,rho,sigma,R,x,y,z)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1))::tgrho
|
||||
double precision,dimension(ex(2))::tgsigma
|
||||
integer :: i,j,k
|
||||
|
||||
call getcartr(ex(3),R,cartr)
|
||||
tgrho = dtan(rho)
|
||||
tgsigma = dtan(sigma)
|
||||
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
y(i,j,k) = -cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j))
|
||||
x(i,j,k) = y(i,j,k)*tgrho(i)
|
||||
z(i,j,k) = y(i,j,k)*tgsigma(j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine ym_getxyz
|
||||
|
||||
subroutine xp_getxyz(ex,rho,sigma,R,x,y,z)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1))::tgrho
|
||||
double precision,dimension(ex(2))::tgsigma
|
||||
integer :: i,j,k
|
||||
|
||||
call getcartr(ex(3),R,cartr)
|
||||
tgrho = dtan(rho)
|
||||
tgsigma = dtan(sigma)
|
||||
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
x(i,j,k) = cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j))
|
||||
y(i,j,k) = x(i,j,k)*tgrho(i)
|
||||
z(i,j,k) = x(i,j,k)*tgsigma(j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine xp_getxyz
|
||||
|
||||
subroutine xm_getxyz(ex,rho,sigma,R,x,y,z)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1))::tgrho
|
||||
double precision,dimension(ex(2))::tgsigma
|
||||
integer :: i,j,k
|
||||
|
||||
call getcartr(ex(3),R,cartr)
|
||||
tgrho = dtan(rho)
|
||||
tgsigma = dtan(sigma)
|
||||
|
||||
do k=1,ex(3)
|
||||
do j=1,ex(2)
|
||||
do i=1,ex(1)
|
||||
x(i,j,k) = -cartr(k)/dsqrt(1+tgrho(i)*tgrho(i)+tgsigma(j)*tgsigma(j))
|
||||
y(i,j,k) = x(i,j,k)*tgrho(i)
|
||||
z(i,j,k) = x(i,j,k)*tgsigma(j)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
return
|
||||
|
||||
end subroutine xm_getxyz
|
||||
!------------------------------------------------------------------------------------------
|
||||
! calculate Jacobians
|
||||
subroutine xpm_getjacobian(ex,rho,sigma,R,x,y,z, &
|
||||
drhodx, drhody, drhodz, &
|
||||
dsigmadx,dsigmady,dsigmadz, &
|
||||
dRdx,dRdy,dRdz, &
|
||||
drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, &
|
||||
dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, &
|
||||
dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1),ex(2),ex(3))::srt,xxyy,xxzz,dRdcartr,dRdcartrcartr
|
||||
integer :: i,j,k
|
||||
real*8,parameter :: ZEO=0.d0
|
||||
|
||||
xxyy = x*x + y*y
|
||||
xxzz = x*x + z*z
|
||||
srt = dsqrt(xxyy + z*z)
|
||||
call getdRdcartr(ex(3),R,dRdcartr(1,1,:))
|
||||
call getdRdcartrcartr(ex(3),R,dRdcartrcartr(1,1,:))
|
||||
do k=1,ex(3)
|
||||
dRdcartr(:,:,k) = dRdcartr(1,1,k)
|
||||
dRdcartrcartr(:,:,k) = dRdcartrcartr(1,1,k)
|
||||
enddo
|
||||
|
||||
dRdx = x/srt*dRdcartr
|
||||
dRdy = y/srt*dRdcartr
|
||||
dRdz = z/srt*dRdcartr
|
||||
drhodx = -y/xxyy
|
||||
drhody = x/xxyy
|
||||
drhodz = ZEO
|
||||
dsigmadx = -z/xxzz
|
||||
dsigmady = ZEO
|
||||
dsigmadz = x/xxzz
|
||||
|
||||
dRdxx = dRdcartrcartr*x*x/srt/srt+dRdcartr*(y*y+z*z)/srt**3
|
||||
dRdxy = dRdcartrcartr*x*y/srt/srt-dRdcartr*( x*y)/srt**3
|
||||
dRdxz = dRdcartrcartr*x*z/srt/srt-dRdcartr*( x*z)/srt**3
|
||||
dRdyy = dRdcartrcartr*y*y/srt/srt+dRdcartr*(x*x+z*z)/srt**3
|
||||
dRdyz = dRdcartrcartr*y*z/srt/srt-dRdcartr*( y*z)/srt**3
|
||||
dRdzz = dRdcartrcartr*z*z/srt/srt+dRdcartr*(x*x+y*y)/srt**3
|
||||
drhodxx = 2*x*y/xxyy**2
|
||||
drhodxy = (-x*x + y*y)/xxyy**2
|
||||
drhodxz = ZEO
|
||||
drhodyy = -drhodxx
|
||||
drhodyz = ZEO
|
||||
drhodzz = ZEO
|
||||
dsigmadxx = (2*x*z)/xxzz**2
|
||||
dsigmadxy = ZEO
|
||||
dsigmadxz = (-x*x + z*z)/xxzz**2
|
||||
dsigmadyy = ZEO
|
||||
dsigmadyz = ZEO
|
||||
dsigmadzz = -dsigmadxx
|
||||
|
||||
return
|
||||
|
||||
end subroutine xpm_getjacobian
|
||||
!~~~~
|
||||
subroutine ypm_getjacobian(ex,rho,sigma,R,x,y,z, &
|
||||
drhodx, drhody, drhodz, &
|
||||
dsigmadx,dsigmady,dsigmadz, &
|
||||
dRdx,dRdy,dRdz, &
|
||||
drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, &
|
||||
dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, &
|
||||
dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1),ex(2),ex(3))::srt,xxyy,yyzz,dRdcartr,dRdcartrcartr
|
||||
integer :: i,j,k
|
||||
real*8,parameter :: ZEO=0.d0
|
||||
|
||||
xxyy = x*x + y*y
|
||||
yyzz = y*y + z*z
|
||||
srt = dsqrt(xxyy + z*z)
|
||||
call getdRdcartr(ex(3),R,dRdcartr(1,1,:))
|
||||
call getdRdcartrcartr(ex(3),R,dRdcartrcartr(1,1,:))
|
||||
do k=1,ex(3)
|
||||
dRdcartr(:,:,k) = dRdcartr(1,1,k)
|
||||
dRdcartrcartr(:,:,k) = dRdcartrcartr(1,1,k)
|
||||
enddo
|
||||
|
||||
dRdx = x/srt*dRdcartr
|
||||
dRdy = y/srt*dRdcartr
|
||||
dRdz = z/srt*dRdcartr
|
||||
drhodx = y/xxyy
|
||||
drhody = -x/xxyy
|
||||
drhodz = ZEO
|
||||
dsigmadx = ZEO
|
||||
dsigmady = -z/yyzz
|
||||
dsigmadz = y/yyzz
|
||||
|
||||
dRdxx = dRdcartrcartr*x*x/srt/srt+dRdcartr*(y*y+z*z)/srt**3
|
||||
dRdxy = dRdcartrcartr*x*y/srt/srt-dRdcartr*( x*y)/srt**3
|
||||
dRdxz = dRdcartrcartr*x*z/srt/srt-dRdcartr*( x*z)/srt**3
|
||||
dRdyy = dRdcartrcartr*y*y/srt/srt+dRdcartr*(x*x+z*z)/srt**3
|
||||
dRdyz = dRdcartrcartr*y*z/srt/srt-dRdcartr*( y*z)/srt**3
|
||||
dRdzz = dRdcartrcartr*z*z/srt/srt+dRdcartr*(x*x+y*y)/srt**3
|
||||
drhodxx = -2*x*y/xxyy**2
|
||||
drhodxy = (x*x - y*y)/xxyy**2
|
||||
drhodxz = ZEO
|
||||
drhodyy = -drhodxx
|
||||
drhodyz = ZEO
|
||||
drhodzz = ZEO
|
||||
dsigmadxx = ZEO
|
||||
dsigmadxy = ZEO
|
||||
dsigmadxz = ZEO
|
||||
dsigmadyy = (2*y*z)/yyzz**2
|
||||
dsigmadyz = (-y*y + z*z)/yyzz**2
|
||||
dsigmadzz = -dsigmadyy
|
||||
|
||||
return
|
||||
|
||||
end subroutine ypm_getjacobian
|
||||
!~~~~
|
||||
subroutine zpm_getjacobian(ex,rho,sigma,R,x,y,z, &
|
||||
drhodx, drhody, drhodz, &
|
||||
dsigmadx,dsigmady,dsigmadz, &
|
||||
dRdx,dRdy,dRdz, &
|
||||
drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz, &
|
||||
dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz, &
|
||||
dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz)
|
||||
|
||||
implicit none
|
||||
! argument variables
|
||||
integer,dimension(3),intent(in)::ex
|
||||
double precision,intent(in),dimension(ex(1))::rho
|
||||
double precision,intent(in),dimension(ex(2))::sigma
|
||||
double precision,intent(in),dimension(ex(3))::R
|
||||
double precision,intent(in),dimension(ex(1),ex(2),ex(3))::x,y,z
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz
|
||||
double precision,intent(out),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz
|
||||
!~~~~~~ other variables
|
||||
double precision,dimension(ex(3))::cartr
|
||||
double precision,dimension(ex(1),ex(2),ex(3))::srt,xxzz,yyzz,dRdcartr,dRdcartrcartr
|
||||
integer :: i,j,k
|
||||
real*8,parameter :: ZEO=0.d0
|
||||
|
||||
xxzz = x*x + z*z
|
||||
yyzz = y*y + z*z
|
||||
srt = dsqrt(xxzz + y*y)
|
||||
call getdRdcartr(ex(3),R,dRdcartr(1,1,:))
|
||||
call getdRdcartrcartr(ex(3),R,dRdcartrcartr(1,1,:))
|
||||
do k=1,ex(3)
|
||||
dRdcartr(:,:,k) = dRdcartr(1,1,k)
|
||||
dRdcartrcartr(:,:,k) = dRdcartrcartr(1,1,k)
|
||||
enddo
|
||||
|
||||
dRdx = x/srt*dRdcartr
|
||||
dRdy = y/srt*dRdcartr
|
||||
dRdz = z/srt*dRdcartr
|
||||
drhodx = z/xxzz
|
||||
drhody = ZEO
|
||||
drhodz = -x/xxzz
|
||||
dsigmadx = ZEO
|
||||
dsigmady = z/yyzz
|
||||
dsigmadz = -y/yyzz
|
||||
|
||||
dRdxx = dRdcartrcartr*x*x/srt/srt+dRdcartr*(y*y+z*z)/srt**3
|
||||
dRdxy = dRdcartrcartr*x*y/srt/srt-dRdcartr*( x*y)/srt**3
|
||||
dRdxz = dRdcartrcartr*x*z/srt/srt-dRdcartr*( x*z)/srt**3
|
||||
dRdyy = dRdcartrcartr*y*y/srt/srt+dRdcartr*(x*x+z*z)/srt**3
|
||||
dRdyz = dRdcartrcartr*y*z/srt/srt-dRdcartr*( y*z)/srt**3
|
||||
dRdzz = dRdcartrcartr*z*z/srt/srt+dRdcartr*(x*x+y*y)/srt**3
|
||||
drhodxx = -2*x*z/xxzz**2
|
||||
drhodxy = ZEO
|
||||
drhodxz = (x*x - z*z)/xxzz**2
|
||||
drhodyy = ZEO
|
||||
drhodyz = ZEO
|
||||
drhodzz = -drhodxx
|
||||
dsigmadxx = ZEO
|
||||
dsigmadxy = ZEO
|
||||
dsigmadxz = ZEO
|
||||
dsigmadyy = -(2*y*z)/yyzz**2
|
||||
dsigmadyz = (y*y - z*z)/yyzz**2
|
||||
dsigmadzz = -dsigmadyy
|
||||
|
||||
return
|
||||
|
||||
end subroutine zpm_getjacobian
|
||||
112
AMSS_NCKU_source/Shell_Patch/shellfunctions.h
Normal file
112
AMSS_NCKU_source/Shell_Patch/shellfunctions.h
Normal file
@@ -0,0 +1,112 @@
|
||||
|
||||
#ifndef SHELLFUNCTIONS_H
|
||||
#define SHELLFUNCTIONS_H
|
||||
|
||||
#ifdef fortran1
|
||||
#define f_get_initial_nbhs_sh get_initial_nbhs_sh
|
||||
#define f_xp_getxyz xp_getxyz
|
||||
#define f_xm_getxyz xm_getxyz
|
||||
#define f_yp_getxyz yp_getxyz
|
||||
#define f_ym_getxyz ym_getxyz
|
||||
#define f_zp_getxyz zp_getxyz
|
||||
#define f_zm_getxyz zm_getxyz
|
||||
#define f_xpm_getjacobian xpm_getjacobian
|
||||
#define f_ypm_getjacobian ypm_getjacobian
|
||||
#define f_zpm_getjacobian zpm_getjacobian
|
||||
#define f_shellcordpar shellcordpar
|
||||
#endif
|
||||
#ifdef fortran2
|
||||
#define f_get_initial_nbhs_sh GET_INITIAL_NBHS_SH
|
||||
#define f_xp_getxyz XP_GETXYZ
|
||||
#define f_xm_getxyz XM_GETXYZ
|
||||
#define f_yp_getxyz YP_GETXYZ
|
||||
#define f_ym_getxyz YM_GETXYZ
|
||||
#define f_zp_getxyz ZP_GETXYZ
|
||||
#define f_zm_getxyz ZM_GETXYZ
|
||||
#define f_xpm_getjacobian XPM_GETJACOBIAN
|
||||
#define f_ypm_getjacobian YPM_GETJACOBIAN
|
||||
#define f_zpm_getjacobian ZPM_GETJACOBIAN
|
||||
#define f_shellcordpar SHELLCORDPAR
|
||||
#endif
|
||||
#ifdef fortran3
|
||||
#define f_get_initial_nbhs_sh get_initial_nbhs_sh_
|
||||
#define f_xp_getxyz xp_getxyz_
|
||||
#define f_xm_getxyz xm_getxyz_
|
||||
#define f_yp_getxyz yp_getxyz_
|
||||
#define f_ym_getxyz ym_getxyz_
|
||||
#define f_zp_getxyz zp_getxyz_
|
||||
#define f_zm_getxyz zm_getxyz_
|
||||
#define f_xpm_getjacobian xpm_getjacobian_
|
||||
#define f_ypm_getjacobian ypm_getjacobian_
|
||||
#define f_zpm_getjacobian zpm_getjacobian_
|
||||
#define f_shellcordpar shellcordpar_
|
||||
#endif
|
||||
|
||||
extern "C"
|
||||
{
|
||||
void f_get_initial_nbhs_sh(int *, double *, double *, double *,
|
||||
double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *,
|
||||
double *, double *, double *, double *,
|
||||
double *, double *, double *,
|
||||
double *, double *, double *, double *, int &);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
{
|
||||
void f_xp_getxyz(int *, double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
extern "C"
|
||||
{
|
||||
void f_xm_getxyz(int *, double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
extern "C"
|
||||
{
|
||||
void f_yp_getxyz(int *, double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
extern "C"
|
||||
{
|
||||
void f_ym_getxyz(int *, double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
extern "C"
|
||||
{
|
||||
void f_zp_getxyz(int *, double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
extern "C"
|
||||
{
|
||||
void f_zm_getxyz(int *, double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
{
|
||||
void f_xpm_getjacobian(int *, double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
extern "C"
|
||||
{
|
||||
void f_ypm_getjacobian(int *, double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
extern "C"
|
||||
{
|
||||
void f_zpm_getjacobian(int *, double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *,
|
||||
double *, double *, double *, double *, double *, double *);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
{
|
||||
void f_shellcordpar(double &, double &, double &, double &);
|
||||
}
|
||||
|
||||
#endif /* SHELLFUNCTIONS_H */
|
||||
Reference in New Issue
Block a user