module wrap_sj contains subroutine S_S2G(s,g) ! スペクトル→グリッド(球面調和) use constants implicit none real(8) :: s((2*NN+1-MM)*MM+NN+1) real(8) :: g(IM, JM) real(8) :: Q((JM*0.5)*7), WS(2*(NN+1)), WG((IM+2)*JM), W((JM+1)*IM) call SJTS2G(MM,NM,NN,IM,JM,s,g,SJIT,SJT,SJP,Q,SJR,WS,WG,W,0) endsubroutine subroutine S_G2S(g,s) ! グリッド→スペクトル(球面調和) use constants implicit none real(8) :: s((2*NN+1-MM)*MM+NN+1) real(8) :: g(IM, JM) real(8) :: Q((JM*0.5)*7), WS(2*(NN+1)), WG((IM+2)*JM), W((JM+1)*IM) call SJTG2S(MM,NM,NN,IM,JM,s,g,SJIT,SJT,SJP,Q,SJR,WS,WG,W,0) endsubroutine subroutine S_S2G_dual(s1,s2,g1,g2) !2変数同時 スペクトル→グリッド(球面調和) use constants implicit none real(8) :: s1((2*NN+1-MM)*MM+NN+1), s2((2*NN+1-MM)*MM+NN+1) real(8) :: g1(IM, JM), g2(IM, JM) real(8) :: Q((JM*0.5)*11), WS1(2*(NN+1)), WS2(2*(NN+1)), WG((IM+2)*JM), W1((JM+1)*IM), W2((JM+1)*IM) call SJMS2G(MM,NM,NN,IM,JM,s1,s2,g1,g2,SJIT,SJT,SJP,Q,SJR,WS1,WS2,WG,W1,W2,0) endsubroutine subroutine S_G2S_dual(g1,g2,s1,s2) !2変数同時 グリッド→スペクトル(球面調和) use constants implicit none real(8) :: s1((2*NN+1-MM)*MM+NN+1), s2((2*NN+1-MM)*MM+NN+1) real(8) :: g1(IM, JM), g2(IM, JM) real(8) :: Q((JM*0.5)*11), WS1(2*(NN+1)), WS2(2*(NN+1)), WG((IM+2)*JM), W1((JM+1)*IM), W2((JM+1)*IM) call SJMG2S(MM,NM,NN,IM,JM,s1,s2,g1,g2,SJIT,SJT,SJP,Q,SJR,WS1,WS2,WG,W1,W2,0) endsubroutine subroutine S_S2G_dlat(s,g) !緯度微分 スペクトル→グリッド (球面調和) use constants implicit none real(8) :: s((2*NN+1-MM)*MM+NN+1), sy((NN+4)*NN+2) real(8) :: g(IM, JM) real(8) :: Q((JM*0.5)*7), WS(2*(NN+2)), WG((IM+2)*JM), W((JM+1)*IM) call SJCS2Y(NN, s, sy, SJC) call SJTS2G(MM,NM,NN+1,IM,JM,sy,g,SJIT,SJT,SJP,Q,SJR,WS,WG,W,1) endsubroutine subroutine S_G2S_div(g,s) !発散緯度成分 グリッド→スペクトル (球面調和) use constants implicit none real(8) :: s((2*NN+1-MM)*MM+NN+1), sy((NN+4)*NN+2) real(8) :: g(IM, JM) real(8) :: Q((JM*0.5)*7), WS(2*(NN+2)), WG((IM+2)*JM), W((JM+1)*IM) call SJTG2S(MM,NM,NN+1,IM,JM,sy,g,SJIT,SJT,SJP,Q,SJR,WS,WG,W,1) call SJCY2S(NN, sy, s, SJC) endsubroutine subroutine S_S2G_dlat_dual(s1,s2,g1,g2) !緯度微分 2変数同時 スペクトル→グリッド (球面調和) use constants implicit none real(8) :: s1((2*NN+1-MM)*MM+NN+1), s1y((NN+4)*NN+2) real(8) :: s2((2*NN+1-MM)*MM+NN+1), s2y((NN+4)*NN+2) real(8) :: g1(IM, JM), g2(IM,JM) real(8) :: Q((JM*0.5)*11), WS1(2*(NN+2)), WS2(2*(NN+2)), WG((IM+2)*JM), W1((JM+1)*IM), W2((JM+1)*IM) call SJCS2Y(NN, s1, s1y, SJC) call SJCS2Y(NN, s2, s2y, SJC) call SJMS2G(MM,NM,NN+1,IM,JM,s1y,s2y,g1,g2,SJIT,SJT,SJP,Q,SJR,WS1,WS2,WG,W1,W2,1) endsubroutine subroutine S_G2S_div_dual(s1,s2,g1,g2) !発散緯度成分 2変数同時 グリッド→スペクトル (球面調和) use constants implicit none real(8) :: s1((2*NN+1-MM)*MM+NN+1), s1y((NN+4)*NN+2) real(8) :: s2((2*NN+1-MM)*MM+NN+1), s2y((NN+4)*NN+2) real(8) :: g1(IM, JM), g2(IM,JM) real(8) :: Q((JM*0.5)*11), WS1(2*(NN+2)), WS2(2*(NN+2)), WG((IM+2)*JM), W1((JM+1)*IM), W2((JM+1)*IM) call SJTG2S(MM,NM,NN+1,IM,JM,s1y,s2y,g1,g2,SJIT,SJT,SJP,Q,SJR,WS1,WS2,WG,W1,W2,1) call SJCY2S(NN, s1y, s1, SJC) call SJCY2S(NN, s2y, s2, SJC) endsubroutine subroutine S_S2S_dlon(s1,s2) !経度微分 スペクトル→スペクトル (球面調和) use constants implicit none real(8) :: s1((MM+1)*(MM+1)), s2((MM+1)*(MM+1)) call SJCS2X(MM, s1, s2) endsubroutine subroutine S_S2S_lap(s1,s2) !ラプラシアン -n(n+1) スペクトル→スペクトル (球面調和) use constants implicit none real(8) :: s1((NN+1)*(NN+1)), s2((NN+1)*(NN+1)) call SJCLAP(NN, s1, s2, SJD, 1) endsubroutine subroutine S_S2S_inlap(s1,s2) !逆ラプラシアン -1/n(n+1) スペクトル→スペクトル (球面調和) use constants implicit none real(8) :: s1((NN+1)*(NN+1)), s2((NN+1)*(NN+1)) call SJCLAP(NN, s1, s2, SJD, 2) endsubroutine endmodule