dyn3d/Inter_barxy/inter_bary.f90

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	guez	98	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