trunk/dyn3d/interpre.f


! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/interpre.F,v 1.1.1.1 2004/05/19
! 12:53:07 lmdzadmin Exp $

SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, apppm, bpppm, massebx, &
    masseby, pbaru, pbarv, unatppm, vnatppm, psppm)

  USE dimens_m
  USE paramet_m
  USE comconst
  USE disvert_m
  USE conf_gcm_m
  USE conf_gcm_m
  USE comgeom
  USE temps
  IMPLICIT NONE

  ! ---------------------------------------------------
  ! Arguments
  REAL apppm(llm+1), bpppm(llm+1)
  REAL q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
  ! ---------------------------------------------------
  REAL masse(iip1, jjp1, llm)
  REAL massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
  REAL w(iip1, jjp1, llm+1)
  REAL fluxwppm(iim, jjp1, llm)
  REAL, INTENT (IN) :: pbaru(iip1, jjp1, llm)
  REAL, INTENT (IN) :: pbarv(iip1, jjm, llm)
  REAL unatppm(iim, jjp1, llm)
  REAL vnatppm(iim, jjp1, llm)
  REAL psppm(iim, jjp1)
  ! ---------------------------------------------------
  ! Local
  REAL vnat(iip1, jjp1, llm)
  REAL unat(iip1, jjp1, llm)
  REAL fluxw(iip1, jjp1, llm)
  REAL smass(iip1, jjp1)
  ! ----------------------------------------------------
  INTEGER l, ij, i, j

  ! CALCUL DE LA PRESSION DE SURFACE
  ! Les coefficients ap et bp sont passés en common
  ! Calcul de la pression au sol en mb optimisée pour
  ! la vectorialisation

  DO j = 1, jjp1
    DO i = 1, iip1
      smass(i, j) = 0.
    END DO
  END DO

  DO l = 1, llm
    DO j = 1, jjp1
      DO i = 1, iip1
        smass(i, j) = smass(i, j) + masse(i, j, l)
      END DO
    END DO
  END DO

  DO j = 1, jjp1
    DO i = 1, iim
      psppm(i, j) = smass(i, j)/aire_2d(i, j)*g*0.01
    END DO
  END DO

  ! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
  ! Le programme ppm3d travaille avec les composantes
  ! de vitesse et pas les flux, on doit donc passer de l'un à l'autre
  ! Dans le même temps, on fait le changement d'orientation du vent en v
  DO l = 1, llm
    DO j = 1, jjm
      DO i = 1, iip1
        vnat(i, j, l) = -pbarv(i, j, l)/masseby(i, j, l)*cv_2d(i, j)
      END DO
    END DO
    DO i = 1, iim
      vnat(i, jjp1, l) = 0.
    END DO
    DO j = 1, jjp1
      DO i = 1, iip1
        unat(i, j, l) = pbaru(i, j, l)/massebx(i, j, l)*cu_2d(i, j)
      END DO
    END DO
  END DO

  ! CALCUL DU FLUX MASSIQUE VERTICAL
  ! Flux en l=1 (sol) nul
  fluxw = 0.
  DO l = 1, llm
    DO j = 1, jjp1
      DO i = 1, iip1
        fluxw(i, j, l) = w(i, j, l)*g*0.01/aire_2d(i, j)
      END DO
    END DO
  END DO

  ! INVERSION DES NIVEAUX
  ! le programme ppm3d travaille avec une 3ème coordonnée inversée par
  ! rapport
  ! de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
  ! On passe donc des niveaux du LMDZ à ceux de Lin

  DO l = 1, llm + 1
    apppm(l) = ap(llm+2-l)
    bpppm(l) = bp(llm+2-l)
  END DO

  DO l = 1, llm
    DO j = 1, jjp1
      DO i = 1, iim
        unatppm(i, j, l) = unat(i, j, llm-l+1)
        vnatppm(i, j, l) = vnat(i, j, llm-l+1)
        fluxwppm(i, j, l) = fluxw(i, j, llm-l+1)
        qppm(i, j, l) = q(i, j, llm-l+1)
      END DO
    END DO
  END DO

  RETURN
END SUBROUTINE interpre


1
2	! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/interpre.F,v 1.1.1.1 2004/05/19
3	! 12:53:07 lmdzadmin Exp $
4
5	SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, apppm, bpppm, massebx, &
6	masseby, pbaru, pbarv, unatppm, vnatppm, psppm)
7
8	USE dimens_m
9	USE paramet_m
10	USE comconst
11	USE disvert_m
12	USE conf_gcm_m
13	USE conf_gcm_m
14	USE comgeom
15	USE temps
16	IMPLICIT NONE
17
18	! ---------------------------------------------------
19	! Arguments
20	REAL apppm(llm+1), bpppm(llm+1)
21	REAL q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
22	! ---------------------------------------------------
23	REAL masse(iip1, jjp1, llm)
24	REAL massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
25	REAL w(iip1, jjp1, llm+1)
26	REAL fluxwppm(iim, jjp1, llm)
27	REAL, INTENT (IN) :: pbaru(iip1, jjp1, llm)
28	REAL, INTENT (IN) :: pbarv(iip1, jjm, llm)
29	REAL unatppm(iim, jjp1, llm)
30	REAL vnatppm(iim, jjp1, llm)
31	REAL psppm(iim, jjp1)
32	! ---------------------------------------------------
33	! Local
34	REAL vnat(iip1, jjp1, llm)
35	REAL unat(iip1, jjp1, llm)
36	REAL fluxw(iip1, jjp1, llm)
37	REAL smass(iip1, jjp1)
38	! ----------------------------------------------------
39	INTEGER l, ij, i, j
40
41	! CALCUL DE LA PRESSION DE SURFACE
42	! Les coefficients ap et bp sont passés en common
43	! Calcul de la pression au sol en mb optimisée pour
44	! la vectorialisation
45
46	DO j = 1, jjp1
47	DO i = 1, iip1
48	smass(i, j) = 0.
49	END DO
50	END DO
51
52	DO l = 1, llm
53	DO j = 1, jjp1
54	DO i = 1, iip1
55	smass(i, j) = smass(i, j) + masse(i, j, l)
56	END DO
57	END DO
58	END DO
59
60	DO j = 1, jjp1
61	DO i = 1, iim
62	psppm(i, j) = smass(i, j)/aire_2d(i, j)g0.01
63	END DO
64	END DO
65
66	! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
67	! Le programme ppm3d travaille avec les composantes
68	! de vitesse et pas les flux, on doit donc passer de l'un à l'autre
69	! Dans le même temps, on fait le changement d'orientation du vent en v
70	DO l = 1, llm
71	DO j = 1, jjm
72	DO i = 1, iip1
73	vnat(i, j, l) = -pbarv(i, j, l)/masseby(i, j, l)*cv_2d(i, j)
74	END DO
75	END DO
76	DO i = 1, iim
77	vnat(i, jjp1, l) = 0.
78	END DO
79	DO j = 1, jjp1
80	DO i = 1, iip1
81	unat(i, j, l) = pbaru(i, j, l)/massebx(i, j, l)*cu_2d(i, j)
82	END DO
83	END DO
84	END DO
85
86	! CALCUL DU FLUX MASSIQUE VERTICAL
87	! Flux en l=1 (sol) nul
88	fluxw = 0.
89	DO l = 1, llm
90	DO j = 1, jjp1
91	DO i = 1, iip1
92	fluxw(i, j, l) = w(i, j, l)g0.01/aire_2d(i, j)
93	END DO
94	END DO
95	END DO
96
97	! INVERSION DES NIVEAUX
98	! le programme ppm3d travaille avec une 3ème coordonnée inversée par
99	! rapport
100	! de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
101	! On passe donc des niveaux du LMDZ à ceux de Lin
102
103	DO l = 1, llm + 1
104	apppm(l) = ap(llm+2-l)
105	bpppm(l) = bp(llm+2-l)
106	END DO
107
108	DO l = 1, llm
109	DO j = 1, jjp1
110	DO i = 1, iim
111	unatppm(i, j, l) = unat(i, j, llm-l+1)
112	vnatppm(i, j, l) = vnat(i, j, llm-l+1)
113	fluxwppm(i, j, l) = fluxw(i, j, llm-l+1)
114	qppm(i, j, l) = q(i, j, llm-l+1)
115	END DO
116	END DO
117	END DO
118
119	RETURN
120	END SUBROUTINE interpre
121
122
123
124
125
126