Ignore:
Timestamp:
Mar 5, 2014, 2:19:12 PM (11 years ago)
Author:
lguez
Message:

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

File:
1 moved

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/phylmd/homogene.F90

    r1988 r1992  
    1 !
     1
    22! $Header$
    3 !
    4       SUBROUTINE homogene(paprs, q, dq, u,v, du, dv)
    5       USE dimphy
    6       IMPLICIT NONE
    7 c==============================================================
    8 c Schema ad hoc du melange vertical pour les vitesses u et v,
    9 c a appliquer apres le schema de convection (fiajc et fiajh).
    10 c
    11 c paprs:input, pression demi-couche (inter-couche)
    12 c q:    input, vapeur d'eau (kg/kg)
    13 c dq:   input, incrementation de vapeur d'eau (de la convection)
    14 c u:    input, vitesse u
    15 c v:    input, vitesse v
    16 c
    17 c du:   output, incrementation pour u
    18 c dv:   output, incrementation pour v
    19 c==============================================================
    20 cym#include "dimensions.h"
    21 cym#include "dimphy.h"
    22 c
    23       REAL paprs(klon,klev+1)
    24       REAL q(klon,klev), dq(klon,klev)
    25       REAL u(klon,klev), du(klon,klev)
    26       REAL v(klon,klev), dv(klon,klev)
    27 c
    28       REAL zm_dq(klon) ! quantite totale de l'eau deplacee
    29       REAL zm_q(klon) ! quantite totale de la vapeur d'eau
    30       REAL zm_u(klon) ! moyenne de u (brassage parfait et total)
    31       REAL zm_v(klon) ! moyenne de v (brassage parfait et total)
    32       REAL z_frac(klon) ! fraction du brassage parfait et total
    33       REAL zm_dp(klon)
    34 c
    35       REAL zx
    36       INTEGER i, k
    37       REAL frac_max
    38       PARAMETER (frac_max=0.1)
    39       REAL seuil
    40       PARAMETER (seuil=1.0e-10)
    41       LOGICAL faisrien
    42       PARAMETER (faisrien=.true.)
    43 c
    44       DO k = 1, klev
    45       DO i = 1, klon
    46          du(i,k) = 0.0
    47          dv(i,k) = 0.0
    48       ENDDO
    49       ENDDO
    50 c
    51       IF (faisrien) RETURN
    52 c
    53       DO i = 1, klon
    54          zm_dq(i)=0.
    55          zm_q(i) =0.
    56          zm_u(i)=0.
    57          zm_v(i)=0.
    58          zm_dp(i)=0.
    59       ENDDO
    60       DO k = 1, klev
    61       DO i = 1, klon
    62       IF (ABS(dq(i,k)).GT.seuil) THEN
    63          zx = paprs(i,k) - paprs(i,k+1)
    64          zm_dq(i) = zm_dq(i) + ABS(dq(i,k))*zx
    65          zm_q(i) = zm_q(i) + q(i,k)*zx
    66          zm_dp(i) = zm_dp(i) + zx
    67          zm_u(i) = zm_u(i) + u(i,k)*zx
    68          zm_v(i) = zm_v(i) + v(i,k)*zx
    69       ENDIF
    70       ENDDO
    71       ENDDO
    72 c
    73 c Hypothese principale: apres la convection, la vitesse de chaque
    74 c couche est composee de deux parties: celle (1-z_frac) de la vitesse
    75 c original et celle (z_frac) de la vitesse moyenne qui serait la
    76 c vitesse de chaque couche si le brassage etait parfait et total.
    77 c La fraction du brassage est calculee par le rapport entre la quantite
    78 c totale de la vapeur d'eau deplacee (ou condensee) et la quantite
    79 c totale de la vapeur d'eau. Et cette fraction est limitee a frac_max
    80 c (Est-ce vraiment raisonnable ? Z.X. Li, le 07-09-1995).
    81 c
    82       DO i = 1, klon
    83       IF (zm_dp(i).GE.1.0E-15 .AND. zm_q(i).GE.1.0E-15) THEN
    84          z_frac(i)=MIN(frac_max,zm_dq(i)/zm_q(i))
    85          zm_u(i)=zm_u(i)/zm_dp(i)
    86          zm_v(i)=zm_v(i)/zm_dp(i)
    87       ENDIF
    88       ENDDO
    89       DO k = 1, klev
    90       DO i = 1, klon
    91       IF (zm_dp(i).GE.1.e-15 .AND. zm_q(i).GE.1.e-15
    92      .                         .AND. ABS(dq(i,k)).GT.seuil) THEN
    93          du(i,k) = u(i,k)*(1.-z_frac(i)) + zm_u(i)*z_frac(i) - u(i,k)
    94          dv(i,k) = v(i,k)*(1.-z_frac(i)) + zm_v(i)*z_frac(i) - v(i,k)
    95       ENDIF
    96       ENDDO
    97       ENDDO
    98 c
    99       RETURN
    100       END
     3
     4SUBROUTINE homogene(paprs, q, dq, u, v, du, dv)
     5  USE dimphy
     6  IMPLICIT NONE
     7  ! ==============================================================
     8  ! Schema ad hoc du melange vertical pour les vitesses u et v,
     9  ! a appliquer apres le schema de convection (fiajc et fiajh).
     10
     11  ! paprs:input, pression demi-couche (inter-couche)
     12  ! q:    input, vapeur d'eau (kg/kg)
     13  ! dq:   input, incrementation de vapeur d'eau (de la convection)
     14  ! u:    input, vitesse u
     15  ! v:    input, vitesse v
     16
     17  ! du:   output, incrementation pour u
     18  ! dv:   output, incrementation pour v
     19  ! ==============================================================
     20  ! ym#include "dimensions.h"
     21  ! ym#include "dimphy.h"
     22
     23  REAL paprs(klon, klev+1)
     24  REAL q(klon, klev), dq(klon, klev)
     25  REAL u(klon, klev), du(klon, klev)
     26  REAL v(klon, klev), dv(klon, klev)
     27
     28  REAL zm_dq(klon) ! quantite totale de l'eau deplacee
     29  REAL zm_q(klon) ! quantite totale de la vapeur d'eau
     30  REAL zm_u(klon) ! moyenne de u (brassage parfait et total)
     31  REAL zm_v(klon) ! moyenne de v (brassage parfait et total)
     32  REAL z_frac(klon) ! fraction du brassage parfait et total
     33  REAL zm_dp(klon)
     34
     35  REAL zx
     36  INTEGER i, k
     37  REAL frac_max
     38  PARAMETER (frac_max=0.1)
     39  REAL seuil
     40  PARAMETER (seuil=1.0E-10)
     41  LOGICAL faisrien
     42  PARAMETER (faisrien=.TRUE.)
     43
     44  DO k = 1, klev
     45    DO i = 1, klon
     46      du(i, k) = 0.0
     47      dv(i, k) = 0.0
     48    END DO
     49  END DO
     50
     51  IF (faisrien) RETURN
     52
     53  DO i = 1, klon
     54    zm_dq(i) = 0.
     55    zm_q(i) = 0.
     56    zm_u(i) = 0.
     57    zm_v(i) = 0.
     58    zm_dp(i) = 0.
     59  END DO
     60  DO k = 1, klev
     61    DO i = 1, klon
     62      IF (abs(dq(i,k))>seuil) THEN
     63        zx = paprs(i, k) - paprs(i, k+1)
     64        zm_dq(i) = zm_dq(i) + abs(dq(i,k))*zx
     65        zm_q(i) = zm_q(i) + q(i, k)*zx
     66        zm_dp(i) = zm_dp(i) + zx
     67        zm_u(i) = zm_u(i) + u(i, k)*zx
     68        zm_v(i) = zm_v(i) + v(i, k)*zx
     69      END IF
     70    END DO
     71  END DO
     72
     73  ! Hypothese principale: apres la convection, la vitesse de chaque
     74  ! couche est composee de deux parties: celle (1-z_frac) de la vitesse
     75  ! original et celle (z_frac) de la vitesse moyenne qui serait la
     76  ! vitesse de chaque couche si le brassage etait parfait et total.
     77  ! La fraction du brassage est calculee par le rapport entre la quantite
     78  ! totale de la vapeur d'eau deplacee (ou condensee) et la quantite
     79  ! totale de la vapeur d'eau. Et cette fraction est limitee a frac_max
     80  ! (Est-ce vraiment raisonnable ? Z.X. Li, le 07-09-1995).
     81
     82  DO i = 1, klon
     83    IF (zm_dp(i)>=1.0E-15 .AND. zm_q(i)>=1.0E-15) THEN
     84      z_frac(i) = min(frac_max, zm_dq(i)/zm_q(i))
     85      zm_u(i) = zm_u(i)/zm_dp(i)
     86      zm_v(i) = zm_v(i)/zm_dp(i)
     87    END IF
     88  END DO
     89  DO k = 1, klev
     90    DO i = 1, klon
     91      IF (zm_dp(i)>=1.E-15 .AND. zm_q(i)>=1.E-15 .AND. abs(dq(i, &
     92          k))>seuil) THEN
     93        du(i, k) = u(i, k)*(1.-z_frac(i)) + zm_u(i)*z_frac(i) - u(i, k)
     94        dv(i, k) = v(i, k)*(1.-z_frac(i)) + zm_v(i)*z_frac(i) - v(i, k)
     95      END IF
     96    END DO
     97  END DO
     98
     99  RETURN
     100END SUBROUTINE homogene
Note: See TracChangeset for help on using the changeset viewer.