Ignore:
Timestamp:
Nov 30, 2016, 1:28:41 PM (8 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2664:2719 into testing branch

Location:
LMDZ5/branches/testing
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90

    r2669 r2720  
    2020
    2121  USE infotrac_phy
     22  USE YOMCST
    2223
    2324  IMPLICIT NONE
     25
    2426  include "clesphys.h"
    25   include "YOMCST.h"
    26 
    2727
    2828  ! Input arguments
    … …  
    104104     !--convert to ug m-3 unit for consistency with offline fields
    105105     !
    106      do i=1,nbtr
    107         select case(trim(solsym(i)))
    108            case ("ASBCM")
     106     DO i=1,nbtr
     107        SELECT CASE(trim(solsym(i)))
     108           CASE ("ASBCM")
    109109              id_ASBCM = i
    110            case ("ASPOMM")
     110           CASE ("ASPOMM")
    111111              id_ASPOMM = i
    112            case ("ASSO4M")
     112           CASE ("ASSO4M")
    113113              id_ASSO4M = i
    114            case ("ASMSAM")
     114           CASE ("ASMSAM")
    115115              id_ASMSAM = i
    116            case ("CSSO4M")
     116           CASE ("CSSO4M")
    117117              id_CSSO4M = i
    118            case ("CSMSAM")
     118           CASE ("CSMSAM")
    119119              id_CSMSAM = i
    120            case ("SSSSM")
     120           CASE ("SSSSM")
    121121              id_SSSSM = i
    122            case ("CSSSM")
     122           CASE ("CSSSM")
    123123              id_CSSSM = i
    124            case ("ASSSM")
     124           CASE ("ASSSM")
    125125              id_ASSSM = i
    126            case ("CIDUSTM")
     126           CASE ("CIDUSTM")
    127127              id_CIDUSTM = i
    128            case ("AIBCM")
     128           CASE ("AIBCM")
    129129              id_AIBCM = i
    130            case ("AIPOMM")
     130           CASE ("AIPOMM")
    131131              id_AIPOMM = i
    132            case ("ASNO3M")
     132           CASE ("ASNO3M")
    133133              id_ASNO3M = i
    134            case ("CSNO3M")
     134           CASE ("CSNO3M")
    135135              id_CSNO3M = i
    136            case ("CINO3M")
     136           CASE ("CINO3M")
    137137              id_CINO3M = i
    138            end select
    139      enddo
    140 
     138           END SELECT
     139     ENDDO
    141140
    142141     bcsol(:,:)        =   tr_seri(:,:,id_ASBCM)                         *zrho(:,:)*1.e9  ! ASBCM
    … …  
    171170     !
    172171     ! Read and interpolate sulfate
    173      IF ( flag_aerosol .EQ. 1 .OR. &
    174           flag_aerosol .EQ. 6 ) THEN
     172     IF ( flag_aerosol .EQ. 1 .OR. flag_aerosol .EQ. 6 ) THEN
    175173
    176174        CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
    … …  
    178176        sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
    179177        loadso4=0.
    180      END IF
     178     ENDIF
    181179
    182180     ! Read and interpolate bcsol and bcins
    183      IF ( flag_aerosol .EQ. 2 .OR. &
    184           flag_aerosol .EQ. 6 ) THEN
     181     IF ( flag_aerosol .EQ. 2 .OR. flag_aerosol .EQ. 6 ) THEN
    185182
    186183        ! Get bc aerosol distribution
    … …  
    192189        bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
    193190        loadbc=0.
    194      END IF
    195 
     191     ENDIF
    196192
    197193     ! Read and interpolate pomsol and pomins
    198      IF ( flag_aerosol .EQ. 3 .OR. &
    199           flag_aerosol .EQ. 6 ) THEN
     194     IF ( flag_aerosol .EQ. 3 .OR. flag_aerosol .EQ. 6 ) THEN
    200195
    201196        CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
    … …  
    206201        pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
    207202        loadoa=0.
    208      END IF
    209 
     203     ENDIF
    210204
    211205     ! Read and interpolate csssm, ssssm, assssm
    212      IF (flag_aerosol .EQ. 4 .OR. &
    213           flag_aerosol .EQ. 6 ) THEN
     206     IF (flag_aerosol .EQ. 4 .OR. flag_aerosol .EQ. 6 ) THEN
    214207
    215208        CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
    … …  
    228221
    229222     ! Read and interpolate cidustm
    230      IF (flag_aerosol .EQ. 5 .OR.  &
    231           flag_aerosol .EQ. 6 ) THEN
     223     IF (flag_aerosol .EQ. 5 .OR. flag_aerosol .EQ. 6 ) THEN
    232224
    233225        CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
    … …  
    299291     DO i = 1, klon
    300292        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
    301      END DO
    302   END DO
     293     ENDDO
     294  ENDDO
    303295
    304296!--new aerosol properties

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90

    r2594 r2720  
    22! $Id: readaerosolstrato1_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
    33!
    4 subroutine readaerosolstrato1_rrtm(debut)
    5 
    6     use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, &
     4SUBROUTINE readaerosolstrato1_rrtm(debut)
     5
     6    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    77                        nf95_inq_varid, nf95_open
    8     use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
     8    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    99
    1010    USE phys_cal_mod, ONLY : mth_cur
    … …  
    1717    USE aero_mod
    1818    USE dimphy
    19     USE YOERAD   , ONLY : NLW
    20 
    21     implicit none
    22 
    23     include "YOMCST.h"
     19    USE YOERAD, ONLY : NLW
     20    USE YOMCST
     21
     22    IMPLICIT NONE
    2423
    2524! Variable input
    26     logical debut
     25    LOGICAL debut
    2726
    2827! Variables locales
    29     integer n_lat   ! number of latitudes in the input data
    30     integer n_lon   ! number of longitudes in the input data
    31     integer n_lev   ! number of levels in the input data
    32     integer n_month ! number of months in the input data
    33     real, pointer:: latitude(:)
    34     real, pointer:: longitude(:)
    35     real, pointer:: time(:)
    36     real, pointer:: lev(:)
    37     integer k, band, wave, i
    38     integer, save :: mth_pre
    39 
    40     real, allocatable, dimension(:,:), save :: tau_aer_strat
     28    INTEGER n_lat   ! number of latitudes in the input data
     29    INTEGER n_lon   ! number of longitudes in the input data
     30    INTEGER n_lev   ! number of levels in the input data
     31    INTEGER n_month ! number of months in the input data
     32    REAL, POINTER:: latitude(:)
     33    REAL, POINTER:: longitude(:)
     34    REAL, POINTER:: time(:)
     35    REAL, POINTER:: lev(:)
     36    INTEGER k, band, wave, i
     37    INTEGER, SAVE :: mth_pre
     38
     39    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tau_aer_strat
    4140!$OMP THREADPRIVATE(tau_aer_strat)
    4241
    4342! Champs reconstitues
    44     real, allocatable:: tauaerstrat(:, :, :, :)
    45     real, allocatable:: tauaerstrat_mois(:, :, :)
    46     real, allocatable:: tauaerstrat_mois_glo(:, :)
    47 
    48     real, allocatable:: sum_tau_aer_strat(:)
     43    REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :)
     44    REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :)
     45    REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :)
     46
     47    REAL, ALLOCATABLE:: sum_tau_aer_strat(:)
    4948
    5049! For NetCDF:
    51     integer ncid_in  ! IDs for input files
    52     integer varid, ncerr
     50    INTEGER ncid_in  ! IDs for input files
     51    INTEGER varid, ncerr
    5352
    5453! Stratospheric aerosols optical properties
    5554! alpha_sw_strat over the 6 bands is normalised by the 550 nm extinction coefficient
    56     real, dimension(nbands_sw_rrtm) :: alpha_sw_strat, piz_sw_strat, cg_sw_strat
    57     data alpha_sw_strat/0.8545564, 0.8451642, 0.9821724, 0.8145110, 0.3073565, 7.7966176E-02/
    58     data cg_sw_strat   /0.6997170, 0.6810035, 0.7403592, 0.7562674, 0.6676504, 0.3478689/
    59     data piz_sw_strat  /0.9999998, 0.9999998, 1.000000000, 0.9999958, 0.9977155, 0.4510679/
     55    REAL, DIMENSION(nbands_sw_rrtm) :: alpha_sw_strat, piz_sw_strat, cg_sw_strat
     56    DATA alpha_sw_strat/0.8545564, 0.8451642, 0.9821724, 0.8145110, 0.3073565, 7.7966176E-02/
     57    DATA cg_sw_strat   /0.6997170, 0.6810035, 0.7403592, 0.7562674, 0.6676504, 0.3478689/
     58    DATA piz_sw_strat  /0.9999998, 0.9999998, 1.000000000, 0.9999958, 0.9977155, 0.4510679/
    6059!
    6160!--diagnostics AOD in the SW
    6261! alpha_sw_strat_wave is *not* normalised by the 550 nm extinction coefficient
    63     real, dimension(nwave_sw) :: alpha_sw_strat_wave
    64     data alpha_sw_strat_wave/3.708007,4.125824,4.136584,3.887478,3.507738/
     62    REAL, DIMENSION(nwave_sw) :: alpha_sw_strat_wave
     63    DATA alpha_sw_strat_wave/3.708007,4.125824,4.136584,3.887478,3.507738/
    6564!
    6665!--diagnostics AOD in the LW at 10 um (not normalised by the 550 nm ext coefficient
    67     real :: alpha_lw_strat_wave(nwave_lw)
    68     data alpha_lw_strat_wave/0.2746812/
    69 !
    70     real, dimension(nbands_lw_rrtm) :: alpha_lw_abs_rrtm
    71     data alpha_lw_abs_rrtm/   8.8340312E-02, 6.9856711E-02, 6.2652975E-02, 5.7188231E-02, &
     66    REAL :: alpha_lw_strat_wave(nwave_lw)
     67    DATA alpha_lw_strat_wave/0.2746812/
     68!
     69    REAL, DIMENSION(nbands_lw_rrtm) :: alpha_lw_abs_rrtm
     70    DATA alpha_lw_abs_rrtm/   8.8340312E-02, 6.9856711E-02, 6.2652975E-02, 5.7188231E-02, &
    7271                              6.3157059E-02, 5.5072524E-02, 5.0571125E-02, 0.1349073, &   
    7372                              0.1381676, 9.6506312E-02, 5.1312990E-02, 2.4256418E-02, &
    … …  
    237236    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
    238237
    239 end subroutine readaerosolstrato1_rrtm
     238END SUBROUTINE readaerosolstrato1_rrtm

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90

    r2594 r2720  
    22! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
    33!
    4 subroutine readaerosolstrato2_rrtm(debut)
    5 
    6     use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, &
     4SUBROUTINE readaerosolstrato2_rrtm(debut)
     5
     6    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    77                        nf95_inq_varid, nf95_open
    8     use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
     8    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    99
    1010    USE phys_cal_mod, ONLY : mth_cur
    … …  
    1717    USE aero_mod
    1818    USE dimphy
    19     USE YOERAD   , ONLY : NLW
    20 
    21     implicit none
    22 
    23     include "YOMCST.h"
     19    USE YOERAD, ONLY : NLW
     20    USE YOMCST
     21
     22    IMPLICIT NONE
     23
    2424    INCLUDE "clesphys.h"
    2525
    … …  
    2828
    2929! Variable input
    30     logical, intent(in) ::  debut
     30    LOGICAL, INTENT(IN) ::  debut
    3131
    3232! Variables locales
    33     integer n_lat   ! number of latitudes in the input data
    34     integer n_lon   ! number of longitudes
    35     integer n_lev   ! number of levels in the input data
    36     integer n_month ! number of months in the input data
    37     integer n_wav   ! number of wavelengths in the input data
    38     real, pointer:: latitude(:)
    39     real, pointer:: longitude(:)
    40     real, pointer:: time(:)
    41     real, pointer:: lev(:)
    42     real, pointer:: wav(:)
    43     integer i,k,wave,band
    44     integer, save :: mth_pre
    45 
    46     real, allocatable, dimension(:,:,:), save :: tau_aer_strat
    47     real, allocatable, dimension(:,:,:), save :: piz_aer_strat
    48     real, allocatable, dimension(:,:,:), save :: cg_aer_strat
    49     real, allocatable, dimension(:,:,:), save :: taulw_aer_strat
     33    INTEGER n_lat   ! number of latitudes in the input data
     34    INTEGER n_lon   ! number of longitudes
     35    INTEGER n_lev   ! number of levels in the input data
     36    INTEGER n_month ! number of months in the input data
     37    INTEGER n_wav   ! number of wavelengths in the input data
     38    REAL, POINTER:: latitude(:)
     39    REAL, POINTER:: time(:)
     40    REAL, POINTER:: lev(:)
     41    REAL, POINTER:: wav(:)
     42    INTEGER i,k,wave,band
     43    INTEGER, SAVE :: mth_pre
     44
     45    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: tau_aer_strat
     46    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: piz_aer_strat
     47    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cg_aer_strat
     48    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: taulw_aer_strat
    5049!$OMP THREADPRIVATE(tau_aer_strat,piz_aer_strat,cg_aer_strat,taulw_aer_strat)
    5150
    5251! Champs reconstitues
    53     real, allocatable:: tauaerstrat(:, :, :, :)
    54     real, allocatable:: pizaerstrat(:, :, :, :)
    55     real, allocatable:: cgaerstrat(:, :, :, :)
    56     real, allocatable:: taulwaerstrat(:, :, :, :)
    57 
    58     real, allocatable:: tauaerstrat_mois(:, :, :, :)
    59     real, allocatable:: pizaerstrat_mois(:, :, :, :)
    60     real, allocatable:: cgaerstrat_mois(:, :, :, :)
    61     real, allocatable:: taulwaerstrat_mois(:, :, :, :)
    62 
    63     real, allocatable:: tauaerstrat_mois_glo(:, :, :)
    64     real, allocatable:: pizaerstrat_mois_glo(:, :, :)
    65     real, allocatable:: cgaerstrat_mois_glo(:, :, :)
    66     real, allocatable:: taulwaerstrat_mois_glo(:, :, :)
     52    REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :)
     53    REAL, ALLOCATABLE:: pizaerstrat(:, :, :, :)
     54    REAL, ALLOCATABLE:: cgaerstrat(:, :, :, :)
     55    REAL, ALLOCATABLE:: taulwaerstrat(:, :, :, :)
     56
     57    REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :, :)
     58    REAL, ALLOCATABLE:: pizaerstrat_mois(:, :, :, :)
     59    REAL, ALLOCATABLE:: cgaerstrat_mois(:, :, :, :)
     60    REAL, ALLOCATABLE:: taulwaerstrat_mois(:, :, :, :)
     61
     62    REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :, :)
     63    REAL, ALLOCATABLE:: pizaerstrat_mois_glo(:, :, :)
     64    REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :)
     65    REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :)
    6766
    6867! For NetCDF:
    69     integer ncid_in  ! IDs for input files
    70     integer varid, ncerr
     68    INTEGER ncid_in  ! IDs for input files
     69    INTEGER varid, ncerr
    7170
    7271!--------------------------------------------------------
    … …  
    343342    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
    344343
    345 end subroutine readaerosolstrato2_rrtm
     344END SUBROUTINE readaerosolstrato2_rrtm
Note: See TracChangeset for help on using the changeset viewer.