dyn3d/Inter_barxy/inter_bary.f

module inter_bary_m

  implicit none

contains


  !******************************

  function inter_bary(yjdat, fdat, yjmod)

    ! From dyn3d/inter_bary.F, version 1.1.1.1 2004/05/19 12:53:06
    ! Authors: R. Sadourny, P. Le Van

    ! Interpolation barycentrique basée sur les aires.
    ! Version unidimensionnelle, en latitude.
    ! L'indice 1 correspond à l'interface maille 1 -- maille 2.

    use nr_util, only: assert


    REAL, intent(in):: yjdat(:)
    ! (angles, ordonnées des interfaces des mailles des données, in
    ! degrees, in increasing order)

    REAL, intent(in):: fdat(:) ! champ de données

    REAL, intent(in):: yjmod(:)
    ! (ordonnées des interfaces des mailles du modèle)
    ! (in degrees, in strictly increasing order)

    REAL inter_bary(size(yjmod)) ! champ du modèle

    ! Variables local to the procedure:

    REAL y0, dy, dym
    INTEGER jdat ! indice du champ de données
    integer jmod ! indice du champ du modèle

    !------------------------------------

    call assert(size(yjdat) == size(fdat), "inter_bary")

    ! Initialisation des variables
    inter_bary(:) = 0.
    y0    = -90.
    dym   = 0.
    jmod  = 1
    jdat  = 1

    do while (jmod <= size(yjmod))
       do while (yjmod(jmod) > yjdat(jdat))
          dy         = yjdat(jdat) - y0
          dym        = dym + dy
          inter_bary(jmod) = inter_bary(jmod) + dy * fdat(jdat)
          y0         = yjdat(jdat)
          jdat       = jdat + 1
       end do
       IF (yjmod(jmod) < yjdat(jdat)) THEN
          dy         = yjmod(jmod) - y0
          dym        = dym + dy
          inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
          y0         = yjmod(jmod)
          dym        = 0.
          jmod       = jmod + 1
       ELSE
          ! {yjmod(jmod) == yjdat(jdat)}
          dy         = yjmod(jmod) - y0
          dym        = dym + dy
          inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
          y0         = yjmod(jmod)
          dym        = 0.
          jmod       = jmod + 1
          jdat       = jdat + 1
       END IF
    end do
    ! Le test de fin suppose que l'interface 0 est commune aux deux
    ! grilles "yjdat" et "yjmod".

  END function inter_bary

end module inter_bary_m
1	module inter_bary_m
2
3	implicit none
4
5	contains
6
7
8	!******************************
9
10	function inter_bary(yjdat, fdat, yjmod)
11
12	! From dyn3d/inter_bary.F, version 1.1.1.1 2004/05/19 12:53:06
13	! Authors: R. Sadourny, P. Le Van
14
15	! Interpolation barycentrique basée sur les aires.
16	! Version unidimensionnelle, en latitude.
17	! L'indice 1 correspond à l'interface maille 1 -- maille 2.
18
19	use nr_util, only: assert
20
21
22	REAL, intent(in):: yjdat(:)
23	! (angles, ordonnées des interfaces des mailles des données, in
24	! degrees, in increasing order)
25
26	REAL, intent(in):: fdat(:) ! champ de données
27
28	REAL, intent(in):: yjmod(:)
29	! (ordonnées des interfaces des mailles du modèle)
30	! (in degrees, in strictly increasing order)
31
32	REAL inter_bary(size(yjmod)) ! champ du modèle
33
34	! Variables local to the procedure:
35
36	REAL y0, dy, dym
37	INTEGER jdat ! indice du champ de données
38	integer jmod ! indice du champ du modèle
39
40	!------------------------------------
41
42	call assert(size(yjdat) == size(fdat), "inter_bary")
43
44	! Initialisation des variables
45	inter_bary(:) = 0.
46	y0 = -90.
47	dym = 0.
48	jmod = 1
49	jdat = 1
50
51	do while (jmod <= size(yjmod))
52	do while (yjmod(jmod) > yjdat(jdat))
53	dy = yjdat(jdat) - y0
54	dym = dym + dy
55	inter_bary(jmod) = inter_bary(jmod) + dy * fdat(jdat)
56	y0 = yjdat(jdat)
57	jdat = jdat + 1
58	end do
59	IF (yjmod(jmod) < yjdat(jdat)) THEN
60	dy = yjmod(jmod) - y0
61	dym = dym + dy
62	inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
63	y0 = yjmod(jmod)
64	dym = 0.
65	jmod = jmod + 1
66	ELSE
67	! {yjmod(jmod) == yjdat(jdat)}
68	dy = yjmod(jmod) - y0
69	dym = dym + dy
70	inter_bary(jmod) = (inter_bary(jmod) + dy * fdat(jdat)) / dym
71	y0 = yjmod(jmod)
72	dym = 0.
73	jmod = jmod + 1
74	jdat = jdat + 1
75	END IF
76	end do
77	! Le test de fin suppose que l'interface 0 est commune aux deux
78	! grilles "yjdat" et "yjmod".
79
80	END function inter_bary
81
82	end module inter_bary_m