Changeset 1608 in lmdz_wrf for trunk


Ignore:
Timestamp:
Aug 18, 2017, 8:21:48 PM (8 years ago)
Author:
lfita
Message:

Adding new Fortran capabilities after Rominas' DistriCorrection?

Location:
trunk/tools
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/tools/interpolate.f90

    r1606 r1608  
    1616! Function to search a given value from a coarser version of the data
    1717
     18  USE module_definitions
    1819  USE module_generic
    1920
    … …  
    3738  REAL(r_k)                                              :: fraclonv, fraclatv
    3839  REAL(r_k), ALLOCATABLE, DIMENSION(:,:)                 :: difflonlat, lon, lat
    39   CHARACTER(LEN=50)                                      :: fname
    4040 
    4141! Variables
    … …  
    225225  REAL(r_k), ALLOCATABLE, DIMENSION(:,:)                 :: fractionlon, fractionlat
    226226  INTEGER                                                :: fracdx, fracdy
    227   CHARACTER(LEN=50)                                      :: fname
    228227
    229228!!!!!!! Variables

  • trunk/tools/module_ForDiagnostics.f90

    r1606 r1608  
    77MODULE module_ForDiagnostics
    88
     9  USE module_definitions
    910  USE module_generic
    1011  USE module_ForDiagnosticsVars
    … …  
    3132    IMPLICIT NONE
    3233
    33     INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    3434    INTEGER, INTENT(in)                                  :: d1, d2, d3, d4
    3535    REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in)        :: cldfra4D, pres4D
    … …  
    3838! Local
    3939    INTEGER                                              :: i,j,k, zdim, Ndim
    40     CHARACTER(LEN=50)                                    :: fname
    4140
    4241!!!!!!! Variables
    … …  
    7170    IMPLICIT NONE
    7271
    73     INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    7472    INTEGER, INTENT(in)                                  :: d1, d2, d3
    7573    REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in)           :: cldfra3D, pres3D
    … …  
    7876! Local
    7977    INTEGER                                              :: i,j,k, zdim, Ndim
    80     CHARACTER(LEN=50)                                    :: fname
    8178
    8279!!!!!!! Variables
    … …  
    109106    IMPLICIT NONE
    110107
    111     INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    112108    INTEGER, INTENT(in)                                  :: Ndim, d1, d2, d3, d4, zdim
    113109    REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in)       :: cldfra1D, pres1D
    … …  
    133129! Local
    134130    INTEGER                                              :: i,j,k
    135     CHARACTER(LEN=50)                                    :: fname
    136131
    137132!!!!!!! Variables
    … …  
    253248    IMPLICIT NONE
    254249
    255     INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    256250    INTEGER, INTENT(in)                                  :: d1, d2, d3, d4
    257251    REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in)        :: cldfra4D
    … …  
    260254! Local
    261255    INTEGER                                              :: i,j,k, zdim, Ndim
    262     CHARACTER(LEN=50)                                    :: fname
    263256
    264257!!!!!!! Variables
    … …  
    292285    IMPLICIT NONE
    293286
    294     INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    295287    INTEGER, INTENT(in)                                  :: d1, d2, d3
    296288    REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in)           :: cldfra3D
    … …  
    299291! Local
    300292    INTEGER                                              :: i,j,k, zdim, Ndim
    301     CHARACTER(LEN=50)                                    :: fname
    302293
    303294!!!!!!! Variables
    … …  
    328319    IMPLICIT NONE
    329320
    330     INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    331321    INTEGER, INTENT(in)                                  :: Ndim, d1, d2, d3, d4, zdim
    332322    REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in)       :: cldfra1D
    … …  
    348338! Local
    349339    INTEGER                                              :: i,j,k
    350     CHARACTER(LEN=50)                                    :: fname
    351340
    352341!!!!!!! Variables

  • trunk/tools/module_ForDiagnosticsVars.f90

    r1606 r1608  
    77MODULE module_ForDiagnosticsVars
    88
     9  USE module_definitions
    910  USE module_generic
    1011
    1112  IMPLICIT NONE
    1213
    13 !  INTEGER, PARAMETER                                     :: r_k = KIND(1.d0)
    1414  REAL(r_k), PARAMETER                                   :: ZEPSEC=1.0D-12
    1515! Low limit pressure for medium clouds [Pa]
    … …  
    1717! Low limit pressure for High clouds [Pa]
    1818  REAL(r_k), PARAMETER                                   :: prmlc = 68000.d0
    19 
    20   REAL(r_k), PARAMETER                                   :: zero=0.d0
    21   REAL(r_k), PARAMETER                                   :: one=1.d0
    22   REAL(r_k), PARAMETER                                   :: two=2.d0
    2319
    2420  CONTAINS
    … …  
    4036    IMPLICIT NONE
    4137
    42 !    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    4338    INTEGER, INTENT(in)                                  :: dz
    4439    REAL(r_k), DIMENSION(dz), INTENT(in)                 :: clfra, p
    … …  
    4742! Local
    4843    INTEGER                                              :: iz
    49     CHARACTER(LEN=50)                                    :: fname
    5044    REAL(r_k)                                            :: zclearl, zcloudl, zclearm, zcloudm,       &
    5145      zclearh, zcloudh
    … …  
    5650    fname = 'var_cllmh'
    5751
    58     zclearl = one
    59     zcloudl = zero
    60     zclearm = one
    61     zcloudm = zero
    62     zclearh = one
    63     zcloudh = zero
     52    zclearl = oneRK
     53    zcloudl = zeroRK
     54    zclearm = oneRK
     55    zcloudm = zeroRK
     56    zclearh = oneRK
     57    zcloudh = zeroRK
    6458
    65     var_cllmh = one
     59    var_cllmh = oneRK
    6660
    6761    DO iz=1, dz
    6862      IF (p(iz) < prmhc) THEN
    69         var_cllmh(3) = var_cllmh(3)*(one-MAX(clfra(iz),zcloudh))/(one-MIN(zcloudh,one-ZEPSEC))
     63        var_cllmh(3) = var_cllmh(3)*(oneRK-MAX(clfra(iz),zcloudh))/(oneRK-MIN(zcloudh,oneRK-ZEPSEC))
    7064        zcloudh = clfra(iz)
    7165      ELSE IF ( (p(iz) >= prmhc) .AND. (p(iz) < prmlc) ) THEN
    72         var_cllmh(2) = var_cllmh(2)*(one-MAX(clfra(iz),zcloudm))/(one-MIN(zcloudm,one-ZEPSEC))
     66        var_cllmh(2) = var_cllmh(2)*(oneRK-MAX(clfra(iz),zcloudm))/(oneRK-MIN(zcloudm,oneRK-ZEPSEC))
    7367        zcloudm = clfra(iz)
    7468      ELSE IF (p(iz) >= prmlc) THEN
    75         var_cllmh(1) = var_cllmh(1)*(one-MAX(clfra(iz),zcloudl))/(one-MIN(zcloudl,one-ZEPSEC))
     69        var_cllmh(1) = var_cllmh(1)*(oneRK-MAX(clfra(iz),zcloudl))/(oneRK-MIN(zcloudl,oneRK-ZEPSEC))
    7670        zcloudl = clfra(iz)
    7771      ELSE
    … …  
    8579    END DO
    8680
    87     var_cllmh = one - var_cllmh
     81    var_cllmh = oneRK - var_cllmh
    8882
    8983    RETURN
    … …  
    9791    IMPLICIT NONE
    9892
    99 !    INTEGER, PARAMETER                                   :: r_k = KIND(1.d0)
    10093    INTEGER, INTENT(in)                                  :: dz
    10194    REAL(r_k), DIMENSION(dz), INTENT(in)                 :: clfra
    … …  
    10396    INTEGER                                              :: iz
    10497    REAL(r_k)                                            :: zclear, zcloud
    105     CHARACTER(LEN=50)                                    :: fname
     98
    10699!!!!!!! Variables
    107100! cfra: 1-column cloud fraction values
    … …  
    109102    fname = 'var_clt'
    110103
    111     zclear = one
    112     zcloud = zero
     104    zclear = oneRK
     105    zcloud = zeroRK
    113106
    114107    DO iz=1,dz
    115       zclear = zclear*(one-MAX(clfra(iz),zcloud))/(one-MIN(zcloud,1.-ZEPSEC))
    116       var_clt = one - zclear
     108      zclear = zclear*(oneRK-MAX(clfra(iz),zcloud))/(oneRK-MIN(zcloud,1.-ZEPSEC))
     109      var_clt = oneRK - zclear
    117110      zcloud = clfra(iz)
    118111    END DO

  • trunk/tools/module_ForInterpolate.f90

    r1606 r1608  
    1010MODULE module_ForInterpolate
    1111
     12  USE module_definitions
    1213  USE module_generic
    1314
    … …  
    3738  REAL(r_k)                                              :: fraclonv, fraclatv
    3839  REAL(r_k), ALLOCATABLE, DIMENSION(:,:)                 :: difflonlat, lon, lat
    39   CHARACTER(LEN=50)                                      :: fname
    4040 
    4141! Variables
    … …  
    227227  REAL(r_k)                                              :: fraclonv, fraclatv
    228228  REAL(r_k), ALLOCATABLE, DIMENSION(:,:)                 :: difflonlat, lon, lat
    229   CHARACTER(LEN=50)                                      :: fname
    230229 
    231230! Variables
    … …  
    446445! Local
    447446  REAL(r_k), DIMENSION(dx,dy)                            :: difflonlat
    448   CHARACTER(LEN=50)                                      :: fname
    449447 
    450448! Variables
    … …  
    503501  REAL(r_k), ALLOCATABLE, DIMENSION(:,:)                 :: fractionlon, fractionlat
    504502  INTEGER                                                :: dfracdx, dfracdy, fracdx, fracdy
    505   CHARACTER(LEN=50)                                      :: fname
    506503
    507504!!!!!!! Variables
    … …  
    609606  REAL(r_k), ALLOCATABLE, DIMENSION(:,:)                 :: fractionlon, fractionlat
    610607  INTEGER                                                :: dfracdx, dfracdy, fracdx, fracdy
    611   CHARACTER(LEN=50)                                      :: fname
    612608
    613609!!!!!!! Variables
    … …  
    735731  REAL(r_k), DIMENSION(2)                                :: extremelon, extremelat, ipos
    736732  INTEGER, DIMENSION(2)                                  :: iLl
    737   CHARACTER(LEN=50)                                      :: fname
    738733
    739734!!!!!!! Variables
    … …  
    889884  REAL(r_k)                                              :: w
    890885  REAL(r_k), DIMENSION(3,16,pdimx,pdimy)                 :: outLlw
    891   CHARACTER(LEN=50)                                      :: fname
    892886
    893887!!!!!!! Variables
    … …  
    967961  REAL(r_k)                                              :: w
    968962  REAL(r_k), DIMENSION(3,16,pdimx,pdimy)                 :: outLlw
    969   CHARACTER(LEN=50)                                      :: fname
    970963
    971964!!!!!!! Variables
    … …  
    10481041  REAL(r_k)                                              :: w
    10491042  REAL(r_k), DIMENSION(3,16,pdimx,pdimy)                 :: outLlw
    1050   CHARACTER(LEN=50)                                      :: fname
    10511043
    10521044!!!!!!! Variables
    … …  
    11331125  REAL(r_k)                                              :: w
    11341126  REAL(r_k), DIMENSION(3,16,pdimx,pdimy)                 :: outLlw
    1135   CHARACTER(LEN=50)                                      :: fname
    11361127
    11371128!!!!!!! Variables
    … …  
    12251216  REAL(r_k), DIMENSION(dimx,dimy)                        :: difflonlat
    12261217  REAL(r_k), DIMENSION(2)                                :: extremelon, extremelat
    1227   CHARACTER(LEN=50)                                      :: fname
    12281218
    12291219!!!!!!! Variables
    … …  
    13241314  REAL(r_k), DIMENSION(dimy)                             :: difflat
    13251315  REAL(r_k), DIMENSION(2)                                :: extremelon, extremelat
    1326   CHARACTER(LEN=50)                                      :: fname
    13271316
    13281317!!!!!!! Variables

  • trunk/tools/module_generic.f90

    r1606 r1608  
    11MODULE module_generic
    22! Module with generic functions
     3
     4!!!!!!! Subroutines/Functions
     5! ErrMsg: Subroutine to stop execution and provide an error message
     6! ErrWarnMsg: Function to print error/warning message
    37! Index1DArrayR: Function to provide the first index of a given value inside a 1D real array
     8! Index1DArrayR_K: Function to provide the first index of a given value inside a 1D real(r_k) array
    49! Index2DArrayR: Function to provide the first index of a given value inside a 2D real array
    5 ! ErrWarnMsg: Function to print error/warning message
    6 
    7   INTEGER, PARAMETER                                     :: r_k = KIND(1.d0)
    8   ! Fill value at 64 bits
    9   REAL(r_k)                                              :: fillval64 = 1.e20
    10   CHARACTER(len=50), PARAMETER                           :: errormsg = 'ERROR -- error -- ERROR -- error'
    11   CHARACTER(len=50), PARAMETER                           :: warnmsg = 'WARNING -- warning -- WARNING -- warning'
     10! Nstrings: Function to repeat a number of times a given string
     11! RangeI: Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
     12! RangeR: Function to provide a range of d1 values from 'iniv' to 'endv', of real values in a vector
     13! RangeR_K: Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
     14! vectorR_KS: Function to transform a vector of reals to a string of characters
     15
     16  USE module_definitions
    1217
    1318  CONTAINS
     19
     20  CHARACTER(len=1000) FUNCTION vectorR_KS(d1, vector)
     21  ! Function to transform a vector of reals(r_k) to a string of characters
     22
     23    IMPLICIT NONE
     24
     25    INTEGER, INTENT(in)                                  :: d1
     26    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: vector
     27
     28! Local
     29    INTEGER                                              :: iv
     30    CHARACTER(len=50)                                    :: RS
     31
     32!!!!!!! Variables
     33! d1: length of the vector
     34! vector: values to transform
     35
     36    fname = 'vectorR_KS'
     37
     38    vectorR_KS = ''
     39    DO iv=1, d1
     40      WRITE(RS, '(F50.25)')vector(iv)
     41      IF (iv == 1) THEN
     42        vectorR_KS = TRIM(RS)
     43      ELSE
     44        vectorR_KS = TRIM(vectorR_KS) // ', ' // TRIM(RS)
     45      END IF
     46    END DO   
     47
     48  END FUNCTION vectorR_KS
     49
     50CHARACTER(len=1000) FUNCTION Nstrings(Strval, Ntimes)
     51! Function to repeat a number of times a given string
     52
     53  IMPLICIT NONE
     54
     55  CHARACTER(LEN=50), INTENT(in)                        :: Strval
     56  INTEGER, INTENT(in)                                  :: Ntimes
     57
     58! Local
     59  INTEGER                                              :: i
     60
     61!!!!!!! Variables
     62! Strval: String to repeat
     63! Ntimes: number of repetitions
     64
     65  fname = 'Nstrings'
     66
     67  Nstrings = ''
     68  Do i=1, Ntimes
     69    Nstrings = TRIM(Nstrings) // TRIM(Strval)
     70  END DO
     71
     72END FUNCTION Nstrings
    1473
    1574  INTEGER FUNCTION Index1DArrayR(array1D, d1, val)
    … …  
    2584! Local
    2685    INTEGER                                              :: i
    27     CHARACTER(LEN=50)                                    :: fname
    2886
    2987    fname = 'Index1DArrayR'
    … …  
    4098  END FUNCTION Index1DArrayR
    4199
     100  INTEGER FUNCTION Index1DArrayR_K(array1D, d1, val)
     101! Function to provide the first index of a given value inside a 1D real(r_k) array
     102
     103    IMPLICIT NONE
     104
     105    INTEGER, INTENT(in)                                  :: d1
     106    REAL(r_k), INTENT(in)                                :: val
     107    REAL(r_k), DIMENSION(d1), INTENT(in)                 :: array1D
     108
     109! Local
     110    INTEGER                                              :: i
     111
     112    fname = 'Index1DArrayR_K'
     113
     114    Index1DArrayR_K = -1
     115
     116    DO i=1,d1
     117      IF (array1d(i) == val) THEN
     118        Index1DArrayR_K = i
     119        EXIT
     120      END IF
     121    END DO
     122
     123  END FUNCTION Index1DArrayR_K
     124
    42125  FUNCTION Index2DArrayR(array2D, d1, d2, val)
    43126! Function to provide the first index of a given value inside a 2D real array
    … …  
    53136! Local
    54137    INTEGER                                              :: i, j
    55     CHARACTER(LEN=50)                                    :: fname
    56138
    57139    fname = 'Index2DArrayR'
    … …  
    71153  END FUNCTION Index2DArrayR
    72154
     155  FUNCTION RangeI(d1, iniv, endv)
     156! Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
     157
     158    IMPLICIT NONE
     159
     160    INTEGER, INTENT(in)                                  :: d1, iniv, endv
     161    INTEGER, DIMENSION(d1)                               :: RangeI
     162
     163! Local
     164    INTEGER                                              :: i, intv
     165
     166    fname = 'RangeI'
     167
     168    intv = (endv - iniv) / (d1*1 - 1)
     169
     170    RangeI(1) = iniv
     171    DO i=2,d1
     172      RangeI(i) = RangeI(i-1) + intv
     173    END DO
     174
     175  END FUNCTION RangeI
     176
     177  FUNCTION RangeR(d1, iniv, endv)
     178! Function to provide a range of d1 from 'iniv' to 'endv', of real values in a vector
     179
     180    IMPLICIT NONE
     181
     182    INTEGER, INTENT(in)                                  :: d1
     183    REAL, INTENT(in)                                     :: iniv, endv
     184    REAL, DIMENSION(d1)                                  :: RangeR
     185
     186! Local
     187    INTEGER                                              :: i
     188    REAL                                                 :: intv
     189
     190    fname = 'RangeR'
     191
     192    intv = (endv - iniv) / (d1*1. - 1.)
     193
     194    RangeR(1) = iniv
     195    DO i=2,d1
     196      RangeR(i) = RangeR(i-1) + intv
     197    END DO
     198
     199  END FUNCTION RangeR
     200
     201
     202  FUNCTION RangeR_K(d1, iniv, endv)
     203! Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
     204
     205    IMPLICIT NONE
     206
     207    INTEGER, INTENT(in)                                  :: d1
     208    REAL(r_k), INTENT(in)                                :: iniv, endv
     209    REAL(r_k), DIMENSION(d1)                             :: RangeR_K
     210
     211! Local
     212    INTEGER                                              :: i
     213    REAL(r_k)                                            :: intv
     214
     215    fname = 'RangeR_K'
     216
     217    intv = (endv - iniv) / (d1*oneRK-oneRK)
     218
     219    RangeR_K(1) = iniv
     220    DO i=2,d1
     221      RangeR_K(i) = RangeR_K(i-1) + intv
     222    END DO
     223
     224  END FUNCTION RangeR_K
     225
     226
     227SUBROUTINE ErrMsg(msg, funcn, errN)
     228! Subroutine to stop execution and provide an error message
     229
     230  IMPLICIT NONE
     231
     232  CHARACTER(LEN=*), INTENT(in)                           :: msg, funcn
     233  INTEGER, INTENT(in)                                    :: errN
     234
     235! Local
     236  CHARACTER(LEN=50)                                      :: emsg
     237
     238!!!!!!! Variables
     239! msg: message to print with the error
     240! funcn: name of the funciton, section to localize the error
     241! errN: number of the error provided for a given FORTRAN function
     242
     243  emsg = 'ERORR -- error -- ERROR -- error'
     244
     245  IF (errN /= 0) THEN
     246    PRINT *,TRiM(emsg)
     247    PRINT *,'  ' // TRIM(funcn) // ': ' // TRIM(msg) // ' !!'
     248    PRINT *,'    error number:', errN
     249    STOP
     250  END IF
     251
     252  RETURN
     253
     254END SUBROUTINE ErrMsg
     255
    73256  CHARACTER(LEN=50) FUNCTION ErrWarnMsg(msg)
    74257! Function to print error/warning message
    … …  
    78261    CHARACTER(LEN=3), INTENT(in)                         :: msg
    79262! Local
    80     CHARACTER(LEN=50)                                    :: fname
    81263
    82264    fname = 'ErrWarnMsg'
Note: See TracChangeset for help on using the changeset viewer.