/[lmdze]/trunk/dyn3d/advect.f

Diff of /trunk/dyn3d/advect.f

Parent Directory | Revision Log | View Patch Patch

-trunk/libf/dyn3d/advect.f
revision 12 by guez,
Mon Jul 21 16:05:07 2008 UTC
+trunk/libf/dyn3d/advect.f90
revision 46 by guez,
Mon May 16 14:52:30 2011 UTC
 Line 1
- !
+ module advect_m
- ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/advect.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $
- !
+   IMPLICIT NONE
-       SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta,
-      $     conser)
+ contains
-       use dimens_m
+   SUBROUTINE advect(ucov, vcov, teta, w, massebx, masseby, du, dv, dteta, &
-       use paramet_m
+        conser)
-       use comconst
-       use comvert
+     ! From dyn3d/advect.F, version 1.1.1.1 2004/05/19 12:53:06
-       use comgeom
+     ! Authors: P. Le Van , F. Hourdin
-       use ener
+     ! Objet : calcul des termes d'advection verticale pour u, v, teta.
-       IMPLICIT NONE
+     ! Ces termes sont ajoutés à du, dv, dteta.
- c=======================================================================
- c
+     USE dimens_m, ONLY : iim, llm
- c   Auteurs:  P. Le Van , Fr. Hourdin  .
+     USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1
- c   -------
+     USE comconst, ONLY : daysec
- c
+     USE comgeom, ONLY : unsaire
- c   Objet:
+     USE ener, ONLY : gtot
- c   ------
- c
+     ! Arguments:
- c   *************************************************************
+     REAL, intent(in):: vcov(ip1jm, llm), ucov(ip1jmp1, llm)
- c   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
+     real, intent(in):: teta(ip1jmp1, llm)
- c   *************************************************************
+     REAL, intent(in):: massebx(ip1jmp1, llm), masseby(ip1jm, llm)
- c        ces termes sont ajoutes a du,dv,dteta et dq .
+     real, INTENT (IN):: w(ip1jmp1, llm)
- c  Modif F.Forget 03/94 : on retire q de advect
+     REAL, intent(inout):: dv(ip1jm, llm), du(ip1jmp1, llm), dteta(ip1jmp1, llm)
- c
+     LOGICAL, INTENT (IN):: conser
- c=======================================================================
- c-----------------------------------------------------------------------
+     ! Local:
- c   Declarations:
+     REAL uav(ip1jmp1, llm), vav(ip1jm, llm), wsur2(ip1jmp1)
- c   -------------
+     REAL unsaire2(ip1jmp1)
+     REAL deuxjour, ww, uu, vv
+     INTEGER ij, l
- c   Arguments:
- c   ----------
+     !-----------------------------------------------------------------------
-       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
+     ! 2. Calculs preliminaires :
-       REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
-       REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
+     IF (conser) THEN
-       logical, intent(in):: conser
+        deuxjour = 2. * daysec
+        unsaire2 = unsaire**2
- c   Local:
+     END IF
- c   ------
+     ! Calcul de \bar{u}^{yy}
-       REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
+     DO l = 1, llm
-       REAL unsaire2(ip1jmp1), ge(ip1jmp1)
+        DO ij = iip2, ip1jmp1
-       REAL deuxjour, ww, gt, uu, vv
+           uav(ij, l) = 0.25*(ucov(ij, l)+ucov(ij-iip1, l))
+        END DO
-       INTEGER  ij,l
+        DO ij = iip2, ip1jm
+           uav(ij, l) = uav(ij, l) + uav(ij+iip1, l)
-       REAL      SSUM
+        END DO
+        DO ij = 1, iip1
- c-----------------------------------------------------------------------
+           uav(ij, l) = 0.
- c   2. Calculs preliminaires:
+           uav(ip1jm+ij, l) = 0.
- c   -------------------------
+        END DO
+     END DO
-       IF (conser)  THEN
-          deuxjour = 2. * daysec
+     ! Calcul de \bar{v}^{xx}
+     DO l = 1, llm
-          DO   1  ij   = 1, ip1jmp1
+        DO ij = 2, ip1jm
-          unsaire2(ij) = unsaire(ij) * unsaire(ij)
+           vav(ij, l) = 0.25*(vcov(ij, l)+vcov(ij-1, l))
-    CONTINUE
+        END DO
-       END IF
+        DO ij = 1, ip1jm, iip1
+           vav(ij, l) = vav(ij+iim, l)
+        END DO
- c------------------  -yy ----------------------------------------------
+        DO ij = 1, ip1jm - 1
- c   .  Calcul de     u
+           vav(ij, l) = vav(ij, l) + vav(ij+1, l)
+        END DO
-       DO  l=1,llm
+        DO ij = 1, ip1jm, iip1
-          DO    ij     = iip2, ip1jmp1
+           vav(ij+iim, l) = vav(ij, l)
-             uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
+        END DO
-          ENDDO
+     END DO
-          DO    ij     = iip2, ip1jm
-             uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
+     DO l = 1, llm - 1
-          ENDDO
+        ! calcul de - w/2 au niveau l+1
-          DO      ij         = 1, iip1
+        DO ij = 1, ip1jmp1
-             uav(ij      ,l) = 0.
+           wsur2(ij) = -0.5 * w(ij, l+1)
-             uav(ip1jm+ij,l) = 0.
+        END DO
-          ENDDO
-       ENDDO
+        ! calcul pour "du"
+        DO ij = iip2, ip1jm - 1
- c------------------  -xx ----------------------------------------------
+           ww = wsur2(ij) + wsur2(ij+1)
- c   .  Calcul de     v
+           uu = 0.5*(ucov(ij, l)+ucov(ij, l+1))
+           du(ij, l) = du(ij, l) - ww*(uu-uav(ij, l))/massebx(ij, l)
-       DO  l=1,llm
+           du(ij, l+1) = du(ij, l+1) + ww*(uu-uav(ij, l+1))/massebx(ij, l+1)
-          DO    ij   = 2, ip1jm
+        END DO
-           vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
-          ENDDO
+        ! correction pour du(iip1, j, l)
-          DO    ij   = 1,ip1jm,iip1
+        ! du(iip1, j, l)= du(1, j, l)
-           vav(ij,l) = vav(ij+iim,l)
-          ENDDO
+        DO ij = iip1 + iip1, ip1jm, iip1
-          DO    ij   = 1, ip1jm-1
+           du(ij, l) = du(ij-iim, l)
-           vav(ij,l) = vav(ij,l) + vav(ij+1,l)
+           du(ij, l+1) = du(ij-iim, l+1)
-          ENDDO
+        END DO
-          DO    ij       = 1, ip1jm, iip1
-           vav(ij+iim,l) = vav(ij,l)
+        ! calcul pour dv
-          ENDDO
+        DO ij = 1, ip1jm
-       ENDDO
+           ww = wsur2(ij+iip1) + wsur2(ij)
+           vv = 0.5*(vcov(ij, l)+vcov(ij, l+1))
- c-----------------------------------------------------------------------
+           dv(ij, l) = dv(ij, l) - ww*(vv-vav(ij, l))/masseby(ij, l)
+           dv(ij, l+1) = dv(ij, l+1) + ww*(vv-vav(ij, l+1))/masseby(ij, l+1)
- c
+        END DO
-       DO 20 l = 1, llmm1
+        ! calcul pour dh
+        ! calcul de - d(\bar{teta}^z * w) qu'on ajoute à dh
- c       ......   calcul de  - w/2.    au niveau  l+1   .......
+        DO ij = 1, ip1jmp1
+           ww = wsur2(ij) * (teta(ij, l) + teta(ij, l + 1))
-       DO 5   ij   = 1, ip1jmp1
+           dteta(ij, l) = dteta(ij, l) - ww
-       wsur2( ij ) = - 0.5 * w( ij,l+1 )
+           dteta(ij, l + 1) = dteta(ij, l + 1) + ww
- CONTINUE
+        end DO
+        IF (conser) THEN
- c     .....................     calcul pour  du     ..................
+           gtot(l) = deuxjour * sqrt(sum(wsur2**2 * unsaire2) / ip1jmp1)
+        END IF
-       DO 6 ij = iip2 ,ip1jm-1
+     END DO
-       ww        = wsur2 (  ij  )     + wsur2( ij+1 )
-       uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
+   END SUBROUTINE advect
-       du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
-       du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
+ end module advect_m
- CONTINUE
- c     .....  correction pour  du(iip1,j,l)  ........
- c     .....     du(iip1,j,l)= du(1,j,l)   .....
- CDIR$ IVDEP
-       DO   7  ij   = iip1 +iip1, ip1jm, iip1
-       du( ij, l  ) = du( ij -iim, l  )
-       du( ij,l+1 ) = du( ij -iim,l+1 )
- CONTINUE
- c     .................    calcul pour   dv      .....................
-       DO 8 ij = 1, ip1jm
-       ww        = wsur2( ij+iip1 )   + wsur2( ij )
-       vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
-       dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
-       dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
- CONTINUE
- c
- c     ............................................................
- c     ...............    calcul pour   dh      ...................
- c     ............................................................
- c                       ---z
- c       calcul de  - d( teta  * w )      qu'on ajoute a   dh
- c                   ...............
-         DO 15 ij = 1, ip1jmp1
-          ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
-          dteta(ij, l ) = dteta(ij, l )  -  ww
-          dteta(ij,l+1) = dteta(ij,l+1)  +  ww
-   CONTINUE
-       IF( conser)  THEN
-         DO 17 ij = 1,ip1jmp1
-         ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
-   CONTINUE
-         gt       = SSUM( ip1jmp1,ge,1 )
-         gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
-       END IF
- CONTINUE
-       RETURN
-       END

 Legend:



Removed from v.12
 


changed lines


 
Added in v.46
 Legend:



Removed from v.12
 


changed lines


 
Added in v.46
-Removed from v.12
+Added in v.46

	ViewVC Help
Powered by ViewVC 1.1.21