Changeset 1474
- Timestamp:
- Jan 14, 2011, 12:04:45 PM (13 years ago)
- Location:
- LMDZ5/branches/LMDZ5V2.0-dev/libf
- Files:
-
- 2 edited
- 2 moved
-
dyn3d/iniacademic.F90 (modified) (2 diffs)
-
dyn3d/ugeostr.F90 (moved) (moved from LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3d/ugeostr.F) (1 diff)
-
dyn3dpar/iniacademic.F90 (modified) (2 diffs)
-
dyn3dpar/ugeostr.F90 (moved) (moved from LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3dpar/ugeostr.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3d/iniacademic.F90
r1472 r1474 16 16 17 17 ! Author: Frederic Hourdin original: 15/01/93 18 ! The forcing defined here is from Held and Suarez, 1994, Bulletin 19 ! of the American Meteorological Society, 75, 1825. 18 20 19 21 IMPLICIT NONE … … 54 56 REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches 55 57 REAL phi(ip1jmp1,llm) ! geopotentiel 56 REAL ddsin,tetastrat,zsig,tetapv,w_pv ! variables auxiliaires 58 REAL ddsin,zsig,tetapv,w_pv ! variables auxiliaires 59 real tetastrat ! potential temperature in the stratosphere, in K 57 60 real tetajl(jjp1,llm) 58 61 INTEGER i,j,l,lsup,ij -
LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3d/ugeostr.F90
r1472 r1474 2 2 ! $Id$ 3 3 ! 4 4 subroutine ugeostr(phi,ucov) 5 5 6 ! Calcul du vent covariant geostrophique a partir du champ de 7 ! geopotentiel. 8 ! We actually compute: (1 - cos^8 \phi) u_g 9 ! to have a wind going smoothly to 0 at the equator. 10 ! We assume that the surface pressure is uniform so that model 11 ! levels are pressure levels. 6 12 7 c Calcul du vent covariant geostrophique a partir du champs de 8 c geopotentiel en supposant que le vent au sol est nul. 13 implicit none 9 14 10 implicit none 15 include "dimensions.h" 16 include "paramet.h" 17 include "comconst.h" 18 include "comgeom2.h" 11 19 12 #include "dimensions.h" 13 #include "paramet.h" 14 #include "comconst.h" 15 #include "comgeom2.h" 20 real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm) 21 real um(jjm,llm),fact,u(iip1,jjm,llm) 22 integer i,j,l 16 23 17 real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm) 18 real um(jjm,llm),fact,u(iip1,jjm,llm) 19 integer i,j,l 24 real zlat 20 25 21 real zlat26 um(:,:)=0 ! initialize um() 22 27 23 um(:,:)=0 ! initialize um()28 DO j=1,jjm 24 29 25 DO j=1,jjm 30 if (abs(sin(rlatv(j))).lt.1.e-4) then 31 zlat=1.e-4 32 else 33 zlat=rlatv(j) 34 endif 35 fact=cos(zlat) 36 fact=fact*fact 37 fact=fact*fact 38 fact=fact*fact 39 fact=(1.-fact)/ & 40 (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j))) 41 fact=-fact/rad 42 DO l=1,llm 43 DO i=1,iim 44 u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l)) 45 um(j,l)=um(j,l)+u(i,j,l)/REAL(iim) 46 ENDDO 47 ENDDO 48 ENDDO 49 call dump2d(jjm,llm,um,'Vent-u geostrophique') 26 50 27 if (abs(sin(rlatv(j))).lt.1.e-4) then 28 zlat=1.e-4 29 else 30 zlat=rlatv(j) 31 endif 32 fact=cos(zlat) 33 fact=fact*fact 34 fact=fact*fact 35 fact=fact*fact 36 fact=(1.-fact)/ 37 s (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j))) 38 fact=-fact/rad 39 DO l=1,llm 40 DO i=1,iim 41 u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l)) 42 um(j,l)=um(j,l)+u(i,j,l)/REAL(iim) 43 ENDDO 44 ENDDO 45 ENDDO 46 call dump2d(jjm,llm,um,'Vent-u geostrophique') 51 ! calcul des champ de vent: 47 52 48 c 49 c----------------------------------------------------------------------- 50 c calcul des champ de vent: 51 c ------------------------- 53 DO l=1,llm 54 DO i=1,iip1 55 ucov(i,1,l)=0. 56 ucov(i,jjp1,l)=0. 57 end DO 58 DO j=2,jjm 59 DO i=1,iim 60 ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j) 61 end DO 62 ucov(iip1,j,l)=ucov(1,j,l) 63 end DO 64 end DO 52 65 53 DO 301 l=1,llm 54 DO 302 i=1,iip1 55 ucov(i,1,l)=0. 56 ucov(i,jjp1,l)=0. 57 302 CONTINUE 58 DO 304 j=2,jjm 59 DO 305 i=1,iim 60 ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j) 61 305 CONTINUE 62 ucov(iip1,j,l)=ucov(1,j,l) 63 304 CONTINUE 64 301 CONTINUE 66 print *, 301 65 67 66 print*,301 67 68 return 69 end 68 end subroutine ugeostr -
LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3dpar/iniacademic.F90
r1472 r1474 16 16 17 17 ! Author: Frederic Hourdin original: 15/01/93 18 ! The forcing defined here is from Held and Suarez, 1994, Bulletin 19 ! of the American Meteorological Society, 75, 1825. 18 20 19 21 IMPLICIT NONE … … 54 56 REAL pkf(ip1jmp1,llm) ! exner filt.au milieu des couches 55 57 REAL phi(ip1jmp1,llm) ! geopotentiel 56 REAL ddsin,tetastrat,zsig,tetapv,w_pv ! variables auxiliaires 58 REAL ddsin,zsig,tetapv,w_pv ! variables auxiliaires 59 real tetastrat ! potential temperature in the stratosphere, in K 57 60 real tetajl(jjp1,llm) 58 61 INTEGER i,j,l,lsup,ij -
LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3dpar/ugeostr.F90
r1472 r1474 2 2 ! $Id$ 3 3 ! 4 4 subroutine ugeostr(phi,ucov) 5 5 6 ! Calcul du vent covariant geostrophique a partir du champ de 7 ! geopotentiel. 8 ! We actually compute: (1 - cos^8 \phi) u_g 9 ! to have a wind going smoothly to 0 at the equator. 10 ! We assume that the surface pressure is uniform so that model 11 ! levels are pressure levels. 6 12 7 c Calcul du vent covariant geostrophique a partir du champs de 8 c geopotentiel en supposant que le vent au sol est nul. 13 implicit none 9 14 10 implicit none 15 include "dimensions.h" 16 include "paramet.h" 17 include "comconst.h" 18 include "comgeom2.h" 11 19 12 #include "dimensions.h" 13 #include "paramet.h" 14 #include "comconst.h" 15 #include "comgeom2.h" 20 real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm) 21 real um(jjm,llm),fact,u(iip1,jjm,llm) 22 integer i,j,l 16 23 17 real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm) 18 real um(jjm,llm),fact,u(iip1,jjm,llm) 19 integer i,j,l 24 real zlat 20 25 21 real zlat26 um(:,:)=0 ! initialize um() 22 27 23 um(:,:)=0 ! initialize um()28 DO j=1,jjm 24 29 25 DO j=1,jjm 30 if (abs(sin(rlatv(j))).lt.1.e-4) then 31 zlat=1.e-4 32 else 33 zlat=rlatv(j) 34 endif 35 fact=cos(zlat) 36 fact=fact*fact 37 fact=fact*fact 38 fact=fact*fact 39 fact=(1.-fact)/ & 40 (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j))) 41 fact=-fact/rad 42 DO l=1,llm 43 DO i=1,iim 44 u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l)) 45 um(j,l)=um(j,l)+u(i,j,l)/REAL(iim) 46 ENDDO 47 ENDDO 48 ENDDO 49 call dump2d(jjm,llm,um,'Vent-u geostrophique') 26 50 27 if (abs(sin(rlatv(j))).lt.1.e-4) then 28 zlat=1.e-4 29 else 30 zlat=rlatv(j) 31 endif 32 fact=cos(zlat) 33 fact=fact*fact 34 fact=fact*fact 35 fact=fact*fact 36 fact=(1.-fact)/ 37 s (2.*omeg*sin(zlat)*(rlatu(j+1)-rlatu(j))) 38 fact=-fact/rad 39 DO l=1,llm 40 DO i=1,iim 41 u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l)) 42 um(j,l)=um(j,l)+u(i,j,l)/REAL(iim) 43 ENDDO 44 ENDDO 45 ENDDO 46 call dump2d(jjm,llm,um,'Vent-u geostrophique') 51 ! calcul des champ de vent: 47 52 48 c 49 c----------------------------------------------------------------------- 50 c calcul des champ de vent: 51 c ------------------------- 53 DO l=1,llm 54 DO i=1,iip1 55 ucov(i,1,l)=0. 56 ucov(i,jjp1,l)=0. 57 end DO 58 DO j=2,jjm 59 DO i=1,iim 60 ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j) 61 end DO 62 ucov(iip1,j,l)=ucov(1,j,l) 63 end DO 64 end DO 52 65 53 DO 301 l=1,llm 54 DO 302 i=1,iip1 55 ucov(i,1,l)=0. 56 ucov(i,jjp1,l)=0. 57 302 CONTINUE 58 DO 304 j=2,jjm 59 DO 305 i=1,iim 60 ucov(i,j,l) = 0.5*(u(i,j,l)+u(i,j-1,l))*cu(i,j) 61 305 CONTINUE 62 ucov(iip1,j,l)=ucov(1,j,l) 63 304 CONTINUE 64 301 CONTINUE 66 print *, 301 65 67 66 print*,301 67 68 return 69 end 68 end subroutine ugeostr
Note: See TracChangeset
for help on using the changeset viewer.
