Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / EXTRACTDIA / ff.f90
1 !     ############################################################
2       MODULE MODI_FF
3 !     ############################################################
4 !
5 INTERFACE
6       SUBROUTINE FF(PU,PV,PFFVENT,KVEXT,KHEXT,KGRID)
7 !
8 REAL, INTENT(IN), DIMENSION (:,:,:) :: PU,PV    ! composantes u et V
9 INTEGER, INTENT(IN) :: KVEXT,KHEXT              ! points a exclure
10 REAL, INTENT(INOUT), DIMENSION (:,:,:) :: PFFVENT ! module vent
11 INTEGER, INTENT(IN) :: KGRID                    ! grille des champs PU,PV
12 !
13 END SUBROUTINE FF
14 END INTERFACE
15 END MODULE MODI_FF
16 !
17 !------------------------------------------------------------------------------
18 !
19
20 !     ################
21       SUBROUTINE FF(PU,PV,PFFVENT,KVEXT,KHEXT,KGRID)
22 !     ################
23 !
24 !!****  *FF* - 
25 !! 
26 !!
27 !!    PURPOSE
28 !!    -------
29 !  calcul du module du vent
30 !
31 !!**  METHOD
32 !! 
33 !!    AUTHORS
34 !!    -------
35 !!     N. Asencio * CNRM*
36 !!
37 !!    Copyright 2003,  Meteo-France and Laboratoire d'Aerologie
38 !!    All Rights Reserved
39 !!
40 !!    MODIFICATIONS
41 !!    -------------
42 !-------------------------------------------------------------------------------
43 !
44 !*       0.    DECLARATIONS
45 !              ------------
46 !
47 USE MODN_NCAR,  ONLY: XSPVAL
48 !
49 IMPLICIT NONE
50 !
51 !*       0.1   Arguments d'appel
52 !
53 REAL, INTENT(IN), DIMENSION (:,:,:) :: PU,PV    ! composantes u et V
54 INTEGER, INTENT(IN) :: KVEXT,KHEXT              ! points a exclure
55 REAL, INTENT(INOUT), DIMENSION (:,:,:) :: PFFVENT ! module vent
56 INTEGER, INTENT(IN) :: KGRID                    ! grille des champs PU,PV
57 !
58 !*       0.2 variables locales
59 !
60 INTEGER :: JI,JJ,JK  ! loop indexes
61 INTEGER :: JK1,JK2
62 !
63 !-------------------------------------------------------------------------------
64 !
65 IF (SIZE(PU,3) == 1) THEN
66     JK1=1 
67     JK2=1
68 ELSE
69     JK1=1+KVEXT
70     JK2=SIZE(PU,3)-KVEXT
71 ENDIF
72 IF (KGRID == 1 ) THEN
73   ! les 2 composantes sont au point de masse UM10,VM10 ou colocalis√©es
74   ! apres interpolation horizontale
75   DO JK=JK1,JK2
76     DO JJ=1+KHEXT,SIZE(PU,2)-KHEXT
77       DO JI=1+KHEXT,SIZE(PU,1)-KHEXT
78       ! calcul de la force du vent
79         IF ( PU(JI,JJ,JK) /= XSPVAL .AND. PV(JI,JJ,JK) /= XSPVAL) then
80           PFFVENT(JI,JJ,JK)=sqrt( PU(JI,JJ,JK)**2+ PV(JI,JJ,JK)**2 )
81         ELSE
82           PFFVENT(JI,JJ,JK)=XSPVAL
83         ENDIF
84       end DO
85     end DO
86   end DO
87 ELSE
88   ! les 2 composantes sont dans les grilles U et V Mesonh
89   DO JK=JK1,JK2
90     DO JJ=1+KHEXT,SIZE(PU,2)-KHEXT
91       DO JI=1+KHEXT,SIZE(PU,1)-KHEXT
92       ! calcul de la force du vent
93         IF (PU(JI,JJ,JK) /= XSPVAL .AND. PU(JI+1,JJ,JK) /= XSPVAL &
94            .AND. PV(JI,JJ,JK) /= XSPVAL .AND. PV(JI,JJ+1,JK) /= XSPVAL) then
95           PFFVENT(JI,JJ,JK) = sqrt(0.25*(PU(JI,JJ,JK)+PU(JI+1,JJ,JK))**2+   &
96                                    0.25*(PV(JI,JJ,JK)+PV(JI,JJ+1,JK))**2    )
97         ELSE
98           PFFVENT(JI,JJ,JK) = XSPVAL
99         ENDIF
100       end DO
101     end DO
102   end DO
103 ENDIF
104 !
105 END SUBROUTINE FF