Ignore:
Timestamp:
Jan 14, 2011, 12:04:45 PM (14 years ago)
Author:
lguez
Message:

Conversion to free source form for "ugeostr". Removed strange "print
*, 301" at the end of "ugeostr".

Location:
LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3d
Files:
1 edited
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3d/iniacademic.F90

    r1472 r1474  
    1616
    1717  !   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.
    1820
    1921  IMPLICIT NONE
    … …  
    5456  REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    5557  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
    5760  real tetajl(jjp1,llm)
    5861  INTEGER i,j,l,lsup,ij

  • LMDZ5/branches/LMDZ5V2.0-dev/libf/dyn3d/ugeostr.F90

    r1472 r1474  
    22! $Id$
    33!
    4       subroutine ugeostr(phi,ucov)
     4subroutine ugeostr(phi,ucov)
    55
     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.
    612
    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
    914
    10       implicit none
     15  include "dimensions.h"
     16  include "paramet.h"
     17  include "comconst.h"
     18  include "comgeom2.h"
    1119
    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
    1623
    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
    2025
    21       real zlat
     26  um(:,:)=0 ! initialize um()
    2227
    23       um(:,:)=0 ! initialize um()
     28  DO j=1,jjm
    2429
    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')
    2650
    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:
    4752
    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
    5265
    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
    6567
    66       print*,301
    67 
    68       return
    69       end
     68end subroutine ugeostr
Note: See TracChangeset for help on using the changeset viewer.