source: LMDZ6/trunk/libf/dyn3d_common/interpre.f90 @ 5252

Last change on this file since 5252 was 5246, checked in by abarral, 7 weeks ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.1 KB
RevLine 
[524]1!
[1403]2! $Id: interpre.f90 5246 2024-10-21 12:58:45Z abarral $
[524]3!
[5246]4 subroutine interpre(q,qppm,w,fluxwppm,masse, &
5         apppm,bpppm,massebx,masseby,pbaru,pbarv, &
6         unatppm,vnatppm,psppm)
[524]7
[5246]8  USE comconst_mod, ONLY: g
9  USE comvert_mod, ONLY: ap, bp
[1403]10
[5246]11   implicit none
[524]12
[5246]13  include "dimensions.h"
14  include "paramet.h"
15  include "comdissip.h"
16  include "comgeom2.h"
17  include "description.h"
[524]18
[5246]19  !---------------------------------------------------
20  ! Arguments
21  real :: apppm(llm+1),bpppm(llm+1)
22  real :: q(iip1,jjp1,llm),qppm(iim,jjp1,llm)
23  !---------------------------------------------------
24  real :: masse(iip1,jjp1,llm)
25  real :: massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
26  real :: w(iip1,jjp1,llm)
27  real :: fluxwppm(iim,jjp1,llm)
28  real :: pbaru(iip1,jjp1,llm )
29  real :: pbarv(iip1,jjm,llm)
30  real :: unatppm(iim,jjp1,llm)
31  real :: vnatppm(iim,jjp1,llm)
32  real :: psppm(iim,jjp1)
33  !---------------------------------------------------
34  ! Local
35  real :: vnat(iip1,jjp1,llm)
36  real :: unat(iip1,jjp1,llm)
37  real :: fluxw(iip1,jjp1,llm)
38  real :: smass(iip1,jjp1)
39  !----------------------------------------------------
40  integer :: l,ij,i,j
[524]41
[5246]42    ! CALCUL DE LA PRESSION DE SURFACE
43    ! Les coefficients ap et bp sont passés en common
44    ! Calcul de la pression au sol en mb optimisée pour
45    ! la vectorialisation
46
47     do j=1,jjp1
48         do i=1,iip1
49            smass(i,j)=0.
50         enddo
51     enddo
52
53     do l=1,llm
[524]54         do j=1,jjp1
55             do i=1,iip1
[5246]56                smass(i,j)=smass(i,j)+masse(i,j,l)
[524]57             enddo
58         enddo
[5246]59     enddo
[524]60
[5246]61     do j=1,jjp1
62         do i=1,iim
63             psppm(i,j)=smass(i,j)/aire(i,j)*g*0.01
64         end do
65     end do
66
67  ! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
68  ! Le programme ppm3d travaille avec les composantes
69  ! de vitesse et pas les flux, on doit donc passer de l'un à l'autre
70  ! Dans le même temps, on fait le changement d'orientation du vent en v
71  do l=1,llm
72      do j=1,jjm
73          do i=1,iip1
74              vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)
[524]75          enddo
76      enddo
[5246]77      do  i=1,iim
78      vnat(i,jjp1,l)=0.
[524]79      enddo
[5246]80      do j=1,jjp1
81          do i=1,iip1
82              unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j)
83          enddo
[524]84      enddo
[5246]85  enddo
[524]86
[5246]87  ! CALCUL DU FLUX MASSIQUE VERTICAL
88  ! Flux en l=1 (sol) nul
89  fluxw=0.
90  do l=1,llm
91       do j=1,jjp1
92          do i=1,iip1
93           fluxw(i,j,l)=w(i,j,l)*g*0.01/aire(i,j)
94            ! print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
95  ! c                      'w(i,j,l)=',w(i,j,l)
96          enddo
97       enddo
98  enddo
[524]99
[5246]100  ! INVERSION DES NIVEAUX
101  ! le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport
102  ! de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
103  ! On passe donc des niveaux du LMDZ à ceux de Lin
[524]104
[5246]105  do l=1,llm+1
106      apppm(l)=ap(llm+2-l)
107      bpppm(l)=bp(llm+2-l)
108  enddo
[524]109
[5246]110  do l=1,llm
111      do j=1,jjp1
112         do i=1,iim
113             unatppm(i,j,l)=unat(i,j,llm-l+1)
114             vnatppm(i,j,l)=vnat(i,j,llm-l+1)
115             fluxwppm(i,j,l)=fluxw(i,j,llm-l+1)
116             qppm(i,j,l)=q(i,j,llm-l+1)
117         enddo
118      enddo
119  enddo
[524]120
[5246]121  return
122end subroutine interpre
[524]123
[5246]124
125
126
127
128
Note: See TracBrowser for help on using the repository browser.