Ignore:
Timestamp:
Aug 2, 2024, 2:12:03 PM (3 months ago)
Author:
abarral
Message:

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_screenp.f90

    r5157 r5158  
     1MODULE lmdz_screenp
    12
    2 MODULE screenp_mod
     3  ! This module contains some procedures for calculation of the first
     4  ! guess of temperature, specific humidity and wind at a reference level
     5  ! coefficients for turbulent diffusion at surface
    36
    4 ! This module contains some procedures for calculation of the first
    5 ! guess of temperature, specific humidity and wind at a reference level
    6 ! coefficients for turbulent diffusion at surface
    7 
    8   IMPLICIT NONE
     7  IMPLICIT NONE; PRIVATE
     8  PUBLIC screenp, screenpn
    99
    1010CONTAINS
    1111
    12 !****************************************************************************************
     12  !****************************************************************************************
    1313
    14 !r original routine
     14  !r original routine
    1515
    16       SUBROUTINE screenp(klon, knon, nsrf, &
    17                      speed, tair, qair, &
    18                      ts, qsurf, rugos, lmon, &
    19                      ustar, testar, qstar, zref, &
    20                      delu, delte, delq)
    21       IMPLICIT NONE
    22 !-------------------------------------------------------------------------
     16  SUBROUTINE screenp(klon, knon, &
     17          speed, tair, qair, &
     18          ts, qsurf, rugos, lmon, &
     19          ustar, testar, qstar, zref, &
     20          delu, delte, delq)
     21    IMPLICIT NONE
     22    !-------------------------------------------------------------------------
    2323
    24 ! Objet : calcul "predicteur" des anomalies du vent, de la temperature
    25 !         potentielle et de l'humidite relative au niveau de reference zref et
    26 !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
    27 !         a partir des relations de Dyer-Businger.
     24    ! Objet : calcul "predicteur" des anomalies du vent, de la temperature
     25    !         potentielle et de l'humidite relative au niveau de reference zref et
     26    !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
     27    !         a partir des relations de Dyer-Businger.
    2828
    29 ! Reference : Hess, Colman et McAvaney (1995)
     29    ! Reference : Hess, Colman et McAvaney (1995)
    3030
    31 ! I. Musat, 01.07.2002
    32 !-------------------------------------------------------------------------
     31    ! I. Musat, 01.07.2002
     32    !-------------------------------------------------------------------------
    3333
    34 ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
    35 ! knon----input-I- nombre de points pour un type de surface
    36 ! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
    37 ! speed---input-R- module du vent au 1er niveau du modele
    38 ! tair----input-R- temperature de l'air au 1er niveau du modele
    39 ! qair----input-R- humidite relative au 1er niveau du modele
    40 ! ts------input-R- temperature de l'air a la surface
    41 ! qsurf---input-R- humidite relative a la surface
    42 ! rugos---input-R- rugosite
    43 ! lmon----input-R- longueur de Monin-Obukov
    44 ! ustar---input-R- facteur d'echelle pour le vent
    45 ! testar--input-R- facteur d'echelle pour la temperature potentielle
    46 ! qstar---input-R- facteur d'echelle pour l'humidite relative
    47 ! zref----input-R- altitude de reference
     34    ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
     35    ! knon----input-I- nombre de points pour un type de surface
     36    ! speed---input-R- module du vent au 1er niveau du modele
     37    ! tair----input-R- temperature de l'air au 1er niveau du modele
     38    ! qair----input-R- humidite relative au 1er niveau du modele
     39    ! ts------input-R- temperature de l'air a la surface
     40    ! qsurf---input-R- humidite relative a la surface
     41    ! rugos---input-R- rugosite
     42    ! lmon----input-R- longueur de Monin-Obukov
     43    ! ustar---input-R- facteur d'echelle pour le vent
     44    ! testar--input-R- facteur d'echelle pour la temperature potentielle
     45    ! qstar---input-R- facteur d'echelle pour l'humidite relative
     46    ! zref----input-R- altitude de reference
    4847
    49 ! delu----input-R- anomalie du vent par rapport au 1er niveau
    50 ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
    51 ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
     48    ! delu----input-R- anomalie du vent par rapport au 1er niveau
     49    ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
     50    ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
    5251
    53       INTEGER, INTENT(IN) :: klon, knon, nsrf
    54       REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
    55       REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
    56       DOUBLE PRECISION, DIMENSION(klon), INTENT(IN) :: lmon
    57       REAL, DIMENSION(klon), INTENT(IN) :: ustar, testar, qstar
    58       REAL, INTENT(IN) :: zref
     52    INTEGER, INTENT(IN) :: klon, knon
     53    REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
     54    REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
     55    DOUBLE PRECISION, DIMENSION(klon), INTENT(IN) :: lmon
     56    REAL, DIMENSION(klon), INTENT(IN) :: ustar, testar, qstar
     57    REAL, INTENT(IN) :: zref
    5958
    60       REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
     59    REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
    6160
    62 !-------------------------------------------------------------------------
    63 ! Variables locales et constantes :
    64       REAL, PARAMETER :: RKAR=0.40
    65       INTEGER :: i
    66       REAL :: xtmp, xtmp0
    67 !-------------------------------------------------------------------------
    68       DO i = 1, knon
     61    !-------------------------------------------------------------------------
     62    ! Variables locales et constantes :
     63    REAL, PARAMETER :: RKAR = 0.40
     64    INTEGER :: i
     65    REAL :: xtmp, xtmp0
     66    !-------------------------------------------------------------------------
     67    DO i = 1, knon
    6968
    70         IF (lmon(i)>=0.) THEN
     69      IF (lmon(i)>=0.) THEN
    7170
    72 ! STABLE CASE
     71        ! STABLE CASE
    7372
    74           IF (speed(i)>1.5.AND.lmon(i)<=1.0                        &
    75                         .AND. rugos(i)<=1.0) THEN
    76             delu(i) = (ustar(i)/RKAR)* &
    77                       (log(zref/(rugos(i))+1.) + &
    78                       min(5.d0, 5.0 *(zref - rugos(i))/lmon(i)))
    79             delte(i) = (testar(i)/RKAR)* &
    80                        (log(zref/(rugos(i))+1.) + &
    81                        min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
    82             delq(i) = (qstar(i)/RKAR)* &
    83                       (log(zref/(rugos(i))+1.) + &
    84                       min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
    85           ELSE
    86             delu(i) = 0.1 * speed(i)
    87             delte(i) = 0.1 * (tair(i) - ts(i) )
    88             delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
    89           ENDIF
    90         ELSE 
     73        IF (speed(i)>1.5.AND.lmon(i)<=1.0                        &
     74                .AND. rugos(i)<=1.0) THEN
     75          delu(i) = (ustar(i) / RKAR) * &
     76                  (log(zref / (rugos(i)) + 1.) + &
     77                          min(5.d0, 5.0 * (zref - rugos(i)) / lmon(i)))
     78          delte(i) = (testar(i) / RKAR) * &
     79                  (log(zref / (rugos(i)) + 1.) + &
     80                          min(5.d0, 5.0 * (zref - rugos(i)) / lmon(i)))
     81          delq(i) = (qstar(i) / RKAR) * &
     82                  (log(zref / (rugos(i)) + 1.) + &
     83                          min(5.d0, 5.0 * (zref - rugos(i)) / lmon(i)))
     84        ELSE
     85          delu(i) = 0.1 * speed(i)
     86          delte(i) = 0.1 * (tair(i) - ts(i))
     87          delq(i) = 0.1 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
     88        ENDIF
     89      ELSE
    9190
    92 ! UNSTABLE CASE
     91        ! UNSTABLE CASE
    9392
    94           IF (speed(i)>5.0.AND.abs(lmon(i))<=50.0) THEN
    95             xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
    96             xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
    97             delu(i) = (ustar(i)/RKAR)* &
    98                       (log(zref/(rugos(i))+1.) &
    99                       - 2.*log(0.5*(1. + xtmp)) &
    100                       + 2.*log(0.5*(1. + xtmp0)) &
    101                       - log(0.5*(1. + xtmp*xtmp)) &
    102                       + log(0.5*(1. + xtmp0*xtmp0)) &
    103                       + 2.*atan(xtmp) - 2.*atan(xtmp0))
    104             delte(i) = (testar(i)/RKAR)* &
    105                        (log(zref/(rugos(i))+1.) &
    106                        - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
    107                        + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
    108             delq(i)  = (qstar(i)/RKAR)* &
    109                        (log(zref/(rugos(i))+1.) &
    110                        - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
    111                        + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
    112           ELSE
    113             delu(i)  = 0.5 * speed(i)
    114             delte(i) = 0.5 * (tair(i) - ts(i) )
    115             delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
    116           ENDIF
     93        IF (speed(i)>5.0.AND.abs(lmon(i))<=50.0) THEN
     94          xtmp = (1. - 16. * (zref / lmon(i)))**(1. / 4.)
     95          xtmp0 = (1. - 16. * (rugos(i) / lmon(i)))**(1. / 4.)
     96          delu(i) = (ustar(i) / RKAR) * &
     97                  (log(zref / (rugos(i)) + 1.) &
     98                          - 2. * log(0.5 * (1. + xtmp)) &
     99                          + 2. * log(0.5 * (1. + xtmp0)) &
     100                          - log(0.5 * (1. + xtmp * xtmp)) &
     101                          + log(0.5 * (1. + xtmp0 * xtmp0)) &
     102                          + 2. * atan(xtmp) - 2. * atan(xtmp0))
     103          delte(i) = (testar(i) / RKAR) * &
     104                  (log(zref / (rugos(i)) + 1.) &
     105                          - 2.0 * log(0.5 * (1. + xtmp * xtmp)) &
     106                          + 2.0 * log(0.5 * (1. + xtmp0 * xtmp0)))
     107          delq(i) = (qstar(i) / RKAR) * &
     108                  (log(zref / (rugos(i)) + 1.) &
     109                          - 2.0 * log(0.5 * (1. + xtmp * xtmp)) &
     110                          + 2.0 * log(0.5 * (1. + xtmp0 * xtmp0)))
     111        ELSE
     112          delu(i) = 0.5 * speed(i)
     113          delte(i) = 0.5 * (tair(i) - ts(i))
     114          delq(i) = 0.5 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
    117115        ENDIF
     116      ENDIF
    118117
    119       ENDDO
     118    ENDDO
    120119
    121       END SUBROUTINE screenp
     120  END SUBROUTINE screenp
    122121
    123       SUBROUTINE screenpn(klon, knon, nsrf, &
    124                      speed, tair, qair, &
    125                      ts, qsurf, rugos, zri1, &
    126                      zref, &
    127                      delu, delte, delq)
    128       IMPLICIT NONE
    129 !-------------------------------------------------------------------------
     122  SUBROUTINE screenpn(klon, knon, speed, tair, qair, ts, qsurf, zri1, delu, delte, delq)
     123    IMPLICIT NONE
     124    !-------------------------------------------------------------------------
    130125
    131 ! Objet : calcul "predicteur" des anomalies du vent, de la temperature
    132 !         potentielle et de l'humidite relative au niveau de reference zref et
    133 !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
    134 !         a partir des relations de Dyer-Businger.
     126    ! Objet : calcul "predicteur" des anomalies du vent, de la temperature
     127    !         potentielle et de l'humidite relative au niveau de reference zref et
     128    !         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
     129    !         a partir des relations de Dyer-Businger.
    135130
    136 ! Reference : Hess, Colman et McAvaney (1995)
     131    ! Reference : Hess, Colman et McAvaney (1995)
    137132
    138 ! I. Musat, 01.07.2002
    139 !-------------------------------------------------------------------------
     133    ! I. Musat, 01.07.2002
     134    !-------------------------------------------------------------------------
    140135
    141 ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
    142 ! knon----input-I- nombre de points pour un type de surface
    143 ! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
    144 ! speed---input-R- module du vent au 1er niveau du modele
    145 ! tair----input-R- temperature de l'air au 1er niveau du modele
    146 ! qair----input-R- humidite relative au 1er niveau du modele
    147 ! ts------input-R- temperature de l'air a la surface
    148 ! qsurf---input-R- humidite relative a la surface
    149 ! rugos---input-R- rugosite
    150 ! zref----input-R- altitude de reference
     136    ! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
     137    ! knon----input-I- nombre de points pour un type de surface
     138    ! speed---input-R- module du vent au 1er niveau du modele
     139    ! tair----input-R- temperature de l'air au 1er niveau du modele
     140    ! qair----input-R- humidite relative au 1er niveau du modele
     141    ! ts------input-R- temperature de l'air a la surface
     142    ! qsurf---input-R- humidite relative a la surface
    151143
    152 ! delu----input-R- anomalie du vent par rapport au 1er niveau
    153 ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
    154 ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
     144    ! delu----input-R- anomalie du vent par rapport au 1er niveau
     145    ! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
     146    ! delq----input-R- anomalie de l'humidite relative par rapport a la surface
    155147
    156       INTEGER, INTENT(IN) :: klon, knon, nsrf
    157       REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
    158       REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf, rugos
    159       REAL, DIMENSION(klon), INTENT(IN) :: zri1
    160       REAL, INTENT(IN) :: zref
     148    INTEGER, INTENT(IN) :: klon, knon
     149    REAL, DIMENSION(klon), INTENT(IN) :: speed, tair, qair
     150    REAL, DIMENSION(klon), INTENT(IN) :: ts, qsurf
     151    REAL, DIMENSION(klon), INTENT(IN) :: zri1
    161152
    162       REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
     153    REAL, DIMENSION(klon), INTENT(OUT) :: delu, delte, delq
    163154
    164 !-------------------------------------------------------------------------
    165 ! Variables locales et constantes :
    166       REAL, PARAMETER :: RKAR=0.40
    167       INTEGER :: i
    168       REAL :: xtmp, xtmp0
    169 !-------------------------------------------------------------------------
    170       DO i = 1, knon
     155    !-------------------------------------------------------------------------
     156    ! Variables locales et constantes :
     157    REAL, PARAMETER :: RKAR = 0.40
     158    INTEGER :: i
     159    !-------------------------------------------------------------------------
     160    DO i = 1, knon
    171161
    172        IF (zri1(i)>=0.) THEN
    173           delu(i) = 0.1 * speed(i)
    174           delte(i) = 0.1 * (tair(i) - ts(i) )
    175           delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
    176        ELSE
    177           delu(i) = 0.5 * speed(i)
    178           delte(i) = 0.5 * (tair(i) - ts(i) )
    179           delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
    180        ENDIF
     162      IF (zri1(i)>=0.) THEN
     163        delu(i) = 0.1 * speed(i)
     164        delte(i) = 0.1 * (tair(i) - ts(i))
     165        delq(i) = 0.1 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
     166      ELSE
     167        delu(i) = 0.5 * speed(i)
     168        delte(i) = 0.5 * (tair(i) - ts(i))
     169        delq(i) = 0.5 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
     170      ENDIF
    181171
    182       ENDDO
     172    ENDDO
    183173
    184       END SUBROUTINE screenpn
    185 END MODULE screenp_mod
     174  END SUBROUTINE screenpn
     175END MODULE lmdz_screenp
Note: See TracChangeset for help on using the changeset viewer.