Changeset 5246 for LMDZ6/trunk/libf/dyn3d_common/interpre.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
-
LMDZ6/trunk/libf/dyn3d_common/interpre.f90 (moved) (moved from LMDZ6/trunk/libf/dyn3d_common/interpre.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d_common/interpre.f90
r5245 r5246 2 2 ! $Id$ 3 3 ! 4 subroutine interpre(q,qppm,w,fluxwppm,masse,5 s apppm,bpppm,massebx,masseby,pbaru,pbarv,6 sunatppm,vnatppm,psppm)4 subroutine interpre(q,qppm,w,fluxwppm,masse, & 5 apppm,bpppm,massebx,masseby,pbaru,pbarv, & 6 unatppm,vnatppm,psppm) 7 7 8 9 8 USE comconst_mod, ONLY: g 9 USE comvert_mod, ONLY: ap, bp 10 10 11 11 implicit none 12 12 13 14 15 16 17 13 include "dimensions.h" 14 include "paramet.h" 15 include "comdissip.h" 16 include "comgeom2.h" 17 include "description.h" 18 18 19 c---------------------------------------------------20 c Arguments 21 realapppm(llm+1),bpppm(llm+1)22 realq(iip1,jjp1,llm),qppm(iim,jjp1,llm)23 c---------------------------------------------------24 real masse(iip1,jjp1,llm)25 real massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)26 realw(iip1,jjp1,llm)27 realfluxwppm(iim,jjp1,llm)28 realpbaru(iip1,jjp1,llm )29 realpbarv(iip1,jjm,llm)30 realunatppm(iim,jjp1,llm)31 realvnatppm(iim,jjp1,llm)32 realpsppm(iim,jjp1)33 c---------------------------------------------------34 cLocal35 realvnat(iip1,jjp1,llm)36 realunat(iip1,jjp1,llm)37 realfluxw(iip1,jjp1,llm)38 realsmass(iip1,jjp1)39 c----------------------------------------------------40 integerl,ij,i,j19 !--------------------------------------------------- 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 41 41 42 c CALCUL DE LA PRESSION DE SURFACE 43 c Les coefficients ap et bp sont passés en common 44 c Calcul de la pression au sol en mb optimisée pour 45 c la vectorialisation 46 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 47 54 do j=1,jjp1 48 55 do i=1,iip1 49 smass(i,j)= 0.56 smass(i,j)=smass(i,j)+masse(i,j,l) 50 57 enddo 51 58 enddo 59 enddo 52 60 53 do l=1,llm 54 do j=1,jjp1 55 do i=1,iip1 56 smass(i,j)=smass(i,j)+masse(i,j,l) 57 enddo 58 enddo 59 enddo 60 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 c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS 68 c Le programme ppm3d travaille avec les composantes 69 c de vitesse et pas les flux, on doit donc passer de l'un à l'autre 70 c 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) 75 enddo 76 enddo 77 do i=1,iim 78 vnat(i,jjp1,l)=0. 79 enddo 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 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) 84 75 enddo 85 76 enddo 86 87 c CALCUL DU FLUX MASSIQUE VERTICAL 88 c 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 C print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l), 95 C c 'w(i,j,l)=',w(i,j,l) 96 enddo 97 enddo 77 do i=1,iim 78 vnat(i,jjp1,l)=0. 98 79 enddo 99 100 c INVERSION DES NIVEAUX 101 c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport 102 c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface 103 c On passe donc des niveaux du LMDZ à ceux de Lin 104 105 do l=1,llm+1 106 apppm(l)=ap(llm+2-l) 107 bpppm(l)=bp(llm+2-l) 108 enddo 109 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 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 119 84 enddo 120 121 return 122 end 85 enddo 86 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 99 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 104 105 do l=1,llm+1 106 apppm(l)=ap(llm+2-l) 107 bpppm(l)=bp(llm+2-l) 108 enddo 109 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 120 121 return 122 end subroutine interpre 123 123 124 124
Note: See TracChangeset
for help on using the changeset viewer.
