Ignore:
Timestamp:
Jul 24, 2024, 4:23:34 PM (2 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_pres2lev.f90

    r5116 r5117  
    11! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
    22
    3 MODULE pres2lev_mod
     3MODULE lmdz_pres2lev
     4  IMPLICIT NONE; PRIVATE
     5  PUBLIC pres2lev
    46
    5 CONTAINS 
     7CONTAINS
    68
    7 !******************************************************
    8 SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
     9  !******************************************************
     10  SUBROUTINE pres2lev(varo, varn, lmo, lmn, po, pn, ni, nj, ok_invertp)
    911
    10 ! interpolation lineaire pour passer
    11 ! a une nouvelle discretisation verticale pour
    12 ! les variables de GCM
    13 ! Francois Forget (01/1995)
    14 ! MOdif remy roca 12/97 pour passer de pres2sig
    15 ! Modif F.Codron 07/08 po en 3D
    16 !**********************************************************
     12    ! interpolation lineaire pour passer
     13    ! a une nouvelle discretisation verticale pour
     14    ! les variables de GCM
     15    ! Francois Forget (01/1995)
     16    ! MOdif remy roca 12/97 pour passer de pres2sig
     17    ! Modif F.Codron 07/08 po en 3D
     18    !**********************************************************
    1719
    18   IMPLICIT NONE
     20    IMPLICIT NONE
    1921
    20 !   Declarations:
    21 ! ==============
     22    !   Declarations:
     23    ! ==============
    2224
    23 !  ARGUMENTS
    24 !  """""""""
    25   LOGICAL, INTENT(IN) :: ok_invertp
    26   INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
    27   INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
    28  
    29   INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
    30   REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
    31   REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
     25    !  ARGUMENTS
     26    !  """""""""
     27    LOGICAL, INTENT(IN) :: ok_invertp
     28    INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
     29    INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
    3230
    33   REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
    34   REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
     31    INTEGER, INTENT(IN) :: ni, nj ! nombre de point horizontal
     32    REAL, INTENT(IN) :: po(ni * nj, lmo) ! niveau de pression ancienne grille
     33    REAL, INTENT(IN) :: pn(ni * nj, lmn) ! niveau de pression nouvelle grille
    3534
    36   REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
     35    REAL, INTENT(IN) :: varo(ni * nj, lmo) ! var dans l'ancienne grille
     36    REAL, INTENT(OUT) :: varn(ni * nj, lmn) ! var dans la nouvelle grille
    3737
    38 ! Autres variables
    39 ! """"""""""""""""
    40   INTEGER ::  ln ,lo, k
    41   REAL    :: coef
     38    REAL :: zvaro(ni * nj, lmo), zpo(ni * nj, lmo)
     39
     40    ! Autres variables
     41    ! """"""""""""""""
     42    INTEGER :: ln, lo, k
     43    REAL :: coef
    4244
    4345
    44 ! Inversion de l'ordre des niveaux verticaux
    45   IF (ok_invertp) THEN
    46     DO lo=1,lmo
    47       DO k=1,ni*nj
    48         zpo(k,lo)=po(k,lmo+1-lo)
    49         zvaro(k,lo)=varo(k,lmo+1-lo)
     46    ! Inversion de l'ordre des niveaux verticaux
     47    IF (ok_invertp) THEN
     48      DO lo = 1, lmo
     49        DO k = 1, ni * nj
     50          zpo(k, lo) = po(k, lmo + 1 - lo)
     51          zvaro(k, lo) = varo(k, lmo + 1 - lo)
     52        ENDDO
     53      ENDDO
     54    ELSE
     55      DO lo = 1, lmo
     56        DO k = 1, ni * nj
     57          zpo(k, lo) = po(k, lo)
     58          zvaro(k, lo) = varo(k, lo)
     59        ENDDO
     60      ENDDO
     61    ENDIF
     62
     63    DO ln = 1, lmn
     64      DO lo = 1, lmo - 1
     65        DO k = 1, ni * nj
     66          IF (pn(k, ln) >= zpo(k, 1)) THEN
     67            varn(k, ln) = zvaro(k, 1)
     68          ELSE IF (pn(k, ln) <= zpo(k, lmo)) THEN
     69            varn(k, ln) = zvaro(k, lmo)
     70          ELSE IF (pn(k, ln) <= zpo(k, lo) .AND. pn(k, ln) > zpo(k, lo + 1)) THEN
     71            coef = (pn(k, ln) - zpo(k, lo)) / (zpo(k, lo + 1) - zpo(k, lo))
     72            varn(k, ln) = zvaro(k, lo) + coef * (zvaro(k, lo + 1) - zvaro(k, lo))
     73          ENDIF
     74
     75        ENDDO
    5076      ENDDO
    5177    ENDDO
    52   ELSE
    53     DO lo=1,lmo
    54       DO k=1,ni*nj
    55         zpo(k,lo)=po(k,lo)
    56         zvaro(k,lo)=varo(k,lo)
    57       ENDDO
    58     ENDDO
    59   ENDIF
    6078
    61   DO ln=1,lmn
    62     DO lo=1,lmo-1
    63       DO k=1,ni*nj
    64         IF (pn(k,ln) >= zpo(k,1) ) THEN
    65           varn(k,ln) = zvaro(k,1)
    66         ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
    67           varn(k,ln) = zvaro(k,lmo)
    68         ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
    69           coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
    70           varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
    71         ENDIF
    72          
    73       ENDDO 
    74     ENDDO
    75   ENDDO               
     79  END SUBROUTINE pres2lev
    7680
    77 END SUBROUTINE pres2lev   
    78 
    79 END MODULE pres2lev_mod
     81END MODULE lmdz_pres2lev
Note: See TracChangeset for help on using the changeset viewer.