My Project
Data Types | Functions/Subroutines | Variables
mod_spherical Module Reference

Data Types

interface  arc
 
interface  arcc
 
interface  arcx
 
interface  arcx_back
 
interface  arcy
 
interface  area
 

Functions/Subroutines

subroutine arc_dbl (XX1, YY1, XX2, YY2, ARCL)
 
subroutine arc_flt (XX1, YY1, XX2, YY2, ARCL)
 
subroutine area_dbl (SIDEA, SIDEB, SIDEC, AREA1)
 
subroutine area_flt (SIDE1, SIDE2, SIDE3, AREA1)
 
subroutine arcc_dbl (XX1, YY1, XX2, YY2, XXC, YYC)
 
subroutine arcc_flt (XX1, YY1, XX2, YY2, XXC, YYC)
 
subroutine arcx_dbl (XX1, YY1, XX2, YY2, ARCX1)
 
subroutine arcy_dbl (XX1, YY1, XX2, YY2, ARCY1)
 
subroutine arcy_flt (XX1, YY1, XX2, YY2, ARCY1)
 
subroutine arcx_flt (XX1, YY1, XX2, YY2, ARCX1)
 
subroutine arcx_back_dbl (XX1, YY1, XX2, YY2, ARCX1)
 
subroutine arcx_back_flt (XX1, YY1, XX2, YY2, ARCX1)
 
subroutine alloc_sphere_vars
 

Variables

real(sp), dimension(:,:), allocatable dltxne
 
real(sp), dimension(:,:), allocatable dltyne
 
real(sp), dimension(:,:), allocatable deltux
 
real(sp), dimension(:,:), allocatable deltuy
 
real(sp), dimension(:,:), allocatable sitau
 

Function/Subroutine Documentation

◆ alloc_sphere_vars()

subroutine mod_spherical::alloc_sphere_vars ( )

Definition at line 403 of file mod_spherical.f90.

403  USE lims
404  INTEGER NCT
405  INTEGER NDB
406  ndb = 1 !!GWC BASE THIS ON KIND
407 
408  nct = nt*3
409  ALLOCATE(dltxne(nct,2)) ;dltxne = zero
410  ALLOCATE(dltyne(nct,2)) ;dltyne = zero
411  ALLOCATE(deltux(nt,3)) ;deltux = zero
412  ALLOCATE(deltuy(nt,3)) ;deltuy = zero
413  ALLOCATE(sitau(nt,3)) ;sitau = zero
414 
415  memcnt = memcnt + nct*4*ndb + nt*9*ndb
416  RETURN
real(sp), dimension(:,:), allocatable dltxne
real(sp), dimension(:,:), allocatable deltux
real(sp), dimension(:,:), allocatable sitau
real(sp), dimension(:,:), allocatable dltyne
real(sp) memcnt
Definition: mod_main.f90:81
real(dp), parameter zero
Definition: mod_main.f90:882
real(sp), dimension(:,:), allocatable deltuy
integer nt
Definition: mod_main.f90:77

◆ arc_dbl()

subroutine mod_spherical::arc_dbl ( real(dp), intent(in)  XX1,
real(dp), intent(in)  YY1,
real(dp), intent(in)  XX2,
real(dp), intent(in)  YY2,
real(dp), intent(out)  ARCL 
)

Definition at line 94 of file mod_spherical.f90.

94  !----------------------------------------------------------------------------
95  ! function:
96  ! calculate the arc lenth for given two point on the spherical plane
97  ! input:
98  ! xx1,yy1,xx2,yy2 :are longitude and latitude of two points
99  ! output:
100  ! arcl : arc lenth of two points in spherical plane
101  !-----------------------------------------------------------------------------
102 
103  ! solve the arc length through the earth center
104  IMPLICIT NONE
105  REAL(DP) :: X1,Y1,X2,Y2,XA,YA,ZA,XB,YB,ZB,AB,AOB
106  REAL(DP),INTENT(OUT) :: ARCL
107  REAL(DP),INTENT(IN) :: XX1,YY1,XX2,YY2
108 
109  x1=xx1*deg2rad
110  y1=yy1*deg2rad
111 
112  x2=xx2*deg2rad
113  y2=yy2*deg2rad
114 
115  ! USE DOUBLE PRECISION COS AND SIN
116  xa=dcos(y1)*dcos(x1)
117  ya=dcos(y1)*dsin(x1)
118  za=dsin(y1)
119 
120  xb=dcos(y2)*dcos(x2)
121  yb=dcos(y2)*dsin(x2)
122  zb=dsin(y2)
123 
124  ab=dsqrt((xb-xa)**2+(yb-ya)**2+(zb-za)**2)
125  aob=(2.0_dp -ab*ab)/2.0_dp
126  aob=dacos(aob)
127  arcl=rearth*aob
128 
129  RETURN
real(dp), parameter rearth
Definition: mod_main.f90:884
real(dp), parameter deg2rad
Definition: mod_main.f90:885
Here is the caller graph for this function:

◆ arc_flt()

subroutine mod_spherical::arc_flt ( real(spa), intent(in)  XX1,
real(spa), intent(in)  YY1,
real(spa), intent(in)  XX2,
real(spa), intent(in)  YY2,
real(spa), intent(out)  ARCL 
)

Definition at line 133 of file mod_spherical.f90.

133  IMPLICIT NONE
134  REAL(SPA), INTENT(IN) :: XX1,YY1,XX2,YY2
135  REAL(SPA), INTENT(OUT) :: ARCL
136  REAL(DP) ARCL_DP
137  CALL arc_dbl(dble(xx1),dble(yy1),dble(xx2),dble(yy2),arcl_dp)
138  arcl = arcl_dp
subroutine arc_dbl(XX1, YY1, XX2, YY2, ARCL)
Here is the call graph for this function:

◆ arcc_dbl()

subroutine mod_spherical::arcc_dbl ( real(dp), intent(in)  XX1,
real(dp), intent(in)  YY1,
real(dp), intent(in)  XX2,
real(dp), intent(in)  YY2,
real(dp), intent(out)  XXC,
real(dp), intent(out)  YYC 
)

Definition at line 191 of file mod_spherical.f90.

191  IMPLICIT NONE
192  REAL(DP), INTENT(OUT) :: XXC,YYC
193  REAL(DP), INTENT(IN) :: XX1,YY1,XX2,YY2
194  REAL(DP) :: X1,Y1,X2,Y2
195 
196  x1=xx1*deg2rad
197  y1=yy1*deg2rad
198 
199  x2=xx2*deg2rad
200  y2=yy2*deg2rad
201 
202  xxc=dcos(y1)*dsin(x1)+dcos(y2)*dsin(x2)
203  ! XXC=XXC/(COS(Y1)*COS(X1)+COS(Y2)*COS(X2))
204  ! XXC=ATAN(XXC)
205  xxc=datan2(xxc,(dcos(y1)*dcos(x1)+dcos(y2)*dcos(x2)))
206  xxc=xxc/deg2rad
207 
208  ! IF(XXC .LT. 0.0) XXC=180.0+XXC
209  IF(xxc < 0.0_dp) xxc=360.0_dp+xxc
210 
211  yyc=dcos(y1)*dcos(y1)+dcos(y2)*dcos(y2)+2.0_dp*dcos(y1)*dcos(y2)*dcos(x1-x2)
212  ! YYC=SQRT(YYC)/(SIN(Y1)+SIN(Y2))
213  yyc=datan2(dsqrt(yyc),(dsin(y1)+dsin(y2)))
214  ! YYC=ATAN(YYC)
215  yyc=90.0_dp-yyc/deg2rad
216 
217  RETURN
real(dp), parameter deg2rad
Definition: mod_main.f90:885
Here is the caller graph for this function:

◆ arcc_flt()

subroutine mod_spherical::arcc_flt ( real(spa)  XX1,
real(spa)  YY1,
real(spa)  XX2,
real(spa)  YY2,
real(spa)  XXC,
real(spa)  YYC 
)

Definition at line 221 of file mod_spherical.f90.

221  IMPLICIT NONE
222  REAL(SPA) :: XX1,YY1,XX2,YY2
223  REAL(SPA) :: XXC,YYC
224  REAL(DP) :: XXC_DP,YYC_DP
225 
226  CALL arcc_dbl(dble(xx1),dble(yy1),dble(xx2),dble(yy2),xxc_dp,yyc_dp)
227  xxc = xxc_dp
228  yyc = yyc_dp
229 
subroutine arcc_dbl(XX1, YY1, XX2, YY2, XXC, YYC)
Here is the call graph for this function:

◆ arcx_back_dbl()

subroutine mod_spherical::arcx_back_dbl ( real(dp), intent(in)  XX1,
real(dp), intent(in)  YY1,
real(dp), intent(in)  XX2,
real(dp), intent(in)  YY2,
real(dp), intent(out)  ARCX1 
)

Definition at line 319 of file mod_spherical.f90.

319  IMPLICIT NONE
320  REAL(DP), INTENT(IN) :: XX1,YY1,XX2,YY2
321  REAL(DP), INTENT(OUT) :: ARCX1
322 
323  INTEGER I
324  INTEGER,PARAMETER ::NX=500
325  REAL(DP) :: X1,Y1,X2,Y2,TY,A1,A2,B1,B2,C1,C2,A,B,C,X(NX+1),Y(NX+1)
326  REAL(DP) :: XTMP
327 
328  IF(xx1 == xx2)THEN
329  arcx1=0.
330  ELSE
331  x1=xx1*deg2rad
332  y1=yy1*deg2rad
333 
334  x2=xx2*deg2rad
335  y2=yy2*deg2rad
336 
337  x(1)=x1
338  y(1)=y1
339  x(nx+1)=x2
340  y(nx+1)=y2
341 
342  xtmp=x(nx+1)-x(1)
343  IF(xtmp > pi)THEN
344  xtmp = real(-2*pi,dp)+xtmp
345  ELSE IF(xtmp < -pi)THEN
346  xtmp = real(2*pi,dp)+xtmp
347  END IF
348 
349  DO i=2,nx
350  x(i)=x(i-1)+xtmp/float(nx)
351  ! x(i)=x(i-1)+(x(nx+1)-x(1))/float(nx)
352  END DO
353 
354  a1=dcos(y(1))*dcos(x(1))
355  a2=dcos(y(nx+1))*dcos(x(nx+1))
356 
357  b1=dcos(y(1))*dsin(x(1))
358  b2=dcos(y(nx+1))*dsin(x(nx+1))
359 
360  c1=dsin(y(1))
361  c2=dsin(y(nx+1))
362 
363  a=a1*b2-a2*b1
364  b=b1*c2-b2*c1
365  c=a2*c1-a1*c2
366 
367  DO i=2,nx
368  y(i)=-b*dcos(x(i))-c*dsin(x(i))
369  y(i)=y(i)/a
370  y(i)=datan(y(i))
371  END DO
372 
373  arcx1=0.
374  DO i=1,nx
375  ty=0.5*(y(i)+y(i+1))
376  xtmp=x(i+1)-x(i)
377  IF(xtmp > pi)THEN
378  xtmp = real(-2*pi,dp)+xtmp
379  ELSE IF(xtmp < -pi)THEN
380  xtmp = real(2*pi,dp)+xtmp
381  END IF
382  arcx1=arcx1+rearth*dcos(ty)*xtmp
383  ! arcx1=arcx1+rearth*cos(ty)*(x(i+1)-x(i))
384  END DO
385  END IF
386 
387  RETURN
real(dp), parameter rearth
Definition: mod_main.f90:884
real(dp), parameter pi
Definition: mod_main.f90:880
integer, parameter dp
Definition: mod_prec.f90:52
real(dp), parameter deg2rad
Definition: mod_main.f90:885
Here is the caller graph for this function:

◆ arcx_back_flt()

subroutine mod_spherical::arcx_back_flt ( real(spa), intent(in)  XX1,
real(spa), intent(in)  YY1,
real(spa), intent(in)  XX2,
real(spa), intent(in)  YY2,
real(spa), intent(out)  ARCX1 
)

Definition at line 391 of file mod_spherical.f90.

391  IMPLICIT NONE
392  REAL(SPA), INTENT(IN) :: XX1,YY1,XX2,YY2
393  REAL(SPA), INTENT(OUT)::ARCX1
394 
395  REAL(DP) ::ARCX_DP
396 
397  CALL arcx_back_dbl(dble(xx1),dble(yy1),dble(xx2),dble(yy2),arcx_dp)
398  arcx1 = arcx_dp
399 
subroutine arcx_back_dbl(XX1, YY1, XX2, YY2, ARCX1)
Here is the call graph for this function:

◆ arcx_dbl()

subroutine mod_spherical::arcx_dbl ( real(dp), intent(in)  XX1,
real(dp), intent(in)  YY1,
real(dp), intent(in)  XX2,
real(dp), intent(in)  YY2,
real(dp), intent(out)  ARCX1 
)

Definition at line 234 of file mod_spherical.f90.

234  IMPLICIT NONE
235  REAL(DP), INTENT(IN) :: XX1,YY1,XX2,YY2
236  REAL(DP), INTENT(OUT)::ARCX1
237 
238  REAL(DP) :: X1,Y1,X2,Y2,TY
239  REAL(DP) :: XTMP
240 
241  IF(xx1 == xx2)THEN
242  arcx1=0.0_dp
243  ELSE
244  x1=xx1*deg2rad
245  y1=yy1*deg2rad
246 
247  x2=xx2*deg2rad
248  y2=yy2*deg2rad
249 
250  xtmp = x2-x1
251  IF(xtmp > pi)THEN
252  xtmp = real(-2*pi,dp)+xtmp
253  ELSE IF(xtmp < -pi)THEN
254  xtmp = real(2*pi,dp)+xtmp
255  END IF
256 
257  ty=0.5_dp*(y2+y1)
258  arcx1=rearth*dcos(ty)*xtmp
259  END IF
260 
261  RETURN
real(dp), parameter rearth
Definition: mod_main.f90:884
real(dp), parameter pi
Definition: mod_main.f90:880
integer, parameter dp
Definition: mod_prec.f90:52
real(dp), parameter deg2rad
Definition: mod_main.f90:885
Here is the caller graph for this function:

◆ arcx_flt()

subroutine mod_spherical::arcx_flt ( real(spa), intent(in)  XX1,
real(spa), intent(in)  YY1,
real(spa), intent(in)  XX2,
real(spa), intent(in)  YY2,
real(spa), intent(out)  ARCX1 
)

Definition at line 307 of file mod_spherical.f90.

307  IMPLICIT NONE
308  REAL(SPA), INTENT(IN) :: XX1,YY1,XX2,YY2
309  REAL(SPA), INTENT(OUT)::ARCX1
310 
311  REAL(DP) ::ARCX_DP
312 
313  CALL arcx_dbl(dble(xx1),dble(yy1),dble(xx2),dble(yy2),arcx_dp)
314  arcx1 = arcx_dp
315 
subroutine arcx_dbl(XX1, YY1, XX2, YY2, ARCX1)
Here is the call graph for this function:

◆ arcy_dbl()

subroutine mod_spherical::arcy_dbl ( real(dp), intent(in)  XX1,
real(dp), intent(in)  YY1,
real(dp), intent(in)  XX2,
real(dp), intent(in)  YY2,
real(dp), intent(out)  ARCY1 
)

Definition at line 265 of file mod_spherical.f90.

265  IMPLICIT NONE
266  REAL(DP), INTENT(IN) :: XX1,YY1,XX2,YY2
267  REAL(DP), INTENT(OUT)::ARCY1
268 
269  REAL(DP) :: X1,Y1,X2,Y2,TY
270  REAL(DP) :: YTMP
271 
272  IF(yy1 == yy2)THEN
273  arcy1=0.0_dp
274  ELSE
275  x1=xx1*deg2rad
276  y1=yy1*deg2rad
277 
278  x2=xx2*deg2rad
279  y2=yy2*deg2rad
280 
281  ytmp = y2-y1
282  IF(ytmp > pi)THEN
283  ytmp = real(-2*pi,dp)+ytmp
284  ELSE IF(ytmp < -pi)THEN
285  ytmp = real(2*pi,dp)+ytmp
286  END IF
287 
288  arcy1=rearth*ytmp
289  END IF
290 
291  RETURN
real(dp), parameter rearth
Definition: mod_main.f90:884
real(dp), parameter pi
Definition: mod_main.f90:880
integer, parameter dp
Definition: mod_prec.f90:52
real(dp), parameter deg2rad
Definition: mod_main.f90:885
Here is the caller graph for this function:

◆ arcy_flt()

subroutine mod_spherical::arcy_flt ( real(spa), intent(in)  XX1,
real(spa), intent(in)  YY1,
real(spa), intent(in)  XX2,
real(spa), intent(in)  YY2,
real(spa), intent(out)  ARCY1 
)

Definition at line 295 of file mod_spherical.f90.

295  IMPLICIT NONE
296  REAL(SPA), INTENT(IN) :: XX1,YY1,XX2,YY2
297  REAL(SPA), INTENT(OUT)::ARCY1
298 
299  REAL(DP) ::ARCY_DP
300 
301  CALL arcy_dbl(dble(xx1),dble(yy1),dble(xx2),dble(yy2),arcy_dp)
302  arcy1 = arcy_dp
303 
subroutine arcy_dbl(XX1, YY1, XX2, YY2, ARCY1)
Here is the call graph for this function:

◆ area_dbl()

subroutine mod_spherical::area_dbl ( real(dp), intent(in)  SIDEA,
real(dp), intent(in)  SIDEB,
real(dp), intent(in)  SIDEC,
real(dp), intent(out)  AREA1 
)

Definition at line 143 of file mod_spherical.f90.

143  !--------------------------------------------------------------------
144  ! function:
145  ! calculate the area of a triangle on a spherical plane
146  ! input:
147  ! side1,side2 and side3: are 3 arc lenth for one triangle
148  ! output:
149  ! areal: is area of a triangle on a spherical plane
150  !--------------------------------------------------------------------
151  IMPLICIT NONE
152  REAL(DP), INTENT(IN) :: SIDEA,SIDEB,SIDEC
153  REAL(DP), INTENT(OUT) :: AREA1
154  REAL(DP) :: SIDE1,SIDE2,SIDE3
155  REAL(DP) :: PSUM,PM,QMJC
156 
157  side1=sidea/rearth
158  side2=sideb/rearth
159  side3=sidec/rearth
160 
161  ! SLOWER TO CHECK THEN TO CALCULATE
162  ! IF(SIDE1 == 0.0_DP .OR. SIDE2 == 0.0_DP .OR. SIDE3 == 0.0_DP)THEN
163  ! AREA1=0.0_DP
164  ! ELSE
165 
166  psum=0.5_dp*(side1+side2+side3)
167  pm=dsin(psum)*dsin(psum-side1)*dsin(psum-side2)*dsin(psum-side3)
168  pm=dsqrt(pm)/(2.0_dp*dcos(side1*0.5_dp)*dcos(side2*0.5_dp)*dcos(side3*0.5_dp))
169  qmjc = 2.0_dp*dasin(pm)
170 
171  area1=rearth*rearth*qmjc
172 
173  ! END IF
174 
175  RETURN
real(dp), parameter rearth
Definition: mod_main.f90:884
Here is the caller graph for this function:

◆ area_flt()

subroutine mod_spherical::area_flt ( real(spa), intent(in)  SIDE1,
real(spa), intent(in)  SIDE2,
real(spa), intent(in)  SIDE3,
real(spa), intent(out)  AREA1 
)

Definition at line 179 of file mod_spherical.f90.

179  IMPLICIT NONE
180  REAL(SPA), INTENT(IN) :: SIDE1,SIDE2,SIDE3
181  REAL(SPA), INTENT(OUT) :: AREA1
182  REAL(DP) :: AREA_DP
183 
184  CALL area_dbl(dble(side1),dble(side2),dble(side3),area_dp)
185  area1=area_dp
186 
subroutine area_dbl(SIDEA, SIDEB, SIDEC, AREA1)
Here is the call graph for this function:

Variable Documentation

◆ deltux

real(sp), dimension(:,:), allocatable mod_spherical::deltux

Definition at line 53 of file mod_spherical.f90.

53  REAL(SP), ALLOCATABLE :: DELTUX(:,:)

◆ deltuy

real(sp), dimension(:,:), allocatable mod_spherical::deltuy

Definition at line 54 of file mod_spherical.f90.

54  REAL(SP), ALLOCATABLE :: DELTUY(:,:)

◆ dltxne

real(sp), dimension(:,:), allocatable mod_spherical::dltxne

Definition at line 50 of file mod_spherical.f90.

50  REAL(SP), ALLOCATABLE :: DLTXNE(:,:)

◆ dltyne

real(sp), dimension(:,:), allocatable mod_spherical::dltyne

Definition at line 51 of file mod_spherical.f90.

51  REAL(SP), ALLOCATABLE :: DLTYNE(:,:)

◆ sitau

real(sp), dimension(:,:), allocatable mod_spherical::sitau

Definition at line 55 of file mod_spherical.f90.

55  REAL(SP), ALLOCATABLE :: SITAU(:,:)