Changeset 2146 for LMDZ5/trunk/libf
- Timestamp:
- Nov 14, 2014, 9:22:21 PM (10 years ago)
- Location:
- LMDZ5/trunk/libf/phylmd
- Files:
-
- 24 edited
-
aero_mod.F90 (modified) (3 diffs)
-
aeropt_2bands.F90 (modified) (11 diffs)
-
aeropt_5wv.F90 (modified) (13 diffs)
-
phys_local_var_mod.F90 (modified) (12 diffs)
-
phys_output_ctrlout_mod.F90 (modified) (4 diffs)
-
phys_output_write_mod.F90 (modified) (10 diffs)
-
phys_state_var_mod.F90 (modified) (3 diffs)
-
physiq.F90 (modified) (8 diffs)
-
phytrac_mod.F90 (modified) (1 diff)
-
radlwsw_m.F90 (modified) (17 diffs)
-
readaerosol_optic.F90 (modified) (9 diffs)
-
readaerosolstrato.F90 (modified) (1 diff)
-
rrtm/aeropt_5wv_rrtm.F90 (modified) (13 diffs)
-
rrtm/aeropt_6bands_rrtm.F90 (modified) (12 diffs)
-
rrtm/radlsw.F90 (modified) (6 diffs)
-
rrtm/radlsw.intfb.h (modified) (2 diffs)
-
rrtm/readaerosol_optic_rrtm.F90 (modified) (5 diffs)
-
rrtm/readaerosolstrato_rrtm.F90 (modified) (7 diffs)
-
rrtm/recmwf_aero.F90 (modified) (30 diffs)
-
rrtm/rrtm_ecrt_140gp.F90 (modified) (5 diffs)
-
rrtm/rrtm_ecrt_140gp.intfb.h (modified) (2 diffs)
-
rrtm/rrtm_rrtm_140gp.F90 (modified) (4 diffs)
-
rrtm/rrtm_rrtm_140gp.intfb.h (modified) (2 diffs)
-
tracinca_mod.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/aero_mod.F90
r2003 r2146 6 6 ! 1/ Total number of aerosols for which an aerosol optical depth is provided 7 7 !--strat aerosols are only prescribed naero_tot = 10 ==> 11 8 !--adding nitrate naero_tot = 14 OB 8 9 9 INTEGER, PARAMETER :: naero_tot = 1 110 INTEGER, PARAMETER :: naero_tot = 14 10 11 11 12 ! Identification number used in aeropt_2bands and aeropt_5wv 12 13 ! corresponding to naero_tot 13 INTEGER, PARAMETER :: id_ASBCM = 1 14 INTEGER, PARAMETER :: id_ASPOMM = 2 15 INTEGER, PARAMETER :: id_ASSO4M = 3 16 INTEGER, PARAMETER :: id_CSSO4M = 4 17 INTEGER, PARAMETER :: id_SSSSM = 5 18 INTEGER, PARAMETER :: id_CSSSM = 6 19 INTEGER, PARAMETER :: id_ASSSM = 7 20 INTEGER, PARAMETER :: id_CIDUSTM = 8 21 INTEGER, PARAMETER :: id_AIBCM = 9 22 INTEGER, PARAMETER :: id_AIPOMM = 10 23 INTEGER, PARAMETER :: id_STRAT = 11 14 INTEGER, PARAMETER :: id_ASBCM_phy = 1 15 INTEGER, PARAMETER :: id_ASPOMM_phy = 2 16 INTEGER, PARAMETER :: id_ASSO4M_phy = 3 17 INTEGER, PARAMETER :: id_CSSO4M_phy = 4 18 INTEGER, PARAMETER :: id_SSSSM_phy = 5 19 INTEGER, PARAMETER :: id_CSSSM_phy = 6 20 INTEGER, PARAMETER :: id_ASSSM_phy = 7 21 INTEGER, PARAMETER :: id_CIDUSTM_phy = 8 22 INTEGER, PARAMETER :: id_AIBCM_phy = 9 23 INTEGER, PARAMETER :: id_AIPOMM_phy = 10 24 INTEGER, PARAMETER :: id_ASNO3M_phy = 11 25 INTEGER, PARAMETER :: id_CSNO3M_phy = 12 26 INTEGER, PARAMETER :: id_CINO3M_phy = 13 27 INTEGER, PARAMETER :: id_STRAT_phy = 14 24 28 25 29 ! Corresponding names for the aerosols … … 35 39 "AIBCM ", & 36 40 "AIPOMM ", & 41 "ASNO3M ", & 42 "CSNO3M ", & 43 "CINO3M ", & 37 44 "STRAT " /) 38 45 … … 66 73 ! 9 = NO3 67 74 68 ! Number of wavelengths75 ! Number of diagnostics wavelengths (5 SW + 1 LW @ 10 um) 69 76 INTEGER, PARAMETER :: nwave = 5 77 INTEGER, PARAMETER :: nwave_lw = 1 70 78 71 79 ! Number of modes spectral bands 72 80 INTEGER, parameter :: nbands = 2 73 INTEGER, parameter :: nbands_rrtm = 6 81 INTEGER, parameter :: nbands_sw_rrtm = 6 82 INTEGER, parameter :: nbands_lw_rrtm = 16 74 83 75 84 END MODULE aero_mod -
LMDZ5/trunk/libf/phylmd/aeropt_2bands.F90
r2003 r2146 29 29 REAL, DIMENSION(klon,klev), INTENT(in) :: pdel 30 30 REAL, INTENT(in) :: delt 31 REAL, DIMENSION(klon,klev,naero_ spc), INTENT(in) :: m_allaer31 REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer 32 32 !RAF 33 REAL, DIMENSION(klon,klev,naero_ spc), INTENT(in) :: m_allaer_pi33 REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer_pi 34 34 REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair 35 35 !RAF REAL, DIMENSION(klon,naero_tot),INTENT(in) :: fractnat_allaer … … 136 136 INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name 137 137 INTEGER :: nb_aer 138 REAL, DIMENSION(klon,klev,naero_ spc) :: mass_temp138 REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp 139 139 !RAF 140 REAL, DIMENSION(klon,klev,naero_ spc) :: mass_temp_pi140 REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp_pi 141 141 142 142 ! … … 607 607 nb_aer = 2 608 608 ALLOCATE (aerosol_name(nb_aer)) 609 aerosol_name(1) = id_ASSO4M 610 aerosol_name(2) = id_CSSO4M 609 aerosol_name(1) = id_ASSO4M_phy 610 aerosol_name(2) = id_CSSO4M_phy 611 611 ELSEIF (flag_aerosol .EQ. 2) THEN 612 612 nb_aer = 2 613 613 ALLOCATE (aerosol_name(nb_aer)) 614 aerosol_name(1) = id_ASBCM 615 aerosol_name(2) = id_AIBCM 614 aerosol_name(1) = id_ASBCM_phy 615 aerosol_name(2) = id_AIBCM_phy 616 616 ELSEIF (flag_aerosol .EQ. 3) THEN 617 617 nb_aer = 2 618 618 ALLOCATE (aerosol_name(nb_aer)) 619 aerosol_name(1) = id_ASPOMM 620 aerosol_name(2) = id_AIPOMM 619 aerosol_name(1) = id_ASPOMM_phy 620 aerosol_name(2) = id_AIPOMM_phy 621 621 ELSEIF (flag_aerosol .EQ. 4) THEN 622 622 nb_aer = 3 623 623 ALLOCATE (aerosol_name(nb_aer)) 624 aerosol_name(1) = id_CSSSM 625 aerosol_name(2) = id_SSSSM 626 aerosol_name(3) = id_ASSSM 624 aerosol_name(1) = id_CSSSM_phy 625 aerosol_name(2) = id_SSSSM_phy 626 aerosol_name(3) = id_ASSSM_phy 627 627 ELSEIF (flag_aerosol .EQ. 5) THEN 628 628 nb_aer = 1 629 629 ALLOCATE (aerosol_name(nb_aer)) 630 aerosol_name(1) = id_CIDUSTM 630 aerosol_name(1) = id_CIDUSTM_phy 631 631 ELSEIF (flag_aerosol .EQ. 6) THEN 632 632 nb_aer = 10 633 633 ALLOCATE (aerosol_name(nb_aer)) 634 aerosol_name(1) = id_ASSO4M 635 aerosol_name(2) = id_ASBCM 636 aerosol_name(3) = id_AIBCM 637 aerosol_name(4) = id_ASPOMM 638 aerosol_name(5) = id_AIPOMM 639 aerosol_name(6) = id_CSSSM 640 aerosol_name(7) = id_SSSSM 641 aerosol_name(8) = id_ASSSM 642 aerosol_name(9) = id_CIDUSTM 643 aerosol_name(10)= id_CSSO4M 634 aerosol_name(1) = id_ASSO4M_phy 635 aerosol_name(2) = id_ASBCM_phy 636 aerosol_name(3) = id_AIBCM_phy 637 aerosol_name(4) = id_ASPOMM_phy 638 aerosol_name(5) = id_AIPOMM_phy 639 aerosol_name(6) = id_CSSSM_phy 640 aerosol_name(7) = id_SSSSM_phy 641 aerosol_name(8) = id_ASSSM_phy 642 aerosol_name(9) = id_CIDUSTM_phy 643 aerosol_name(10)= id_CSSO4M_phy 644 644 ENDIF 645 645 … … 678 678 DO m=1,nb_aer ! tau is only computed for each mass 679 679 fac=1.0 680 IF (aerosol_name(m).EQ.id_ASBCM ) THEN680 IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN 681 681 soluble=.TRUE. 682 682 spsol=1 683 683 spss=0 684 ELSEIF (aerosol_name(m).EQ.id_ASPOMM ) THEN684 ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 685 685 soluble=.TRUE. 686 686 spsol=2 687 687 spss=0 688 ELSEIF (aerosol_name(m).EQ.id_ASSO4M ) THEN688 ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN 689 689 soluble=.TRUE. 690 690 spsol=3 691 691 spss=0 692 692 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 693 ELSEIF (aerosol_name(m).EQ.id_CSSO4M ) THEN693 ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN 694 694 soluble=.TRUE. 695 695 spsol=4 696 696 spss=0 697 697 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 698 ELSEIF (aerosol_name(m).EQ.id_SSSSM ) THEN698 ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 699 699 soluble=.TRUE. 700 700 spsol=5 701 701 spss=3 702 ELSEIF (aerosol_name(m).EQ.id_CSSSM ) THEN702 ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 703 703 soluble=.TRUE. 704 704 spsol=6 705 705 spss=2 706 ELSEIF (aerosol_name(m).EQ.id_ASSSM ) THEN706 ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN 707 707 soluble=.TRUE. 708 708 spsol=7 709 709 spss=1 710 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM ) THEN710 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 711 711 soluble=.FALSE. 712 712 spinsol=1 713 713 spss=0 714 ELSEIF (aerosol_name(m).EQ.id_AIBCM ) THEN714 ELSEIF (aerosol_name(m).EQ.id_AIBCM_phy) THEN 715 715 soluble=.FALSE. 716 716 spinsol=2 717 717 spss=0 718 ELSEIF (aerosol_name(m).EQ.id_AIPOMM ) THEN718 ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 719 719 soluble=.FALSE. 720 720 spinsol=3 … … 944 944 DO k=1, KLEV 945 945 DO i=1, KLON 946 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSO4M ,inu)+tau_ae(i,k,id_CSSO4M,inu)+ &947 tau_ae(i,k,id_ASBCM ,inu)+tau_ae(i,k,id_AIBCM,inu)+ &948 tau_ae(i,k,id_ASPOMM ,inu)+tau_ae(i,k,id_AIPOMM,inu)+ &949 tau_ae(i,k,id_ASSSM ,inu)+tau_ae(i,k,id_CSSSM,inu)+ &950 tau_ae(i,k,id_SSSSM ,inu)+ tau_ae(i,k,id_CIDUSTM,inu)946 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSO4M_phy,inu)+tau_ae(i,k,id_CSSO4M_phy,inu)+ & 947 tau_ae(i,k,id_ASBCM_phy,inu)+tau_ae(i,k,id_AIBCM_phy,inu)+ & 948 tau_ae(i,k,id_ASPOMM_phy,inu)+tau_ae(i,k,id_AIPOMM_phy,inu)+ & 949 tau_ae(i,k,id_ASSSM_phy,inu)+tau_ae(i,k,id_CSSSM_phy,inu)+ & 950 tau_ae(i,k,id_SSSSM_phy,inu)+ tau_ae(i,k,id_CIDUSTM_phy,inu) 951 951 tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5) 952 952 953 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)+ &954 tau_ae(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)+ &955 tau_ae(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)+ &956 tau_ae(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)+ &957 tau_ae(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)+ &958 tau_ae(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)+ &959 tau_ae(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)+ &960 tau_ae(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)+ &961 tau_ae(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)+ &962 tau_ae(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)) &953 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ & 954 tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+ & 955 tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)+ & 956 tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+ & 957 tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+ & 958 tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+ & 959 tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+ & 960 tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+ & 961 tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+ & 962 tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) & 963 963 /tau_allaer(i,k,mrfspecies,inu) 964 964 piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1) 965 965 966 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)*cg_ae(i,k,id_ASSO4M,inu)+ &967 tau_ae(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)*cg_ae(i,k,id_CSSO4M,inu)+ &968 tau_ae(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)*cg_ae(i,k,id_ASBCM,inu)+ &969 tau_ae(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)*cg_ae(i,k,id_AIBCM,inu)+ &970 tau_ae(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)*cg_ae(i,k,id_ASPOMM,inu)+ &971 tau_ae(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)*cg_ae(i,k,id_AIPOMM,inu)+ &972 tau_ae(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)*cg_ae(i,k,id_ASSSM,inu)+ &973 tau_ae(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)*cg_ae(i,k,id_CSSSM,inu)+ &974 tau_ae(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)*cg_ae(i,k,id_SSSSM,inu)+ &975 tau_ae(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)*cg_ae(i,k,id_CIDUSTM,inu))/ &966 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ & 967 tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)*cg_ae(i,k,id_CSSO4M_phy,inu)+ & 968 tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)*cg_ae(i,k,id_ASBCM_phy,inu)+ & 969 tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu)+ & 970 tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)+ & 971 tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu)+ & 972 tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)*cg_ae(i,k,id_ASSSM_phy,inu)+ & 973 tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu)+ & 974 tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu)+ & 975 tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)*cg_ae(i,k,id_CIDUSTM_phy,inu))/ & 976 976 (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu)) 977 977 ENDDO … … 983 983 DO i=1, KLON 984 984 !RAF 985 tau_allaer(i,k,mrfspecies,inu)=tau_ae_pi(i,k,id_ASSO4M ,inu)+ &986 tau_ae_pi(i,k,id_CSSO4M ,inu)+ &987 tau_ae_pi(i,k,id_ASBCM ,inu)+ &988 tau_ae_pi(i,k,id_AIBCM ,inu)+ &989 tau_ae_pi(i,k,id_ASPOMM ,inu)+ &990 tau_ae_pi(i,k,id_AIPOMM ,inu)+ &991 tau_ae_pi(i,k,id_ASSSM ,inu)+ &992 tau_ae_pi(i,k,id_CSSSM ,inu)+ &993 tau_ae_pi(i,k,id_SSSSM ,inu)+ &994 tau_ae_pi(i,k,id_CIDUSTM ,inu)985 tau_allaer(i,k,mrfspecies,inu)=tau_ae_pi(i,k,id_ASSO4M_phy,inu)+ & 986 tau_ae_pi(i,k,id_CSSO4M_phy,inu)+ & 987 tau_ae_pi(i,k,id_ASBCM_phy,inu)+ & 988 tau_ae_pi(i,k,id_AIBCM_phy,inu)+ & 989 tau_ae_pi(i,k,id_ASPOMM_phy,inu)+ & 990 tau_ae_pi(i,k,id_AIPOMM_phy,inu)+ & 991 tau_ae_pi(i,k,id_ASSSM_phy,inu)+ & 992 tau_ae_pi(i,k,id_CSSSM_phy,inu)+ & 993 tau_ae_pi(i,k,id_SSSSM_phy,inu)+ & 994 tau_ae_pi(i,k,id_CIDUSTM_phy,inu) 995 995 tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5) 996 996 997 piz_allaer(i,k,mrfspecies,inu)=(tau_ae_pi(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)+ &998 tau_ae_pi(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)+ &999 tau_ae_pi(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)+ &1000 tau_ae_pi(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)+ &1001 tau_ae_pi(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)+ &1002 tau_ae_pi(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)+ &1003 tau_ae_pi(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)+ &1004 tau_ae_pi(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)+ &1005 tau_ae_pi(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)+ &1006 tau_ae_pi(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)) &997 piz_allaer(i,k,mrfspecies,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ & 998 tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+ & 999 tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)+ & 1000 tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+ & 1001 tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+ & 1002 tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+ & 1003 tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+ & 1004 tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+ & 1005 tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+ & 1006 tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) & 1007 1007 /tau_allaer(i,k,mrfspecies,inu) 1008 1008 piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1) 1009 1009 1010 1010 cg_allaer(i,k,mrfspecies,inu)=(& 1011 tau_ae_pi(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)*cg_ae(i,k,id_ASSO4M,inu)+ &1012 tau_ae_pi(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)*cg_ae(i,k,id_CSSO4M,inu)+ &1013 tau_ae_pi(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)*cg_ae(i,k,id_ASBCM,inu)+ &1014 tau_ae_pi(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)*cg_ae(i,k,id_AIBCM,inu)+ &1015 tau_ae_pi(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)*cg_ae(i,k,id_ASPOMM,inu)+ &1016 tau_ae_pi(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)*cg_ae(i,k,id_AIPOMM,inu)+ &1017 tau_ae_pi(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)*cg_ae(i,k,id_ASSSM,inu)+ &1018 tau_ae_pi(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)*cg_ae(i,k,id_CSSSM,inu)+ &1019 tau_ae_pi(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)*cg_ae(i,k,id_SSSSM,inu)+ &1020 tau_ae_pi(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)*&1021 cg_ae(i,k,id_CIDUSTM ,inu))/ &1011 tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ & 1012 tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)*cg_ae(i,k,id_CSSO4M_phy,inu)+ & 1013 tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)*cg_ae(i,k,id_ASBCM_phy,inu)+ & 1014 tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu)+ & 1015 tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)+ & 1016 tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu)+ & 1017 tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)*cg_ae(i,k,id_ASSSM_phy,inu)+ & 1018 tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu)+ & 1019 tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu)+ & 1020 tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)*& 1021 cg_ae(i,k,id_CIDUSTM_phy,inu))/ & 1022 1022 (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu)) 1023 1023 ENDDO … … 1027 1027 DO k=1, KLEV 1028 1028 DO i=1, KLON 1029 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASBCM ,inu)+tau_ae(i,k,id_AIBCM,inu)1029 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASBCM_phy,inu)+tau_ae(i,k,id_AIBCM_phy,inu) 1030 1030 tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5) 1031 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu) &1032 +tau_ae(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu))/ &1031 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu) & 1032 +tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu))/ & 1033 1033 tau_allaer(i,k,mrfspecies,inu) 1034 1034 piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1) 1035 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu) *cg_ae(i,k,id_ASBCM,inu)&1036 +tau_ae(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)*cg_ae(i,k,id_AIBCM,inu))/ &1035 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu) *cg_ae(i,k,id_ASBCM_phy,inu)& 1036 +tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu))/ & 1037 1037 (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu)) 1038 1038 ENDDO … … 1043 1043 DO k=1, KLEV 1044 1044 DO i=1, KLON 1045 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSO4M ,inu)+tau_ae(i,k,id_CSSO4M,inu)1045 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSO4M_phy,inu)+tau_ae(i,k,id_CSSO4M_phy,inu) 1046 1046 tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5) 1047 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu) &1048 +tau_ae(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu))/ &1047 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu) & 1048 +tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu))/ & 1049 1049 tau_allaer(i,k,mrfspecies,inu) 1050 1050 piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1) 1051 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu) *cg_ae(i,k,id_CSSO4M,inu)&1052 +tau_ae(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)*cg_ae(i,k,id_ASSO4M,inu))/ &1051 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu) *cg_ae(i,k,id_CSSO4M_phy,inu)& 1052 +tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu))/ & 1053 1053 (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu)) 1054 1054 ENDDO … … 1059 1059 DO k=1, KLEV 1060 1060 DO i=1, KLON 1061 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASPOMM ,inu)+tau_ae(i,k,id_AIPOMM,inu)1061 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASPOMM_phy,inu)+tau_ae(i,k,id_AIPOMM_phy,inu) 1062 1062 tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5) 1063 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu) &1064 +tau_ae(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu))/ &1063 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu) & 1064 +tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu))/ & 1065 1065 tau_allaer(i,k,mrfspecies,inu) 1066 1066 piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1) 1067 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu) *cg_ae(i,k,id_ASPOMM,inu)&1068 +tau_ae(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)*cg_ae(i,k,id_AIPOMM,inu))/ &1067 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu) *cg_ae(i,k,id_ASPOMM_phy,inu)& 1068 +tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu))/ & 1069 1069 (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu)) 1070 1070 ENDDO … … 1075 1075 DO k=1, KLEV 1076 1076 DO i=1, KLON 1077 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_CIDUSTM ,inu)1077 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_CIDUSTM_phy,inu) 1078 1078 tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5) 1079 piz_allaer(i,k,mrfspecies,inu)=piz_ae(i,k,id_CIDUSTM ,inu)1080 cg_allaer(i,k,mrfspecies,inu)=cg_ae(i,k,id_CIDUSTM ,inu)1079 piz_allaer(i,k,mrfspecies,inu)=piz_ae(i,k,id_CIDUSTM_phy,inu) 1080 cg_allaer(i,k,mrfspecies,inu)=cg_ae(i,k,id_CIDUSTM_phy,inu) 1081 1081 ENDDO 1082 1082 ENDDO … … 1086 1086 DO k=1, KLEV 1087 1087 DO i=1, KLON 1088 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSSM ,inu)+tau_ae(i,k,id_CSSSM,inu)+tau_ae(i,k,id_SSSSM,inu)1088 tau_allaer(i,k,mrfspecies,inu)=tau_ae(i,k,id_ASSSM_phy,inu)+tau_ae(i,k,id_CSSSM_phy,inu)+tau_ae(i,k,id_SSSSM_phy,inu) 1089 1089 tau_allaer(i,k,mrfspecies,inu)=MAX(tau_allaer(i,k,mrfspecies,inu),1e-5) 1090 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu) &1091 +tau_ae(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu) &1092 +tau_ae(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu))/ &1090 piz_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu) & 1091 +tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu) & 1092 +tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu))/ & 1093 1093 tau_allaer(i,k,mrfspecies,inu) 1094 1094 piz_allaer(i,k,mrfspecies,inu)=MAX(piz_allaer(i,k,mrfspecies,inu),0.1) 1095 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu) *cg_ae(i,k,id_ASSSM,inu)&1096 +tau_ae(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)*cg_ae(i,k,id_CSSSM,inu) &1097 +tau_ae(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)*cg_ae(i,k,id_SSSSM,inu))/ &1095 cg_allaer(i,k,mrfspecies,inu)=(tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu) *cg_ae(i,k,id_ASSSM_phy,inu)& 1096 +tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu) & 1097 +tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu))/ & 1098 1098 (tau_allaer(i,k,mrfspecies,inu)*piz_allaer(i,k,mrfspecies,inu)) 1099 1099 ENDDO -
LMDZ5/trunk/libf/phylmd/aeropt_5wv.F90
r1907 r2146 57 57 REAL, DIMENSION(klon,klev), INTENT(in) :: pdel 58 58 REAL, INTENT(in) :: delt 59 REAL, DIMENSION(klon,klev,naero_ spc), INTENT(in) :: m_allaer59 REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer 60 60 REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair 61 61 INTEGER,INTENT(in) :: flag_aerosol … … 67 67 ! 68 68 REAL, DIMENSION(klon), INTENT(out) :: ai ! POLDER aerosol index 69 REAL, DIMENSION(klon,nwave,naero_spc), INTENT(out) :: tausum 70 REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(out) :: tau 69 ! REAL, DIMENSION(klon,nwave,naero_spc), INTENT(out) :: tausum 70 ! REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(out) :: tau 71 REAL, DIMENSION(klon,nwave,naero_tot), INTENT(out) :: tausum 72 REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(out) :: tau 71 73 72 74 … … 77 79 LOGICAL :: soluble 78 80 79 INTEGER :: i, k, ierr, m 81 INTEGER :: i, k, ierr, m, aerindex 80 82 INTEGER :: spsol, spinsol, spss, la 81 83 INTEGER :: RH_num(klon,klev) … … 156 158 REAL :: piz_aeri_5wv(las,naero_insoluble) ! Insoluble comp. 1- Dust: 2- BC; 3- POM 157 159 158 REAL, DIMENSION(klon,klev,naero_ spc) :: mass_temp160 REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp 159 161 160 162 ! … … 639 641 nb_aer = 2 640 642 ALLOCATE (aerosol_name(nb_aer)) 641 aerosol_name(1) = id_ASSO4M 642 aerosol_name(2) = id_CSSO4M 643 aerosol_name(1) = id_ASSO4M_phy 644 aerosol_name(2) = id_CSSO4M_phy 643 645 ELSEIF (flag_aerosol .EQ. 2) THEN 644 646 nb_aer = 2 645 647 ALLOCATE (aerosol_name(nb_aer)) 646 aerosol_name(1) = id_ASBCM 647 aerosol_name(2) = id_AIBCM 648 aerosol_name(1) = id_ASBCM_phy 649 aerosol_name(2) = id_AIBCM_phy 648 650 ELSEIF (flag_aerosol .EQ. 3) THEN 649 651 nb_aer = 2 650 652 ALLOCATE (aerosol_name(nb_aer)) 651 aerosol_name(1) = id_ASPOMM 652 aerosol_name(2) = id_AIPOMM 653 aerosol_name(1) = id_ASPOMM_phy 654 aerosol_name(2) = id_AIPOMM_phy 653 655 ELSEIF (flag_aerosol .EQ. 4) THEN 654 656 nb_aer = 3 655 657 ALLOCATE (aerosol_name(nb_aer)) 656 aerosol_name(1) = id_CSSSM 657 aerosol_name(2) = id_SSSSM 658 aerosol_name(3) = id_ASSSM 658 aerosol_name(1) = id_CSSSM_phy 659 aerosol_name(2) = id_SSSSM_phy 660 aerosol_name(3) = id_ASSSM_phy 659 661 ELSEIF (flag_aerosol .EQ. 5) THEN 660 662 nb_aer = 1 661 663 ALLOCATE (aerosol_name(nb_aer)) 662 aerosol_name(1) = id_CIDUSTM 664 aerosol_name(1) = id_CIDUSTM_phy 663 665 ELSEIF (flag_aerosol .EQ. 6) THEN 664 666 nb_aer = 10 665 667 ALLOCATE (aerosol_name(nb_aer)) 666 aerosol_name(1) = id_ASSO4M 667 aerosol_name(2) = id_ASBCM 668 aerosol_name(3) = id_AIBCM 669 aerosol_name(4) = id_ASPOMM 670 aerosol_name(5) = id_AIPOMM 671 aerosol_name(6) = id_CSSSM 672 aerosol_name(7) = id_SSSSM 673 aerosol_name(8) = id_ASSSM 674 aerosol_name(9) = id_CIDUSTM 675 aerosol_name(10) = id_CSSO4M 668 aerosol_name(1) = id_ASSO4M_phy 669 aerosol_name(2) = id_ASBCM_phy 670 aerosol_name(3) = id_AIBCM_phy 671 aerosol_name(4) = id_ASPOMM_phy 672 aerosol_name(5) = id_AIPOMM_phy 673 aerosol_name(6) = id_CSSSM_phy 674 aerosol_name(7) = id_SSSSM_phy 675 aerosol_name(8) = id_ASSSM_phy 676 aerosol_name(9) = id_CIDUSTM_phy 677 aerosol_name(10) = id_CSSO4M_phy 676 678 ENDIF 677 679 … … 712 714 DO m=1,nb_aer ! tau is only computed for each mass 713 715 fac=1.0 714 IF (aerosol_name(m).EQ.id_ASBCM ) THEN716 IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN 715 717 soluble=.TRUE. 716 718 spsol=1 717 719 spss=0 718 ELSEIF (aerosol_name(m).EQ.id_ASPOMM ) THEN720 ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 719 721 soluble=.TRUE. 720 722 spsol=2 721 723 spss=0 722 ELSEIF (aerosol_name(m).EQ.id_ASSO4M ) THEN724 ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN 723 725 soluble=.TRUE. 724 726 spsol=3 725 727 spss=0 726 728 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 727 ELSEIF (aerosol_name(m).EQ.id_CSSO4M ) THEN729 ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN 728 730 soluble=.TRUE. 729 731 spsol=4 730 732 spss=0 731 733 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 732 ELSEIF (aerosol_name(m).EQ.id_SSSSM ) THEN734 ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 733 735 soluble=.TRUE. 734 736 spsol=5 735 737 spss=3 736 ELSEIF (aerosol_name(m).EQ.id_CSSSM ) THEN738 ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 737 739 soluble=.TRUE. 738 740 spsol=6 739 741 spss=2 740 ELSEIF (aerosol_name(m).EQ.id_ASSSM ) THEN742 ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN 741 743 soluble=.TRUE. 742 744 spsol=7 743 745 spss=1 744 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM ) THEN746 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 745 747 soluble=.FALSE. 746 748 spinsol=1 747 749 spss=0 748 ELSEIF (aerosol_name(m).EQ.id_AIBCM ) THEN750 ELSEIF (aerosol_name(m).EQ.id_AIBCM_phy) THEN 749 751 soluble=.FALSE. 750 752 spinsol=2 751 753 spss=0 752 ELSEIF (aerosol_name(m).EQ.id_AIPOMM ) THEN754 ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 753 755 soluble=.FALSE. 754 756 spinsol=3 … … 765 767 used_tau(naero_soluble+spinsol)=.TRUE. 766 768 ENDIF 769 770 aerindex=aerosol_name(m) 767 771 768 772 DO la=1,las … … 779 783 H=rh(i,k)/100 780 784 tau_ae5wv_int=A1_ASSSM(k)+A2_ASSSM(k)*H+A3_ASSSM(k)/(H-1.05) 781 tau(i,k,la, spsol) = mass_temp(i,k,spsol)*1000.*zdp1(i,k) &785 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 782 786 *tau_ae5wv_int*delt*fac 783 tausum(i,la, spsol)=tausum(i,la,spsol)+tau(i,k,la,spsol)787 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 784 788 ENDDO 785 789 ENDDO … … 794 798 H=rh(i,k)/100 795 799 tau_ae5wv_int=A1_CSSSM(k)+A2_CSSSM(k)*H+A3_CSSSM(k)/(H-1.05) 796 tau(i,k,la, spsol) = mass_temp(i,k,spsol)*1000.*zdp1(i,k) &800 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 797 801 *tau_ae5wv_int*delt*fac 798 tausum(i,la, spsol) = tausum(i,la,spsol)+tau(i,k,la,spsol)802 tausum(i,la,aerindex) = tausum(i,la,aerindex)+tau(i,k,la,aerindex) 799 803 ENDDO 800 804 ENDDO … … 809 813 H=rh(i,k)/100 810 814 tau_ae5wv_int=A1_SSSSM(k)+A2_SSSSM(k)*H+A3_SSSSM(k)/(H-1.05) 811 tau(i,k,la, spsol) = mass_temp(i,k,spsol)*1000.*zdp1(i,k) &815 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 812 816 *tau_ae5wv_int*delt*fac 813 tausum(i,la, spsol)=tausum(i,la,spsol)+tau(i,k,la,spsol)817 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 814 818 ENDDO 815 819 ENDDO … … 824 828 alpha_aers_5wv(RH_num(i,k),la,spsol)) 825 829 826 tau(i,k,la, spsol) = mass_temp(i,k,spsol)*1000.*zdp1(i,k) &830 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 827 831 *tau_ae5wv_int*delt*fac 828 tausum(i,la, spsol)=tausum(i,la,spsol)+tau(i,k,la,spsol)832 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 829 833 ENDDO 830 834 ENDDO … … 836 840 DO i=1, KLON 837 841 tau_ae5wv_int = alpha_aeri_5wv(la,spinsol) 838 tau(i,k,la, naero_soluble+spinsol) = mass_temp(i,k,naero_soluble+spinsol)*1000.*zdp1(i,k)* &842 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k)* & 839 843 tau_ae5wv_int*delt*fac 840 tausum(i,la,naero_soluble+spinsol)= tausum(i,la,naero_soluble+spinsol) & 841 +tau(i,k,la,naero_soluble+spinsol) 844 tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex) 842 845 ENDDO 843 846 ENDDO … … 880 883 END DO 881 884 882 od550lt1aer(:)=tausum(:,2,id_ASSO4M )+tausum(:,2,id_ASBCM)+tausum(:,2,id_AIBCM)+ &883 tausum(:,2,id_ASPOMM )+tausum(:,2,id_AIPOMM)+tausum(:,2,id_ASSSM)+ &884 0.03*tausum(:,2,id_CSSSM )+0.4*tausum(:,2,id_CIDUSTM)885 od550lt1aer(:)=tausum(:,2,id_ASSO4M_phy)+tausum(:,2,id_ASBCM_phy)+tausum(:,2,id_AIBCM_phy)+ & 886 tausum(:,2,id_ASPOMM_phy)+tausum(:,2,id_AIPOMM_phy)+tausum(:,2,id_ASSSM_phy)+ & 887 0.03*tausum(:,2,id_CSSSM_phy)+0.4*tausum(:,2,id_CIDUSTM_phy) 885 888 886 889 -
LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90
r2136 r2146 96 96 REAL, SAVE, ALLOCATABLE :: topswcf_aero(:,:), solswcf_aero(:,:) ! diag 97 97 !$OMP THREADPRIVATE(topswcf_aero,solswcf_aero) 98 ! LW radiation diagnostics CK 99 REAL, SAVE, ALLOCATABLE :: toplwad_aero(:), sollwad_aero(:) ! diag 100 !$OMP THREADPRIVATE(toplwad_aero,sollwad_aero) 101 REAL, SAVE, ALLOCATABLE :: toplwai_aero(:), sollwai_aero(:) ! diag 102 !$OMP THREADPRIVATE(toplwai_aero,sollwai_aero) 103 REAL, SAVE, ALLOCATABLE :: toplwad0_aero(:), sollwad0_aero(:) ! diag 104 !$OMP THREADPRIVATE(toplwad0_aero,sollwad0_aero) 98 105 ! Special RRTM 99 106 REAL, SAVE, ALLOCATABLE :: ZLWFT0_i(:,:), ZSWFT0_i(:,:) ! diag … … 140 147 REAL, SAVE, ALLOCATABLE :: sconcso4(:) 141 148 !$OMP THREADPRIVATE(sconcso4) 149 REAL, SAVE, ALLOCATABLE :: sconcno3(:) 150 !$OMP THREADPRIVATE(sconcno3) 142 151 REAL, SAVE, ALLOCATABLE :: sconcoa(:) 143 152 !$OMP THREADPRIVATE(sconcoa) … … 150 159 REAL, SAVE, ALLOCATABLE :: concso4(:,:) 151 160 !$OMP THREADPRIVATE(concso4) 161 REAL, SAVE, ALLOCATABLE :: concno3(:,:) 162 !$OMP THREADPRIVATE(concno3) 152 163 REAL, SAVE, ALLOCATABLE :: concoa(:,:) 153 164 !$OMP THREADPRIVATE(concoa) … … 197 208 !$OMP THREADPRIVATE(topswcf_aerop, solswcf_aerop) 198 209 210 ! additional LW variables CK 211 REAL,ALLOCATABLE,SAVE :: toplwad_aerop(:), sollwad_aerop(:) 212 !$OMP THREADPRIVATE(toplwad_aerop, sollwad_aerop) 213 REAL,ALLOCATABLE,SAVE :: toplwai_aerop(:), sollwai_aerop(:) 214 !$OMP THREADPRIVATE(toplwai_aerop, sollwai_aerop) 215 REAL,ALLOCATABLE,SAVE :: toplwad0_aerop(:), sollwad0_aerop(:) 216 !$OMP THREADPRIVATE(toplwad0_aerop, sollwad0_aerop) 199 217 200 218 !Ajout de celles nécessaires au phys_output_write_mod … … 337 355 allocate(topswai_aero(klon), solswai_aero(klon)) 338 356 allocate(topswad0_aero(klon), solswad0_aero(klon)) 357 ! LW diagnostics CK 358 allocate(toplwad_aero(klon), sollwad_aero(klon)) 359 allocate(toplwai_aero(klon), sollwai_aero(klon)) 360 allocate(toplwad0_aero(klon), sollwad0_aero(klon)) 361 ! end 339 362 allocate(topsw_aero(klon,naero_grp), solsw_aero(klon,naero_grp)) 340 363 allocate(topsw0_aero(klon,naero_grp), solsw0_aero(klon,naero_grp)) … … 363 386 allocate(od550lt1aer(klon)) 364 387 allocate(sconcso4(klon)) 388 allocate(sconcno3(klon)) 365 389 allocate(sconcoa(klon)) 366 390 allocate(sconcbc(klon)) … … 368 392 allocate(sconcdust(klon)) 369 393 allocate(concso4(klon,klev)) 394 allocate(concno3(klon,klev)) 370 395 allocate(concoa(klon,klev)) 371 396 allocate(concbc(klon,klev)) … … 392 417 ALLOCATE(solsw_aerop(klon,naero_grp), solsw0_aerop(klon,naero_grp)) 393 418 ALLOCATE(topswcf_aerop(klon,naero_grp), solswcf_aerop(klon,naero_grp)) 419 420 ! additional LW variables CK 421 ALLOCATE(toplwad_aerop(klon), sollwad_aerop(klon)) 422 ALLOCATE(toplwai_aerop(klon), sollwai_aerop(klon)) 423 ALLOCATE(toplwad0_aerop(klon), sollwad0_aerop(klon)) 394 424 395 425 ! FH Ajout de celles nécessaires au phys_output_write_mod … … 496 526 deallocate(topswai_aero,solswai_aero) 497 527 deallocate(topswad0_aero,solswad0_aero) 528 ! LW additional CK 529 deallocate(toplwad_aero,sollwad_aero) 530 deallocate(toplwai_aero,sollwai_aero) 531 deallocate(toplwad0_aero,sollwad0_aero) 532 ! end 498 533 deallocate(topsw_aero,solsw_aero) 499 534 deallocate(topsw0_aero,solsw0_aero) … … 517 552 deallocate(od550lt1aer) 518 553 deallocate(sconcso4) 554 deallocate(sconcno3) 519 555 deallocate(sconcoa) 520 556 deallocate(sconcbc) … … 522 558 deallocate(sconcdust) 523 559 deallocate(concso4) 560 deallocate(concno3) 524 561 deallocate(concoa) 525 562 deallocate(concbc) … … 549 586 deallocate(topswcf_aerop, solswcf_aerop) 550 587 588 !CK LW diagnostics 589 deallocate(toplwad_aerop, sollwad_aerop) 590 deallocate(toplwai_aerop, sollwai_aerop) 591 deallocate(toplwad0_aerop, sollwad0_aerop) 551 592 552 593 ! FH Ajout de celles nécessaires au phys_output_write_mod -
LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90
r2136 r2146 3 3 USE phys_output_var_mod 4 4 USE indice_sol_mod 5 USE aero_mod , only : naero_tot,name_aero_tau5 USE aero_mod 6 6 7 7 … … 736 736 TYPE(ctrl_out), SAVE :: o_solswai = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), & 737 737 'solswai', 'AIE at SFR', 'W/m2', (/ ('', i=1, 9) /)) 738 739 type(ctrl_out),save,dimension(naero_tot) :: o_tausumaero = & 740 (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASBCM', & 741 "Aerosol Optical depth at 550 nm "//name_aero_tau(1),"1", (/ ('', i=1, 9) /)), & 742 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASPOMM', & 743 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"1", (/ ('', i=1, 9) /)), & 744 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASSO4M', & 745 "Aerosol Optical depth at 550 nm "//name_aero_tau(3),"1", (/ ('', i=1, 9) /)), & 746 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_CSSO4M', & 747 "Aerosol Optical depth at 550 nm "//name_aero_tau(4),"1", (/ ('', i=1, 9) /)), & 748 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_SSSSM', & 749 "Aerosol Optical depth at 550 nm "//name_aero_tau(5),"1", (/ ('', i=1, 9) /)), & 750 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_ASSSM', & 751 "Aerosol Optical depth at 550 nm "//name_aero_tau(6),"1", (/ ('', i=1, 9) /)), & 752 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_CSSSM', & 753 "Aerosol Optical depth at 550 nm "//name_aero_tau(7),"1", (/ ('', i=1, 9) /)), & 754 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_CIDUSTM', & 755 "Aerosol Optical depth at 550 nm "//name_aero_tau(8),"1", (/ ('', i=1, 9) /)), & 756 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_AIBCM', & 757 "Aerosol Optical depth at 550 nm "//name_aero_tau(9),"1", (/ ('', i=1, 9) /)), & 758 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_AIPOMM', & 759 "Aerosol Optical depth at 550 nm "//name_aero_tau(10),"1", (/ ('', i=1, 9) /)),& 760 ctrl_out((/ 2, 2, 10, 10, 10, 10, 11, 11, 11 /),'OD550_STRAT', & 761 "Aerosol Optical depth at 550 nm "//name_aero_tau(11),"1", (/ ('', i=1, 9) /)) /) 738 TYPE(ctrl_out), SAVE :: o_toplwad = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), & 739 'toplwad', 'LW-ADE at TOA', 'W/m2', (/ ('', i=1, 9) /)) 740 TYPE(ctrl_out), SAVE :: o_toplwad0 = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), & 741 'toplwad0', 'LW-ADE clear-sky at TOA', 'W/m2', (/ ('', i=1, 9) /)) 742 TYPE(ctrl_out), SAVE :: o_toplwai = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), & 743 'toplwai', 'LW-AIE at TOA', 'W/m2', (/ ('', i=1, 9) /)) 744 TYPE(ctrl_out), SAVE :: o_sollwad = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), & 745 'sollwad', 'LW-ADE at SRF', 'W/m2', (/ ('', i=1, 9) /)) 746 TYPE(ctrl_out), SAVE :: o_sollwad0 = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), & 747 'sollwad0', 'LW-ADE clear-sky at SRF', 'W/m2', (/ ('', i=1, 9) /)) 748 TYPE(ctrl_out), SAVE :: o_sollwai = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), & 749 'sollwai', 'LW-AIE at SFR', 'W/m2', (/ ('', i=1, 9) /)) 750 751 type(ctrl_out),save,dimension(naero_tot) :: o_tausumaero = & 752 (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(1), & 753 "Aerosol Optical depth at 550 nm "//name_aero_tau(1),"1", (/ ('', i=1, 9) /)), & 754 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(2), & 755 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"2", (/ ('', i=1, 9) /)), & 756 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(3), & 757 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"3", (/ ('', i=1, 9) /)), & 758 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(4), & 759 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"4", (/ ('', i=1, 9) /)), & 760 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(5), & 761 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"5", (/ ('', i=1, 9) /)), & 762 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(6), & 763 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"6", (/ ('', i=1, 9) /)), & 764 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(7), & 765 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"7", (/ ('', i=1, 9) /)), & 766 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(8), & 767 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"8", (/ ('', i=1, 9) /)), & 768 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(9), & 769 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"9", (/ ('', i=1, 9) /)), & 770 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(10), & 771 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"10", (/ ('', i=1, 9) /)), & 772 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(11), & 773 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"11", (/ ('', i=1, 9) /)), & 774 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(12), & 775 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"12", (/ ('', i=1, 9) /)), & 776 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(13), & 777 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"13", (/ ('', i=1, 9) /)), & 778 ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /),'OD550_'//name_aero_tau(14), & 779 "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"14", (/ ('', i=1, 9) /)) /) 780 781 782 ! 783 TYPE(ctrl_out), SAVE :: o_tausumaero_lw = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & 784 'OD_10um_STRAT', 'Stratospheric Aerosol Optical depth at 10 um ', '1', (/ ('', i=1, 9) /)) 762 785 ! 763 786 TYPE(ctrl_out), SAVE :: o_od550aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & … … 771 794 TYPE(ctrl_out), SAVE :: o_sconcso4 = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & 772 795 'sconcso4', 'Surface Concentration of Sulfate ', 'kg/m3', (/ ('', i=1, 9) /)) 796 TYPE(ctrl_out), SAVE :: o_sconcno3 = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & 797 'sconcno3', 'Surface Concentration of Nitrate ', 'kg/m3', (/ ('', i=1, 9) /)) 773 798 TYPE(ctrl_out), SAVE :: o_sconcoa = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & 774 799 'sconcoa', 'Surface Concentration of Organic Aerosol ', 'kg/m3', (/ ('', i=1, 9) /)) … … 781 806 TYPE(ctrl_out), SAVE :: o_concso4 = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & 782 807 'concso4', 'Concentration of Sulfate ', 'kg/m3', (/ ('', i=1, 9) /)) 808 TYPE(ctrl_out), SAVE :: o_concno3 = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & 809 'concno3', 'Concentration of Nitrate ', 'kg/m3', (/ ('', i=1, 9) /)) 783 810 TYPE(ctrl_out), SAVE :: o_concoa = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11 /), & 784 811 'concoa', 'Concentration of Organic Aerosol ', 'kg/m3', (/ ('', i=1, 9) /)) -
LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90
r2144 r2146 89 89 o_dtsvdfg, o_dtsvdfi, o_rugs, o_od550aer, & 90 90 o_od865aer, o_absvisaer, o_od550lt1aer, & 91 o_sconcso4, o_sconc oa, o_sconcbc, &92 o_sconcss, o_sconcdust, o_concso4, &91 o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, & 92 o_sconcss, o_sconcdust, o_concso4, o_concno3, & 93 93 o_concoa, o_concbc, o_concss, o_concdust, & 94 94 o_loadso4, o_loadoa, o_loadbc, o_loadss, & 95 o_loaddust, o_tausumaero, o_topswad, & 96 o_topswad0, o_solswad, o_solswad0, & 95 o_loaddust, o_tausumaero, o_tausumaero_lw, & 96 o_topswad, o_topswad0, o_solswad, o_solswad0, & 97 o_toplwad, o_toplwad0, o_sollwad, o_sollwad0, & 97 98 o_swtoaas_nat, o_swsrfas_nat, & 98 99 o_swtoacs_nat, o_swtoaas_ant, & … … 195 196 pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, & 196 197 qsat2m, tpote, tpot, d_ts, zxrugs, od550aer, & 197 od865aer, absvisaer, od550lt1aer, sconcso4, &198 sconcoa, sconcbc, sconcss, sconcdust, concso4, &198 od865aer, absvisaer, od550lt1aer, sconcso4, sconcno3, & 199 sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, & 199 200 concoa, concbc, concss, concdust, loadso4, & 200 201 loadoa, loadbc, loadss, loaddust, tausum_aero, & … … 203 204 topsw0_aero, solsw0_aero, topswcf_aero, & 204 205 solswcf_aero, topswai_aero, solswai_aero, & 206 toplwad_aero, toplwad0_aero, sollwad_aero, & 207 sollwad0_aero, toplwai_aero, sollwai_aero, & 205 208 scdnc, cldncl, reffclws, reffclwc, cldnvi, & 206 209 lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, & … … 228 231 USE surface_data, only: type_ocean, ok_veget, ok_snow 229 232 ! USE aero_mod, only: naero_spc 230 USE aero_mod, only: naero_tot 233 USE aero_mod, only: naero_tot, id_STRAT_phy 231 234 USE ioipsl, only: histend, histsync 232 235 USE iophy, only: set_itau_iophy, histwrite_phy … … 331 334 CALL histwrite_phy(o_t2m_min, zt2m) 332 335 CALL histwrite_phy(o_t2m_max, zt2m) 333 if (.not. ok_all_xml) then 334 CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon) 335 CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon) 336 endif 336 CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon) 337 CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon) 337 338 338 339 IF (vars_defined) THEN … … 795 796 CALL histwrite_phy(o_rugs, zxrugs) 796 797 ! OD550 per species 797 IF (new_aod .and. (.not. aerosol_couple)) THEN 798 !--OLIVIER 799 !This is warranted by treating INCA aerosols as offline aerosols 800 ! IF (new_aod .and. (.not. aerosol_couple)) THEN 801 IF (new_aod) THEN 798 802 IF (flag_aerosol.GT.0) THEN 799 803 CALL histwrite_phy(o_od550aer, od550aer) … … 802 806 CALL histwrite_phy(o_od550lt1aer, od550lt1aer) 803 807 CALL histwrite_phy(o_sconcso4, sconcso4) 808 CALL histwrite_phy(o_sconcno3, sconcno3) 804 809 CALL histwrite_phy(o_sconcoa, sconcoa) 805 810 CALL histwrite_phy(o_sconcbc, sconcbc) … … 807 812 CALL histwrite_phy(o_sconcdust, sconcdust) 808 813 CALL histwrite_phy(o_concso4, concso4) 814 CALL histwrite_phy(o_concno3, concno3) 809 815 CALL histwrite_phy(o_concoa, concoa) 810 816 CALL histwrite_phy(o_concbc, concbc) … … 826 832 END DO 827 833 ENDIF 834 IF (flag_aerosol_strat) THEN 835 CALL histwrite_phy(o_tausumaero_lw, & 836 tausum_aero(:,6,id_STRAT_phy) ) 837 ENDIF 828 838 ENDIF 829 839 IF (ok_ade) THEN … … 832 842 CALL histwrite_phy(o_solswad, solswad_aero) 833 843 CALL histwrite_phy(o_solswad0, solswad0_aero) 844 CALL histwrite_phy(o_toplwad, toplwad_aero) 845 CALL histwrite_phy(o_toplwad0, toplwad0_aero) 846 CALL histwrite_phy(o_sollwad, sollwad_aero) 847 CALL histwrite_phy(o_sollwad0, sollwad0_aero) 834 848 !====MS forcing diagnostics 835 849 if (new_aod) then -
LMDZ5/trunk/libf/phylmd/phys_state_var_mod.F90
r2003 r2146 349 349 REAL,SAVE,ALLOCATABLE :: tau_aero(:,:,:,:), piz_aero(:,:,:,:), cg_aero(:,:,:,:) 350 350 !$OMP THREADPRIVATE(tau_aero, piz_aero, cg_aero) 351 REAL,SAVE,ALLOCATABLE :: tau_aero_rrtm(:,:,:,:), piz_aero_rrtm(:,:,:,:), cg_aero_rrtm(:,:,:,:) 352 !$OMP THREADPRIVATE(tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm) 351 REAL,SAVE,ALLOCATABLE :: tau_aero_sw_rrtm(:,:,:,:), piz_aero_sw_rrtm(:,:,:,:), cg_aero_sw_rrtm(:,:,:,:) 352 !$OMP THREADPRIVATE(tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm) 353 REAL,SAVE,ALLOCATABLE :: tau_aero_lw_rrtm(:,:,:,:), piz_aero_lw_rrtm(:,:,:,:), cg_aero_lw_rrtm(:,:,:,:) 354 !$OMP THREADPRIVATE(tau_aero_lw_rrtm, piz_aero_lw_rrtm, cg_aero_lw_rrtm) 353 355 REAL,SAVE,ALLOCATABLE :: ccm(:,:,:) 354 356 !$OMP THREADPRIVATE(ccm) … … 519 521 ALLOCATE(topswai(klon), solswai(klon)) 520 522 ALLOCATE(tau_aero(klon,klev,naero_grp,nbands),piz_aero(klon,klev,naero_grp,nbands),cg_aero(klon,klev,naero_grp,nbands)) 521 ALLOCATE(tau_aero_rrtm(klon,klev,2,nbands_rrtm),piz_aero_rrtm(klon,klev,2,nbands_rrtm)) 522 ALLOCATE(cg_aero_rrtm(klon,klev,2,nbands_rrtm)) 523 ALLOCATE(tau_aero_sw_rrtm(klon,klev,2,nbands_sw_rrtm),piz_aero_sw_rrtm(klon,klev,2,nbands_sw_rrtm)) 524 ALLOCATE(cg_aero_sw_rrtm(klon,klev,2,nbands_sw_rrtm)) 525 ALLOCATE(tau_aero_lw_rrtm(klon,klev,2,nbands_lw_rrtm),piz_aero_lw_rrtm(klon,klev,2,nbands_lw_rrtm)) 526 ALLOCATE(cg_aero_lw_rrtm(klon,klev,2,nbands_lw_rrtm)) 523 527 ALLOCATE(ccm(klon,klev,nbands)) 524 528 … … 635 639 deallocate(topswai, solswai) 636 640 deallocate(tau_aero,piz_aero,cg_aero) 637 deallocate(tau_aero_rrtm,piz_aero_rrtm,cg_aero_rrtm) 641 deallocate(tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm) 642 deallocate(tau_aero_lw_rrtm,piz_aero_lw_rrtm,cg_aero_lw_rrtm) 638 643 deallocate(ccm) 639 644 if (ok_gwd_rando) deallocate(du_gwd_rando, dv_gwd_rando) -
LMDZ5/trunk/libf/phylmd/physiq.F90
r2137 r2146 2761 2761 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 2762 2762 IF (flag_aerosol .gt. 0) THEN 2763 IF ( .NOT. aerosol_couple) THEN2764 IF ( iflag_rrtm .EQ. 0) THEN !--old radiation2763 IF (iflag_rrtm .EQ. 0) THEN !--old radiation 2764 IF (.NOT. aerosol_couple) THEN 2765 2765 ! 2766 2766 CALL readaerosol_optic( & … … 2770 2770 tau_aero, piz_aero, cg_aero, & 2771 2771 tausum_aero, tau3d_aero) 2772 ! 2773 ELSE ! RRTM radiation 2774 ! 2772 ENDIF 2773 ELSE ! RRTM radiation 2774 IF (aerosol_couple .AND. config_inca == 'aero' ) THEN 2775 abort_message='config_inca=aero et rrtm=1 impossible' 2776 call abort_gcm(modname,abort_message,1) 2777 ELSE 2778 ! 2775 2779 #ifdef CPP_RRTM 2776 CALL readaerosol_optic_rrtm(&2777 debut,new_aod, flag_aerosol, itap, jD_cur-jD_ref, &2778 2779 2780 tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm, &2781 2780 CALL readaerosol_optic_rrtm( debut, aerosol_couple, & 2781 new_aod, flag_aerosol, itap, jD_cur-jD_ref, & 2782 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 2783 tr_seri, mass_solu_aero, mass_solu_aero_pi, & 2784 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & 2785 tausum_aero, tau3d_aero) 2782 2786 #else 2783 2787 2784 abort_message = 'You should compile with -rrtm if running ' & 2785 // 'with iflag_rrtm=1' 2788 abort_message='You should compile with -rrtm if running with iflag_rrtm=1' 2786 2789 call abort_gcm(modname,abort_message,1) 2787 2790 #endif … … 2796 2799 cg_aero(:,:,:,:) = 0. 2797 2800 ELSE 2798 tau_aero_ rrtm(:,:,:,:)=0.02799 piz_aero_ rrtm(:,:,:,:)=0.02800 cg_aero_ rrtm(:,:,:,:)=0.02801 tau_aero_sw_rrtm(:,:,:,:)=0.0 2802 piz_aero_sw_rrtm(:,:,:,:)=0.0 2803 cg_aero_sw_rrtm(:,:,:,:)=0.0 2801 2804 ENDIF 2802 2805 ENDIF … … 2980 2983 2981 2984 call chemtime(itap+itau_phy-1, date0, dtime) 2982 IF (config_inca == 'aero' ) THEN2985 IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN 2983 2986 CALL AEROSOL_METEO_CALC( & 2984 2987 calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, & … … 3192 3195 flag_aerosol_strat, & 3193 3196 tau_aero, piz_aero, cg_aero, & 3194 tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,& ! Rajoute par OB pour RRTM 3197 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! Rajoute par OB pour RRTM 3198 tau_aero_lw_rrtm, & 3195 3199 cldtaupirad,new_aod, & 3196 3200 zqsat, flwc, fiwc, & … … 3208 3212 solsw_aero, solsw0_aero, & 3209 3213 topswcf_aero, solswcf_aero, & 3214 !-C. Kleinschmitt for LW diagnostics 3215 toplwad_aero, sollwad_aero,& 3216 toplwai_aero, sollwai_aero, & 3217 toplwad0_aero, sollwad0_aero,& 3218 !-end 3210 3219 ZLWFT0_i, ZFLDN0, ZFLUP0, & 3211 3220 ZSWFT0_i, ZFSDN0, ZFSUP0) … … 3239 3248 flag_aerosol_strat, & 3240 3249 tau_aero, piz_aero, cg_aero, & 3241 tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,& ! Rajoute par OB pour RRTM 3250 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! Rajoute par OB pour RRTM 3251 tau_aero_lw_rrtm, & 3242 3252 cldtaupi,new_aod, & 3243 3253 zqsat, flwc, fiwc, & … … 3255 3265 solsw_aerop, solsw0_aerop, & 3256 3266 topswcf_aerop, solswcf_aerop, & 3267 !-C. Kleinschmitt for LW diagnostics 3268 toplwad_aerop, sollwad_aerop,& 3269 toplwai_aerop, sollwai_aerop, & 3270 toplwad0_aerop, sollwad0_aerop,& 3271 !-end 3257 3272 ZLWFT0_i, ZFLDN0, ZFLUP0, & 3258 3273 ZSWFT0_i, ZFSDN0, ZFSUP0) -
LMDZ5/trunk/libf/phylmd/phytrac_mod.F90
r2007 r2146 54 54 CONTAINS 55 55 56 SUBROUTINE phytrac( & 57 nstep, julien, gmtime, debutphy, & 58 lafin, pdtphys, u, v, t_seri, & 59 paprs, pplay, pmfu, pmfd, & 60 pen_u, pde_u, pen_d, pde_d, & 61 cdragh, coefh, fm_therm, entr_therm, & 62 yu1, yv1, ftsol, pctsrf, & 63 ustar, u10m, v10m, & 64 wstar, ale_bl, ale_wake, & 65 xlat, xlon, & 66 frac_impa,frac_nucl,beta_fisrt,beta_v1, & 67 presnivs, pphis, pphi, albsol, & 68 sh, rh, cldfra, rneb, & 69 diafra, cldliq, itop_con, ibas_con, & 70 pmflxr, pmflxs, prfl, psfl, & 71 da, phi, mp, upwd, & 72 phi2, d1a, dam, sij, wght_cvfd, & ! RomP +RL 73 wdtrainA, wdtrainM, sigd, clw, elij, & ! RomP 74 evap, ep, epmlmMm, eplaMm, & ! RomP 75 dnwd, aerosol_couple, flxmass_w, & 76 tau_aero, piz_aero, cg_aero, ccm, & 77 rfname, & 78 d_tr_dyn, & ! RomP 79 tr_seri) 80 ! 81 !====================================================================== 82 ! Auteur(s) FH 83 ! Objet: Moniteur general des tendances traceurs 84 ! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr 85 ! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav 86 !====================================================================== 87 88 USE ioipsl 89 USE phys_cal_mod, only : hour 90 USE dimphy 91 USE infotrac 92 USE mod_grid_phy_lmdz 93 USE mod_phys_lmdz_para 94 USE comgeomphy 95 USE iophy 96 USE traclmdz_mod 97 USE tracinca_mod 98 USE tracreprobus_mod 99 USE control_mod 100 USE indice_sol_mod 101 102 IMPLICIT NONE 103 104 INCLUDE "YOMCST.h" 105 INCLUDE "dimensions.h" 106 INCLUDE "clesphys.h" 107 INCLUDE "temps.h" 108 INCLUDE "paramet.h" 109 INCLUDE "thermcell.h" 110 INCLUDE "iniprint.h" 111 !========================================================================== 112 ! -- ARGUMENT DESCRIPTION -- 113 !========================================================================== 114 115 ! Input arguments 116 !---------------- 117 !Configuration grille,temps: 118 INTEGER,INTENT(IN) :: nstep ! Appel physique 119 INTEGER,INTENT(IN) :: julien ! Jour julien 120 REAL,INTENT(IN) :: gmtime ! Heure courante 121 REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde) 122 LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique 123 LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique 124 125 REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point 126 REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point 127 ! 128 !Physique: 129 !-------- 130 REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature 131 REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used 132 REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used 133 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique 134 REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative 135 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa) 136 REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa) 137 REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel 138 REAL,DIMENSION(klon),INTENT(IN) :: pphis 139 REAL,DIMENSION(klev),INTENT(IN) :: presnivs 140 REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse 141 REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages) 142 REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels) 143 REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle) 144 ! 145 REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb 146 REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp) 147 REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version) 148 149 ! 150 INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con 151 INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con 152 REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface 153 ! 154 !Dynamique 155 !-------- 156 REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn 157 ! 158 !Convection: 159 !---------- 160 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant 161 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant 162 REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant 163 REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant 164 REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant 165 REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant 166 167 !...Tiedke 168 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection] 169 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale] 170 171 LOGICAL,INTENT(IN) :: aerosol_couple 172 REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w 173 REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: tau_aero 174 REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: piz_aero 175 REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: cg_aero 176 CHARACTER(len=4),DIMENSION(9),INTENT(IN) :: rfname 177 REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm 178 !... K.Emanuel 179 REAL,DIMENSION(klon,klev),INTENT(IN) :: da 180 REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi 181 ! RomP >>> 182 REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam 183 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2 184 ! 185 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA 186 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM 187 REAL,DIMENSION(klon),INTENT(IN) :: sigd 188 ! ---- RomP flux entraine, detraine et precipitant kerry Emanuel 189 REAL,DIMENSION(klon,klev),INTENT(IN) :: evap 190 REAL,DIMENSION(klon,klev),INTENT(IN) :: ep 191 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij 192 REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL 193 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij 194 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm 195 REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm 196 REAL,DIMENSION(klon,klev),INTENT(IN) :: clw 197 ! RomP <<< 198 199 ! 200 REAL,DIMENSION(klon,klev),INTENT(IN) :: mp 201 REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux 202 REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux 203 ! 204 !Thermiques: 205 !---------- 206 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm 207 REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm 208 ! 209 !Couche limite: 210 !-------------- 211 ! 212 ! 213 REAL,DIMENSION(:),INTENT(IN) :: cdragh ! (klon) coeff drag pour T et Q 214 REAL,DIMENSION(:,:),INTENT(IN) :: coefh ! (klon,klev) coeff melange CL (m**2/s) 215 REAL,DIMENSION(:),INTENT(IN) :: ustar,u10m,v10m ! (klon) u* & vent a 10m (m/s) 216 REAL,DIMENSION(:),INTENT(IN) :: wstar,ale_bl,ale_wake ! (klon) w* and Avail. Lifting Ener. 217 REAL,DIMENSION(:),INTENT(IN) :: yu1 ! (klon) vents au premier niveau 218 REAL,DIMENSION(:),INTENT(IN) :: yv1 ! (klon) vents au premier niveau 219 220 ! 221 !Lessivage: 222 !---------- 223 ! 224 ! pour le ON-LINE 225 ! 226 REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes 227 REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees 228 229 ! Arguments necessaires pour les sources et puits de traceur: 230 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin) 231 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol) 232 233 234 ! Output argument 235 !---------------- 236 REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA] 237 REAL,DIMENSION(klon,klev) :: sourceBE 238 !======================================================================================= 239 ! -- LOCAL VARIABLES -- 240 !======================================================================================= 241 242 INTEGER :: i, k, it 243 INTEGER :: nsplit 244 245 !Sources et Reservoirs de traceurs (ex:Radon): 246 !-------------------------------------------- 247 ! 248 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit 56 SUBROUTINE phytrac( & 57 nstep, julien, gmtime, debutphy, & 58 lafin, pdtphys, u, v, t_seri, & 59 paprs, pplay, pmfu, pmfd, & 60 pen_u, pde_u, pen_d, pde_d, & 61 cdragh, coefh, fm_therm, entr_therm, & 62 yu1, yv1, ftsol, pctsrf, & 63 ustar, u10m, v10m, & 64 wstar, ale_bl, ale_wake, & 65 xlat, xlon, & 66 frac_impa,frac_nucl,beta_fisrt,beta_v1, & 67 presnivs, pphis, pphi, albsol, & 68 sh, rh, cldfra, rneb, & 69 diafra, cldliq, itop_con, ibas_con, & 70 pmflxr, pmflxs, prfl, psfl, & 71 da, phi, mp, upwd, & 72 phi2, d1a, dam, sij, wght_cvfd, & ! RomP +RL 73 wdtrainA, wdtrainM, sigd, clw, elij, & ! RomP 74 evap, ep, epmlmMm, eplaMm, & ! RomP 75 dnwd, aerosol_couple, flxmass_w, & 76 tau_aero, piz_aero, cg_aero, ccm, & 77 rfname, & 78 d_tr_dyn, & ! RomP 79 tr_seri) 80 ! 81 !====================================================================== 82 ! Auteur(s) FH 83 ! Objet: Moniteur general des tendances traceurs 84 ! Modification R. Pilon 01 janvier 2012 transport+scavenging KE scheme : cvltr 85 ! Modification R. Pilon 10 octobre 2012 large scale scavenging incloud_scav + bc_scav 86 !====================================================================== 87 88 USE ioipsl 89 USE phys_cal_mod, only : hour 90 USE dimphy 91 USE infotrac 92 USE mod_grid_phy_lmdz 93 USE mod_phys_lmdz_para 94 USE comgeomphy 95 USE iophy 96 USE traclmdz_mod 97 USE tracinca_mod 98 USE tracreprobus_mod 99 USE control_mod 100 USE indice_sol_mod 101 102 USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root 103 104 IMPLICIT NONE 105 106 INCLUDE "YOMCST.h" 107 INCLUDE "dimensions.h" 108 INCLUDE "clesphys.h" 109 INCLUDE "temps.h" 110 INCLUDE "paramet.h" 111 INCLUDE "thermcell.h" 112 INCLUDE "iniprint.h" 113 !========================================================================== 114 ! -- ARGUMENT DESCRIPTION -- 115 !========================================================================== 116 117 ! Input arguments 118 !---------------- 119 !Configuration grille,temps: 120 INTEGER,INTENT(IN) :: nstep ! Appel physique 121 INTEGER,INTENT(IN) :: julien ! Jour julien 122 REAL,INTENT(IN) :: gmtime ! Heure courante 123 REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde) 124 LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique 125 LOGICAL,INTENT(IN) :: lafin ! le flag de la fin de la physique 126 127 REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point 128 REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point 129 ! 130 !Physique: 131 !-------- 132 REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature 133 REAL,DIMENSION(klon,klev),INTENT(IN) :: u ! variable not used 134 REAL,DIMENSION(klon,klev),INTENT(IN) :: v ! variable not used 135 REAL,DIMENSION(klon,klev),INTENT(IN) :: sh ! humidite specifique 136 REAL,DIMENSION(klon,klev),INTENT(IN) :: rh ! humidite relative 137 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa) 138 REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa) 139 REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel 140 REAL,DIMENSION(klon),INTENT(IN) :: pphis 141 REAL,DIMENSION(klev),INTENT(IN) :: presnivs 142 REAL,DIMENSION(klon,klev),INTENT(IN) :: cldliq ! eau liquide nuageuse 143 REAL,DIMENSION(klon,klev),INTENT(IN) :: cldfra ! fraction nuageuse (tous les nuages) 144 REAL,DIMENSION(klon,klev),INTENT(IN) :: diafra ! fraction nuageuse (convection ou stratus artificiels) 145 REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle) 146 ! 147 REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb 148 REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond (de fisrtilp) 149 REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version) 150 151 ! 152 INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con 153 INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con 154 REAL,DIMENSION(klon),INTENT(IN) :: albsol ! albedo surface 155 ! 156 !Dynamique 157 !-------- 158 REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn 159 ! 160 !Convection: 161 !---------- 162 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant 163 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfd ! flux de masse dans le panache descendant 164 REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_u ! flux entraine dans le panache montant 165 REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_u ! flux detraine dans le panache montant 166 REAL,DIMENSION(klon,klev),INTENT(IN) :: pen_d ! flux entraine dans le panache descendant 167 REAL,DIMENSION(klon,klev),INTENT(IN) :: pde_d ! flux detraine dans le panache descendant 168 169 !...Tiedke 170 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: pmflxr, pmflxs ! Flux precipitant de pluie, neige aux interfaces [convection] 171 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: prfl, psfl ! Flux precipitant de pluie, neige aux interfaces [large-scale] 172 173 LOGICAL,INTENT(IN) :: aerosol_couple 174 REAL,DIMENSION(klon,klev),INTENT(IN) :: flxmass_w 175 REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: tau_aero 176 REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: piz_aero 177 REAL,DIMENSION(klon,klev,9,2),INTENT(IN) :: cg_aero 178 CHARACTER(len=4),DIMENSION(9),INTENT(IN) :: rfname 179 REAL,DIMENSION(klon,klev,2),INTENT(IN) :: ccm 180 !... K.Emanuel 181 REAL,DIMENSION(klon,klev),INTENT(IN) :: da 182 REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi 183 ! RomP >>> 184 REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam 185 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2 186 ! 187 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA 188 REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM 189 REAL,DIMENSION(klon),INTENT(IN) :: sigd 190 ! ---- RomP flux entraine, detraine et precipitant kerry Emanuel 191 REAL,DIMENSION(klon,klev),INTENT(IN) :: evap 192 REAL,DIMENSION(klon,klev),INTENT(IN) :: ep 193 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij 194 REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL 195 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij 196 REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm 197 REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm 198 REAL,DIMENSION(klon,klev),INTENT(IN) :: clw 199 ! RomP <<< 200 201 ! 202 REAL,DIMENSION(klon,klev),INTENT(IN) :: mp 203 REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated updraft mass flux 204 REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated downdraft mass flux 205 ! 206 !Thermiques: 207 !---------- 208 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm 209 REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm 210 ! 211 !Couche limite: 212 !-------------- 213 ! 214 ! 215 REAL,DIMENSION(:),INTENT(IN) :: cdragh ! (klon) coeff drag pour T et Q 216 REAL,DIMENSION(:,:),INTENT(IN) :: coefh ! (klon,klev) coeff melange CL (m**2/s) 217 REAL,DIMENSION(:),INTENT(IN) :: ustar,u10m,v10m ! (klon) u* & vent a 10m (m/s) 218 REAL,DIMENSION(:),INTENT(IN) :: wstar,ale_bl,ale_wake ! (klon) w* and Avail. Lifting Ener. 219 REAL,DIMENSION(:),INTENT(IN) :: yu1 ! (klon) vents au premier niveau 220 REAL,DIMENSION(:),INTENT(IN) :: yv1 ! (klon) vents au premier niveau 221 222 ! 223 !Lessivage: 224 !---------- 225 ! 226 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrAA 227 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ccntrENV 228 REAL, DIMENSION(:), ALLOCATABLE, SAVE :: coefcoli 229 LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: flag_cvltr 230 !$OMP THREADPRIVATE(ccntrAA,ccntrENV,coefcoli,flag_cvltr) 231 REAL, DIMENSION(klon,klev) :: ccntrAA_3d 232 REAL, DIMENSION(klon,klev) :: ccntrENV_3d 233 REAL, DIMENSION(klon,klev) :: coefcoli_3d 234 ! 235 ! pour le ON-LINE 236 ! 237 REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_impa ! fraction d'aerosols non impactes 238 REAL,DIMENSION(klon,klev),INTENT(IN) :: frac_nucl ! fraction d'aerosols non nuclees 239 240 ! Arguments necessaires pour les sources et puits de traceur: 241 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: ftsol ! Temperature du sol (surf)(Kelvin) 242 REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol) 243 244 245 ! Output argument 246 !---------------- 247 REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA] 248 REAL,DIMENSION(klon,klev) :: sourceBE 249 !======================================================================================= 250 ! -- LOCAL VARIABLES -- 251 !======================================================================================= 252 253 INTEGER :: i, k, it 254 INTEGER :: nsplit 255 256 !Sources et Reservoirs de traceurs (ex:Radon): 257 !-------------------------------------------- 258 ! 259 REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: source ! a voir lorsque le flux de surface est prescrit 249 260 !$OMP THREADPRIVATE(source) 250 261 251 !252 !Entrees/Sorties: (cf ini_histrac.h et write_histrac.h)253 !---------------254 INTEGER :: iiq, ierr255 INTEGER :: nhori, nvert256 REAL :: zsto, zout, zjulian257 INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc262 ! 263 !Entrees/Sorties: (cf ini_histrac.h et write_histrac.h) 264 !--------------- 265 INTEGER :: iiq, ierr 266 INTEGER :: nhori, nvert 267 REAL :: zsto, zout, zjulian 268 INTEGER,SAVE :: nid_tra ! pointe vers le fichier histrac.nc 258 269 !$OMP THREADPRIVATE(nid_tra) 259 REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique260 INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy261 LOGICAL,PARAMETER :: ok_sync=.TRUE.262 263 !264 ! Nature du traceur265 !------------------266 LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage270 REAL,DIMENSION(klon) :: zx_tmp_fi2d ! variable temporaire grille physique 271 INTEGER :: itau_w ! pas de temps ecriture = nstep + itau_phy 272 LOGICAL,PARAMETER :: ok_sync=.TRUE. 273 274 ! 275 ! Nature du traceur 276 !------------------ 277 LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: aerosol ! aerosol(it) = true => aerosol => lessivage 267 278 !$OMP THREADPRIVATE(aerosol) ! aerosol(it) = false => gaz 268 REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa)269 !270 ! Tendances de traceurs (Td) et flux de traceurs:271 !------------------------272 REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere273 REAL,DIMENSION(klon,klev) :: Mint274 REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a275 REAL,DIMENSION(klon,klev,nbtr) :: zmfdam276 REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2277 ! Physique278 !----------279 REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche280 REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique Kg/m2281 REAL,DIMENSION(klon,klev) :: ztra_th282 !PhH283 REAL,DIMENSION(klon,klev) :: zrho284 REAL,DIMENSION(klon,klev) :: zdz285 REAL :: evaplsc,dx,beta ! variable pour lessivage Genthon286 REAL,DIMENSION(klon) :: his_dh ! ---287 ! in-cloud scav variables288 REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content289 290 !Controles:291 !---------292 INTEGER,SAVE :: iflag_vdf_trac,iflag_con_trac,iflag_the_trac293 INTEGER,SAVE :: iflag_con_trac_omp, iflag_vdf_trac_omp,iflag_the_trac_omp279 REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa) 280 ! 281 ! Tendances de traceurs (Td) et flux de traceurs: 282 !------------------------ 283 REAL,DIMENSION(klon,klev) :: d_tr ! Td dans l'atmosphere 284 REAL,DIMENSION(klon,klev) :: Mint 285 REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a 286 REAL,DIMENSION(klon,klev,nbtr) :: zmfdam 287 REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2 288 ! Physique 289 !---------- 290 REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche 291 REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique Kg/m2 292 REAL,DIMENSION(klon,klev) :: ztra_th 293 !PhH 294 REAL,DIMENSION(klon,klev) :: zrho 295 REAL,DIMENSION(klon,klev) :: zdz 296 REAL :: evaplsc,dx,beta ! variable pour lessivage Genthon 297 REAL,DIMENSION(klon) :: his_dh ! --- 298 ! in-cloud scav variables 299 REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content 300 301 !Controles: 302 !--------- 303 INTEGER,SAVE :: iflag_vdf_trac,iflag_con_trac,iflag_the_trac 304 INTEGER,SAVE :: iflag_con_trac_omp, iflag_vdf_trac_omp,iflag_the_trac_omp 294 305 !$OMP THREADPRIVATE(iflag_vdf_trac,iflag_con_trac,iflag_the_trac) 295 306 296 LOGICAL,SAVE :: lessivage307 LOGICAL,SAVE :: lessivage 297 308 !$OMP THREADPRIVATE(lessivage) 298 309 299 CHARACTER(len=8),DIMENSION(nbtr) :: solsym300 !RomP >>>301 INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav302 LOGICAL,SAVE :: convscav_omp,convscav310 CHARACTER(len=8),DIMENSION(nbtr) :: solsym 311 !RomP >>> 312 INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav 313 LOGICAL,SAVE :: convscav_omp,convscav 303 314 !$OMP THREADPRIVATE(iflag_lscav) 304 315 !$OMP THREADPRIVATE(convscav) 305 !RomP <<< 306 !###################################################################### 307 ! -- INITIALIZATION -- 308 !###################################################################### 309 IF (debutphy) THEN 310 ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr)) 311 ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr)) 312 ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr)) 313 ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr)) 314 ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr)) 315 ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr)) 316 ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr)) 317 ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr)) 318 ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr)) 319 ALLOCATE(d_tr_th(klon,klev,nbtr)) 320 ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr)) 321 ENDIF 322 323 DO k=1,klev 324 DO i=1,klon 325 sourceBE(i,k)=0. 326 Mint(i,k)=0. 327 zrho(i,k)=0. 328 zdz(i,k)=0. 329 END DO 330 END DO 331 332 DO it=1, nbtr 333 DO k=1,klev 334 DO i=1,klon 335 d_tr_insc(i,k,it)=0. 336 d_tr_bcscav(i,k,it)=0. 337 d_tr_evapls(i,k,it)=0. 338 d_tr_ls(i,k,it)=0. 339 d_tr_cv(i,k,it)=0. 340 d_tr_cl(i,k,it)=0. 341 d_tr_trsp(i,k,it)=0. 342 d_tr_sscav(i,k,it)=0. 343 d_tr_sat(i,k,it)=0. 344 d_tr_uscav(i,k,it)=0. 345 d_tr_lessi_impa(i,k,it)=0. 346 d_tr_lessi_nucl(i,k,it)=0. 347 qDi(i,k,it)=0. 348 qPr(i,k,it)=0. 349 qPa(i,k,it)=0. 350 qMel(i,k,it)=0. 351 qTrdi(i,k,it)=0. 352 dtrcvMA(i,k,it)=0. 353 zmfd1a(i,k,it)=0. 354 zmfdam(i,k,it)=0. 355 zmfphi2(i,k,it)=0. 316 !RomP <<< 317 !###################################################################### 318 ! -- INITIALIZATION -- 319 !###################################################################### 320 IF (debutphy) THEN 321 ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr)) 322 ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr),d_tr_cv(klon,klev,nbtr)) 323 ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr)) 324 ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr)) 325 ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr)) 326 ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr)) 327 ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr),qDi(klon,klev,nbtr)) 328 ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr)) 329 ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr)) 330 ALLOCATE(d_tr_th(klon,klev,nbtr)) 331 ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr),d_tr_lessi_nucl(klon,klev,nbtr)) 332 ENDIF 333 334 DO k=1,klev 335 DO i=1,klon 336 sourceBE(i,k)=0. 337 Mint(i,k)=0. 338 zrho(i,k)=0. 339 zdz(i,k)=0. 340 END DO 356 341 END DO 357 END DO 358 END DO 359 IF (debutphy) THEN 360 !!jyg 342 343 DO it=1, nbtr 344 DO k=1,klev 345 DO i=1,klon 346 d_tr_insc(i,k,it)=0. 347 d_tr_bcscav(i,k,it)=0. 348 d_tr_evapls(i,k,it)=0. 349 d_tr_ls(i,k,it)=0. 350 d_tr_cv(i,k,it)=0. 351 d_tr_cl(i,k,it)=0. 352 d_tr_trsp(i,k,it)=0. 353 d_tr_sscav(i,k,it)=0. 354 d_tr_sat(i,k,it)=0. 355 d_tr_uscav(i,k,it)=0. 356 d_tr_lessi_impa(i,k,it)=0. 357 d_tr_lessi_nucl(i,k,it)=0. 358 qDi(i,k,it)=0. 359 qPr(i,k,it)=0. 360 qPa(i,k,it)=0. 361 qMel(i,k,it)=0. 362 qTrdi(i,k,it)=0. 363 dtrcvMA(i,k,it)=0. 364 zmfd1a(i,k,it)=0. 365 zmfdam(i,k,it)=0. 366 zmfphi2(i,k,it)=0. 367 END DO 368 END DO 369 END DO 370 371 DO k = 1, klev 372 DO i = 1, klon 373 delp(i,k) = paprs(i,k)-paprs(i,k+1) 374 END DO 375 END DO 376 377 IF (debutphy) THEN 378 !!jyg 361 379 !$OMP BARRIER 362 ecrit_tra=86400. ! frequence de stokage en dur363 364 !RomP >>>365 !366 !Config Key = convscav367 !Config Desc = Convective scavenging switch: 0=off, 1=on.368 !Config Def = .false.369 !Config Help =370 !380 ecrit_tra=86400. ! frequence de stokage en dur 381 ! obsolete car remplace par des ecritures dans phys_output_write 382 !RomP >>> 383 ! 384 !Config Key = convscav 385 !Config Desc = Convective scavenging switch: 0=off, 1=on. 386 !Config Def = .false. 387 !Config Help = 388 ! 371 389 !$OMP MASTER 372 convscav_omp=.false.373 call getin('convscav', convscav_omp)374 iflag_vdf_trac_omp=1375 call getin('iflag_vdf_trac', iflag_vdf_trac_omp)376 iflag_con_trac_omp=1377 call getin('iflag_con_trac', iflag_con_trac_omp)378 iflag_the_trac_omp=1379 call getin('iflag_the_trac', iflag_the_trac_omp)390 convscav_omp=.false. 391 call getin('convscav', convscav_omp) 392 iflag_vdf_trac_omp=1 393 call getin('iflag_vdf_trac', iflag_vdf_trac_omp) 394 iflag_con_trac_omp=1 395 call getin('iflag_con_trac', iflag_con_trac_omp) 396 iflag_the_trac_omp=1 397 call getin('iflag_the_trac', iflag_the_trac_omp) 380 398 !$OMP END MASTER 381 399 !$OMP BARRIER 382 convscav=convscav_omp383 iflag_vdf_trac=iflag_vdf_trac_omp384 iflag_con_trac=iflag_con_trac_omp385 iflag_the_trac=iflag_the_trac_omp386 print*,'phytrac passage dans routine conv avec lessivage', convscav387 !388 !Config Key = iflag_lscav389 !Config Desc = Large scale scavenging parametrization: 0=none, 1=old(Genthon92),390 ! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon.391 !Config Def = 1392 !Config Help =393 !400 convscav=convscav_omp 401 iflag_vdf_trac=iflag_vdf_trac_omp 402 iflag_con_trac=iflag_con_trac_omp 403 iflag_the_trac=iflag_the_trac_omp 404 write(lunout,*) 'phytrac passage dans routine conv avec lessivage', convscav 405 ! 406 !Config Key = iflag_lscav 407 !Config Desc = Large scale scavenging parametrization: 0=none, 1=old(Genthon92), 408 ! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon. 409 !Config Def = 1 410 !Config Help = 411 ! 394 412 !$OMP MASTER 395 iflag_lscav_omp=1396 call getin('iflag_lscav', iflag_lscav_omp)413 iflag_lscav_omp=1 414 call getin('iflag_lscav', iflag_lscav_omp) 397 415 !$OMP END MASTER 398 416 !$OMP BARRIER 399 iflag_lscav=iflag_lscav_omp 417 iflag_lscav=iflag_lscav_omp 418 ! 419 SELECT CASE(iflag_lscav) 420 CASE(0) 421 WRITE(lunout,*) 'Large scale scavenging: none' 422 CASE(1) 423 WRITE(lunout,*) 'Large scale scavenging: C. Genthon, Tellus(1992), 44B, 371-389' 424 CASE(2) 425 WRITE(lunout,*) 'Large scale scavenging: C. Genthon, modified P. Heinrich' 426 CASE(3) 427 WRITE(lunout,*) 'Large scale scavenging: M. Shekkar Reddy and O. Boucher, JGR(2004), 109, D14202' 428 CASE(4) 429 WRITE(lunout,*) 'Large scale scavenging: Reddy and Boucher, modified R. Pilon' 430 END SELECT 431 !RomP <<< 432 WRITE(*,*) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra 433 ALLOCATE( source(klon,nbtr), stat=ierr) 434 IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 1',1) 435 436 ALLOCATE( aerosol(nbtr), stat=ierr) 437 IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1) 438 439 440 ! Initialize module for specific tracers 441 SELECT CASE(type_trac) 442 CASE('lmdz') 443 CALL traclmdz_init(pctsrf,xlat,xlon,ftsol,tr_seri,t_seri,pplay,sh,pdtphys,aerosol,lessivage) 444 CASE('inca') 445 source(:,:)=0. 446 CALL tracinca_init(aerosol,lessivage) 447 CASE('repr') 448 source(:,:)=0. 449 END SELECT 450 451 ! 452 !--initialising coefficients for scavenging in the case of NP 453 ! 454 ALLOCATE(flag_cvltr(nbtr)) 455 IF (iflag_con.EQ.3) THEN 456 ! 457 ALLOCATE(ccntrAA(nbtr)) 458 ALLOCATE(ccntrENV(nbtr)) 459 ALLOCATE(coefcoli(nbtr)) 460 ! 461 DO it=1, nbtr 462 SELECT CASE(type_trac) 463 CASE('lmdz') 464 IF (convscav.and.aerosol(it)) THEN 465 flag_cvltr(it)=.true. 466 ccntrAA(it) =1.0 !--a modifier par JYG a lire depuis fichier 467 ccntrENV(it)=1.0 468 coefcoli(it)=0.001 469 ELSE 470 flag_cvltr(it)=.false. 471 ENDIF 472 473 CASE('inca') 474 ! IF ((it.EQ.id_Rn222) .OR. ((it.GE.id_SO2) .AND. (it.LE.id_NH3)) ) THEN 475 ! !--gas-phase species 476 ! flag_cvltr(it)=.false. 400 477 ! 401 SELECT CASE(iflag_lscav) 402 CASE(0) 403 PRINT*, 'Large scale scavenging: none' 404 CASE(1) 405 PRINT*, 'Large scale scavenging: C. Genthon, Tellus(1992), 44B, 371-389' 406 CASE(2) 407 PRINT*, 'Large scale scavenging: C. Genthon, modified P. Heinrich' 408 CASE(3) 409 PRINT*, 'Large scale scavenging: M. Shekkar Reddy and O. Boucher, JGR(2004), 109, D14202' 410 CASE(4) 411 PRINT*, 'Large scale scavenging: Reddy and Boucher, modified R. Pilon' 412 END SELECT 413 !RomP <<< 414 WRITE(*,*) 'FIRST TIME IN PHYTRAC : pdtphys(sec) = ',pdtphys,'ecrit_tra (sec) = ',ecrit_tra 415 ALLOCATE( source(klon,nbtr), stat=ierr) 416 IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 1',1) 417 418 ALLOCATE( aerosol(nbtr), stat=ierr) 419 IF (ierr /= 0) CALL abort_gcm('phytrac', 'pb in allocation 2',1) 420 421 422 ! Initialize module for specific tracers 423 SELECT CASE(type_trac) 424 CASE('lmdz') 425 CALL traclmdz_init(pctsrf, xlat, xlon, ftsol, tr_seri, t_seri, pplay, sh, pdtphys, aerosol, lessivage) 426 CASE('inca') 427 source(:,:)=0. 428 CALL tracinca_init(aerosol,lessivage) 429 CASE('repr') 430 source(:,:)=0. 431 END SELECT 432 ! 433 ! Initialize diagnostic output 434 ! ---------------------------- 478 ! ELSEIF ( (it.GE.id_CIDUSTM) .AND. (it.LE.id_AIN) ) THEN 479 ! !--insoluble aerosol species 480 ! flag_cvltr(it)=.true. 481 ! ccntrAA(it)=0.7 482 ! ccntrENV(it)=0.7 483 ! coefcoli(it)=0.001 484 ! ELSEIF ( (it.EQ.id_Pb210) .OR. ((it.GE.id_CSSSM) .AND. (it.LE.id_SSN))) THEN 485 ! !--soluble aerosol species 486 ! flag_cvltr(it)=.true. 487 ! ccntrAA(it)=0.9 488 ! ccntrENV(it)=0.9 489 ! coefcoli(it)=0.001 490 ! ELSE 491 ! WRITE(lunout,*) 'pb it=', it 492 ! CALL abort_gcm('phytrac','pb it scavenging',1) 493 ! ENDIF 494 !--test OB 495 !--for now we do not scavenge in cvltr 496 flag_cvltr(it)=.false. 497 END SELECT 498 ENDDO 499 ! 500 ELSE ! iflag_con .ne. 3 501 flag_cvltr(:) = .false. 502 ENDIF 503 ! 504 ! Initialize diagnostic output 505 ! ---------------------------- 435 506 #ifdef CPP_IOIPSL 436 ! INCLUDE "ini_histrac.h"507 ! INCLUDE "ini_histrac.h" 437 508 #endif 438 END IF ! of IF (debutphy) 439 !############################################ END INITIALIZATION ####### 440 441 DO k=1,klev 442 DO i=1,klon 443 zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg 444 END DO 445 END DO 446 ! 447 IF (id_be .GT. 0) THEN 448 DO k=1,klev 449 DO i=1,klon 450 sourceBE(i,k)=srcbe(i,k) !RomP -> pour sortie histrac 451 END DO 452 END DO 453 ENDIF 454 455 !=============================================================================== 456 ! -- Do specific treatment according to chemestry model or local LMDZ tracers 457 ! 458 !=============================================================================== 459 SELECT CASE(type_trac) 460 CASE('lmdz') 461 ! -- Traitement des traceurs avec traclmdz 462 CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, & 463 cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,iflag_vdf_trac>=0,sh, & 464 rh, pphi, ustar, wstar, ale_bl, ale_wake, u10m, v10m, & 465 tr_seri, source, solsym, d_tr_cl,d_tr_dec, zmasse) !RomP 466 467 CASE('inca') 468 ! -- CHIMIE INCA config_inca = aero or chem -- 469 470 CALL tracinca(& 471 nstep, julien, gmtime, lafin, & 472 pdtphys, t_seri, paprs, pplay, & 473 pmfu, ftsol, pctsrf, pphis, & 474 pphi, albsol, sh, rh, & 475 cldfra, rneb, diafra, cldliq, & 476 itop_con, ibas_con, pmflxr, pmflxs, & 477 prfl, psfl, aerosol_couple, flxmass_w, & 478 tau_aero, piz_aero, cg_aero, ccm, & 479 rfname, & 480 tr_seri, source, solsym) 481 482 CASE('repr') 483 ! -- CHIMIE REPROBUS -- 484 485 CALL tracreprobus(pdtphys, gmtime, debutphy, julien, & 486 presnivs, xlat, xlon, pphis, pphi, & 487 t_seri, pplay, paprs, sh , & 488 tr_seri, solsym) 489 490 END SELECT 491 !====================================================================== 492 ! -- Calcul de l'effet de la convection -- 493 !====================================================================== 494 495 IF (iflag_con_trac==1) THEN 496 DO it=1, nbtr 497 IF ( conv_flg(it) == 0 ) CYCLE 498 IF (iflag_con.LT.2) THEN 499 d_tr_cv(:,:,it)=0. 500 ELSE IF (iflag_con.EQ.2) THEN 501 !..Tiedke 502 CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & 503 pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it)) 504 ! RomP >>> 505 ELSE 506 !..K.Emanuel !RomP modif arg 507 if (convscav.and.aerosol(it)) then ! lessivage convectif pour aerosol 508 ! 509 CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep, & 510 !! sigd,sij,clw,elij,epmlmMm,eplaMm, & !RL 511 sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, & !RL 512 pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, & 513 paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, & 514 d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,& 515 qPa,qMel,qTrdi,dtrcvMA,Mint, & 516 zmfd1a,zmfphi2,zmfdam) 517 else !pas de lessivage convectif ou n'est pas un aerosol 518 !! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri,& !jyg 519 !! upwd,dnwd,d_tr_cv) !jyg 520 CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, & !jyg 521 tr_seri,upwd,dnwd,d_tr_cv) !jyg 522 endif 523 END IF 524 ! RomP <<< 525 526 DO k = 1, klev 527 DO i = 1, klon 528 tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it) 529 END DO 530 END DO 531 532 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it)) 533 534 END DO ! nbtr 535 END IF ! convection 536 537 !====================================================================== 538 ! -- Calcul de l'effet des thermiques -- 539 !====================================================================== 540 541 DO it=1,nbtr 542 DO k=1,klev 543 DO i=1,klon 544 d_tr_th(i,k,it)=0. 545 tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.) 546 tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10) 547 END DO 548 END DO 549 END DO 550 551 IF (iflag_thermals.GT.0.AND.iflag_the_trac>0) THEN 552 nsplit=10 553 DO it=1, nbtr 554 DO isplit=1,nsplit 555 556 CALL dqthermcell(klon,klev,pdtphys/nsplit, & 557 fm_therm,entr_therm,zmasse, & 558 tr_seri(1:klon,1:klev,it),d_tr,ztra_th) 559 560 DO k=1,klev 561 DO i=1,klon 562 d_tr(i,k)=pdtphys*d_tr(i,k)/nsplit 563 d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k) 564 tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k),0.) 565 END DO 566 END DO 567 END DO ! nsplit 568 END DO ! it 569 END IF ! Thermiques 570 571 !====================================================================== 572 ! -- Calcul de l'effet de la couche limite -- 573 !====================================================================== 574 575 DO k = 1, klev 576 DO i = 1, klon 577 delp(i,k) = paprs(i,k)-paprs(i,k+1) 578 END DO 579 END DO 580 581 IF (iflag_vdf_trac==1) THEN 582 DO it=1, nbtr 583 if (prt_level > 20) write(lunout,*)'trac pbl ',it,pbl_flg(it) 584 IF( pbl_flg(it) /= 0 ) THEN 585 CALL cltrac(pdtphys, coefh,t_seri, & 586 tr_seri(:,:,it), source(:,it), & 587 paprs, pplay, delp, & 588 d_tr_cl(:,:,it),d_tr_dry(:,it),flux_tr_dry(:,it)) 589 tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it) 590 END IF 591 END DO 592 ELSE IF (iflag_vdf_trac==0) THEN 593 ! Injection of source in the first model layer 509 ! 510 ! print out all tracer flags 511 ! 512 WRITE(lunout,*) 'print out all tracer flags' 513 WRITE(lunout,*) 'type_trac =', type_trac 514 WRITE(lunout,*) 'config_inca =', config_inca 515 WRITE(lunout,*) 'iflag_con_trac =', iflag_con_trac 516 WRITE(lunout,*) 'iflag_con =', iflag_con 517 WRITE(lunout,*) 'convscav =', convscav 518 WRITE(lunout,*) 'iflag_lscav =', iflag_lscav 519 WRITE(lunout,*) 'aerosol =', aerosol 520 WRITE(lunout,*) 'iflag_the_trac =', iflag_the_trac 521 WRITE(lunout,*) 'iflag_thermals =', iflag_thermals 522 WRITE(lunout,*) 'iflag_vdf_trac =', iflag_vdf_trac 523 WRITE(lunout,*) 'pbl_flg =', pbl_flg 524 WRITE(lunout,*) 'lessivage =', lessivage 525 write(lunout,*) 'flag_cvltr = ', flag_cvltr 526 527 IF (lessivage.AND.config_inca.EQ.'inca') THEN 528 CALL abort_gcm('phytrac', 'lessivage=T config_inca=inca impossible',1) 529 STOP 530 ENDIF 531 ! 532 END IF ! of IF (debutphy) 533 !############################################ END INITIALIZATION ####### 534 535 DO k=1,klev 536 DO i=1,klon 537 zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/rg 538 END DO 539 END DO 540 ! 541 IF (id_be .GT. 0) THEN 542 DO k=1,klev 543 DO i=1,klon 544 sourceBE(i,k)=srcbe(i,k) !RomP -> pour sortie histrac 545 END DO 546 END DO 547 ENDIF 548 549 !=============================================================================== 550 ! -- Do specific treatment according to chemestry model or local LMDZ tracers 551 ! 552 !=============================================================================== 553 SELECT CASE(type_trac) 554 CASE('lmdz') 555 ! -- Traitement des traceurs avec traclmdz 556 CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, & 557 cdragh, coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,iflag_vdf_trac>=0,sh, & 558 rh, pphi, ustar, wstar, ale_bl, ale_wake, u10m, v10m, & 559 tr_seri, source, solsym, d_tr_cl,d_tr_dec, zmasse) !RomP 560 561 CASE('inca') 562 ! -- CHIMIE INCA config_inca = aero or chem -- 563 564 CALL tracinca(& 565 nstep, julien, gmtime, lafin, & 566 pdtphys, t_seri, paprs, pplay, & 567 pmfu, upwd, ftsol, pctsrf, pphis, & 568 pphi, albsol, sh, rh, & 569 cldfra, rneb, diafra, cldliq, & 570 itop_con, ibas_con, pmflxr, pmflxs, & 571 prfl, psfl, aerosol_couple, flxmass_w, & 572 tau_aero, piz_aero, cg_aero, ccm, & 573 rfname, & 574 tr_seri, source, solsym) 575 576 CASE('repr') 577 ! -- CHIMIE REPROBUS -- 578 579 CALL tracreprobus(pdtphys, gmtime, debutphy, julien, & 580 presnivs, xlat, xlon, pphis, pphi, & 581 t_seri, pplay, paprs, sh , & 582 tr_seri, solsym) 583 584 END SELECT 585 !====================================================================== 586 ! -- Calcul de l'effet de la convection -- 587 !====================================================================== 588 589 IF (iflag_con_trac==1) THEN 590 591 DO it=1, nbtr 592 IF ( conv_flg(it) == 0 ) CYCLE 593 IF (iflag_con.LT.2) THEN 594 !--pas de transport convectif 595 596 d_tr_cv(:,:,it)=0. 597 ELSE IF (iflag_con.EQ.2) THEN 598 !--ancien transport convectif de Tiedtke 599 600 CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & 601 pplay, paprs, tr_seri(:,:,it), d_tr_cv(:,:,it)) 602 ELSE 603 !--nouveau transport convectif de Emanuel 604 605 IF (flag_cvltr(it)) THEN 606 !--nouveau transport convectif de Emanuel avec lessivage convectif 607 ! 608 ! 609 ccntrAA_3d(:,:) =ccntrAA(it) 610 ccntrENV_3d(:,:)=ccntrENV(it) 611 coefcoli_3d(:,:)=coefcoli(it) 612 613 !--beware this interface is a bit weird because it is called for each tracer 614 !--with the full array tr_seri even if only item it is processed 615 616 CALL cvltr_scav(pdtphys, da, phi,phi2,d1a,dam, mp,ep, & 617 sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, & 618 pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, & 619 paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, & 620 ccntrAA_3d,ccntrENV_3d,coefcoli_3d, & 621 d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr,& 622 qPa,qMel,qTrdi,dtrcvMA,Mint, & 623 zmfd1a,zmfphi2,zmfdam) 624 625 626 ELSE !---flag_cvltr(it).EQ.FALSE 627 !--nouveau transport convectif de Emanuel mais pas de lessivage convectif 628 629 !--beware this interface is a bit weird because it is called for each tracer 630 !--with the full array tr_seri even if only item it is processed 631 ! 632 CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs,pplay, & !jyg 633 tr_seri,upwd,dnwd,d_tr_cv) !jyg 634 635 ENDIF 636 637 ENDIF !--iflag 638 639 !--on ajoute les tendances 640 641 DO k = 1, klev 642 DO i = 1, klon 643 tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it) 644 END DO 645 END DO 646 647 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'convection it = '//solsym(it)) 648 649 END DO ! nbtr 650 651 END IF ! convection 652 653 !====================================================================== 654 ! -- Calcul de l'effet des thermiques -- 655 !====================================================================== 656 594 657 DO it=1,nbtr 595 d_tr_cl(:,1,it)=source(:,it)*rg/delp(:,1)*pdtphys 596 tr_seri(:,1,it)=tr_seri(:,1,it)+d_tr_cl(:,1,it) 597 ENDDO 598 d_tr_cl(:,2:klev,1:nbtr)=0. 599 ELSE IF (iflag_vdf_trac==-1) THEN 600 d_tr_cl=0. 601 ELSE 602 CALL abort_gcm('iflag_vdf_trac', 'cas non prevu',1) 603 END IF ! couche limite 604 605 606 607 !====================================================================== 608 ! Calcul de l'effet de la precipitation grande echelle 609 !====================================================================== 610 IF (lessivage) THEN 611 612 ql_incloud_ref = 10.e-4 613 ql_incloud_ref = 5.e-4 614 615 616 ! calcul du contenu en eau liquide au sein du nuage 617 ql_incl = ql_incloud_ref 618 ! choix du lessivage 619 ! 620 IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN 621 ! ******** Olivier Boucher version (3) possibly with modified ql_incl (4) 622 ! 623 DO it = 1, nbtr 624 ! incloud scavenging and removal by large scale rain ! orig : ql_incl was replaced by 0.5e-3 kg/kg 625 ! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR 626 ! Liu (2001) proposed to use 1.5e-3 kg/kg 627 628 CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt, & 658 DO k=1,klev 659 DO i=1,klon 660 d_tr_th(i,k,it)=0. 661 tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.) 662 tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10) 663 END DO 664 END DO 665 END DO 666 667 IF (iflag_thermals.GT.0.AND.iflag_the_trac>0) THEN 668 669 DO it=1, nbtr 670 671 CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm, & 672 zmasse,tr_seri(1:klon,1:klev,it), & 673 d_tr_th(1:klon,1:klev,it),ztra_th,0 ) 674 675 DO k=1,klev 676 DO i=1,klon 677 d_tr_th(i,k,it)=pdtphys*d_tr_th(i,k,it) 678 tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr_th(i,k,it),0.) 679 END DO 680 END DO 681 682 END DO ! it 683 684 END IF ! Thermiques 685 686 !====================================================================== 687 ! -- Calcul de l'effet de la couche limite -- 688 !====================================================================== 689 690 IF (iflag_vdf_trac==1) THEN 691 692 ! Injection during BL mixing 693 ! 694 DO it=1, nbtr 695 ! 696 IF( pbl_flg(it) /= 0 ) THEN 697 ! 698 CALL cltrac(pdtphys, coefh,t_seri, & 699 tr_seri(:,:,it), source(:,it), & 700 paprs, pplay, delp, & 701 d_tr_cl(:,:,it),d_tr_dry(:,it),flux_tr_dry(:,it)) 702 ! 703 tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it) 704 ! 705 END IF 706 ! 707 END DO 708 ! 709 ELSE IF (iflag_vdf_trac==0) THEN 710 ! 711 ! Injection of source in the first model layer 712 ! 713 DO it=1,nbtr 714 d_tr_cl(:,1,it)=source(:,it)*RG/delp(:,1)*pdtphys 715 tr_seri(:,1,it)=tr_seri(:,1,it)+d_tr_cl(:,1,it) 716 ENDDO 717 d_tr_cl(:,2:klev,1:nbtr)=0. 718 ! 719 ELSE IF (iflag_vdf_trac==-1) THEN 720 ! 721 ! Nothing happens 722 ! 723 d_tr_cl=0. 724 ! 725 ELSE 726 ! 727 CALL abort_gcm('iflag_vdf_trac', 'cas non prevu',1) 728 ! 729 END IF ! couche limite 730 731 !====================================================================== 732 ! Calcul de l'effet de la precipitation grande echelle 733 ! POUR INCA le lessivage est fait directement dans INCA 734 !====================================================================== 735 736 IF (lessivage) THEN 737 738 ql_incloud_ref = 10.e-4 739 ql_incloud_ref = 5.e-4 740 741 742 ! calcul du contenu en eau liquide au sein du nuage 743 ql_incl = ql_incloud_ref 744 ! choix du lessivage 745 ! 746 IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN 747 ! ******** Olivier Boucher version (3) possibly with modified ql_incl (4) 748 ! 749 DO it = 1, nbtr 750 ! incloud scavenging and removal by large scale rain ! orig : ql_incl was replaced by 0.5e-3 kg/kg 751 ! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR 752 ! Liu (2001) proposed to use 1.5e-3 kg/kg 753 754 CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl,rneb,beta_fisrt, & 629 755 beta_v1,pplay,paprs,t_seri,tr_seri,d_tr_insc, & 630 756 d_tr_bcscav,d_tr_evapls,qPrls) 631 757 632 !large scale scavenging tendency633 DO k = 1, klev634 DO i = 1, klon635 d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)+d_tr_evapls(i,k,it)636 tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it)637 ENDDO638 ENDDO639 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'lsc scav it = '//solsym(it))640 END DO !tr641 642 ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl643 ! ********* modified old version644 645 d_tr_lessi_nucl(:,:,:) = 0.646 d_tr_lessi_impa(:,:,:) = 0.647 flestottr(:,:,:) = 0.648 ! Tendance des aerosols nuclees et impactes649 DO it = 1, nbtr650 IF (aerosol(it)) THEN651 his_dh(:)=0.652 DO k = 1, klev653 DO i = 1, klon654 !PhH655 zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD656 zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG657 !658 END DO659 END DO660 661 DO k=klev-1, 1, -1662 DO i=1, klon663 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.)664 dx=d_tr_ls(i,k,it)665 his_dh(i)=his_dh(i)-dx*zrho(i,k)*zdz(i,k)/pdtphys ! kg/m2/s666 evaplsc = prfl(i,k) - prfl(i,k+1) + psfl(i,k) - psfl(i,k+1)667 ! Evaporation Partielle -> Liberation Partielle 0.5*evap668 IF ( evaplsc .LT.0..and.abs(prfl(i,k+1)+psfl(i,k+1)).gt.1.e-10) THEN669 evaplsc = (-evaplsc)/(prfl(i,k+1)+psfl(i,k+1))670 ! evaplsc est donc positif, his_dh(i) est positif671 !--------------672 d_tr_evapls(i,k,it)=0.5*evaplsc*(d_tr_lessi_nucl(i,k+1,it) &673 674 !------------- d_tr_evapls(i,k,it)=-0.5*evaplsc*(d_tr_lsc(i,k+1,it))675 beta=0.5*evaplsc676 if ((prfl(i,k)+psfl(i,k)).lt.1.e-10) THEN677 beta=1.0*evaplsc678 endif679 dx=beta*his_dh(i)/zrho(i,k)/zdz(i,k)*pdtphys680 his_dh(i)=(1.-beta)*his_dh(i) ! tracer from681 d_tr_evapls(i,k,it)=dx682 ENDIF683 d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.) &684 685 686 !--------------687 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &688 ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)689 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &690 ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)691 !692 ! Flux lessivage total693 flestottr(i,k,it) = flestottr(i,k,it) - &694 ( d_tr_lessi_nucl(i,k,it) + &695 d_tr_lessi_impa(i,k,it) ) * &696 ( paprs(i,k)-paprs(i,k+1) ) / &697 (RG * pdtphys)698 !! Mise a jour des traceurs due a l'impaction,nucleation699 ! tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k)700 !! calcul de la tendance liee au lessivage stratiforme701 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*&702 ! (1.-1./(frac_impa(i,k)*frac_nucl(i,k)))703 !--------------704 END DO705 END DO706 END IF707 END DO708 ! ********* end modified old version709 710 ELSE IF (iflag_lscav .EQ. 1) THEN ! frac_impa, frac_nucl711 ! ********* old version712 713 d_tr_lessi_nucl(:,:,:) = 0.714 d_tr_lessi_impa(:,:,:) = 0.715 flestottr(:,:,:) = 0.716 !=========================717 ! LESSIVAGE LARGE SCALE :718 !=========================719 720 ! Tendance des aerosols nuclees et impactes721 ! -----------------------------------------722 DO it = 1, nbtr723 IF (aerosol(it)) THEN724 DO k = 1, klev725 DO i = 1, klon726 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + &727 ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it)728 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + &729 ( 1 - frac_impa(i,k) )*tr_seri(i,k,it)730 731 !732 ! Flux lessivage total733 ! ------------------------------------------------------------734 flestottr(i,k,it) = flestottr(i,k,it) - &735 ( d_tr_lessi_nucl(i,k,it) + &736 d_tr_lessi_impa(i,k,it) ) * &737 ( paprs(i,k)-paprs(i,k+1) ) / &738 (RG * pdtphys)739 !740 ! Mise a jour des traceurs due a l'impaction,nucleation741 ! ----------------------------------------------------------------------742 tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k)743 END DO744 END DO745 END IF746 END DO747 748 ! ********* end old version749 ENDIF ! iflag_lscav . EQ. 1, 2, 3 or 4750 !751 END IF ! lessivage752 753 !=============================================================754 ! Ecriture des sorties755 !=============================================================758 !large scale scavenging tendency 759 DO k = 1, klev 760 DO i = 1, klon 761 d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it)+d_tr_evapls(i,k,it) 762 tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it) 763 ENDDO 764 ENDDO 765 CALL minmaxqfi(tr_seri(:,:,it),0.,1.e33,'lsc scav it = '//solsym(it)) 766 END DO !tr 767 768 ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl 769 ! ********* modified old version 770 771 d_tr_lessi_nucl(:,:,:) = 0. 772 d_tr_lessi_impa(:,:,:) = 0. 773 flestottr(:,:,:) = 0. 774 ! Tendance des aerosols nuclees et impactes 775 DO it = 1, nbtr 776 IF (aerosol(it)) THEN 777 his_dh(:)=0. 778 DO k = 1, klev 779 DO i = 1, klon 780 !PhH 781 zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD 782 zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG 783 ! 784 END DO 785 END DO 786 787 DO k=klev-1, 1, -1 788 DO i=1, klon 789 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.) 790 dx=d_tr_ls(i,k,it) 791 his_dh(i)=his_dh(i)-dx*zrho(i,k)*zdz(i,k)/pdtphys ! kg/m2/s 792 evaplsc = prfl(i,k) - prfl(i,k+1) + psfl(i,k) - psfl(i,k+1) 793 ! Evaporation Partielle -> Liberation Partielle 0.5*evap 794 IF ( evaplsc .LT.0..and.abs(prfl(i,k+1)+psfl(i,k+1)).gt.1.e-10) THEN 795 evaplsc = (-evaplsc)/(prfl(i,k+1)+psfl(i,k+1)) 796 ! evaplsc est donc positif, his_dh(i) est positif 797 !-------------- 798 d_tr_evapls(i,k,it)=0.5*evaplsc*(d_tr_lessi_nucl(i,k+1,it) & 799 +d_tr_lessi_impa(i,k+1,it)) 800 !------------- d_tr_evapls(i,k,it)=-0.5*evaplsc*(d_tr_lsc(i,k+1,it)) 801 beta=0.5*evaplsc 802 if ((prfl(i,k)+psfl(i,k)).lt.1.e-10) THEN 803 beta=1.0*evaplsc 804 endif 805 dx=beta*his_dh(i)/zrho(i,k)/zdz(i,k)*pdtphys 806 his_dh(i)=(1.-beta)*his_dh(i) ! tracer from 807 d_tr_evapls(i,k,it)=dx 808 ENDIF 809 d_tr_ls(i,k,it)=tr_seri(i,k,it)*(frac_impa(i,k)*frac_nucl(i,k)-1.) & 810 +d_tr_evapls(i,k,it) 811 812 !-------------- 813 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + & 814 ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it) 815 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + & 816 ( 1 - frac_impa(i,k) )*tr_seri(i,k,it) 817 ! 818 ! Flux lessivage total 819 flestottr(i,k,it) = flestottr(i,k,it) - & 820 ( d_tr_lessi_nucl(i,k,it) + & 821 d_tr_lessi_impa(i,k,it) ) * & 822 ( paprs(i,k)-paprs(i,k+1) ) / & 823 (RG * pdtphys) 824 !! Mise a jour des traceurs due a l'impaction,nucleation 825 ! tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k) 826 !! calcul de la tendance liee au lessivage stratiforme 827 ! d_tr_ls(i,k,it)=tr_seri(i,k,it)*& 828 ! (1.-1./(frac_impa(i,k)*frac_nucl(i,k))) 829 !-------------- 830 END DO 831 END DO 832 END IF 833 END DO 834 ! ********* end modified old version 835 836 ELSE IF (iflag_lscav .EQ. 1) THEN ! frac_impa, frac_nucl 837 ! ********* old version 838 839 d_tr_lessi_nucl(:,:,:) = 0. 840 d_tr_lessi_impa(:,:,:) = 0. 841 flestottr(:,:,:) = 0. 842 !========================= 843 ! LESSIVAGE LARGE SCALE : 844 !========================= 845 846 ! Tendance des aerosols nuclees et impactes 847 ! ----------------------------------------- 848 DO it = 1, nbtr 849 IF (aerosol(it)) THEN 850 DO k = 1, klev 851 DO i = 1, klon 852 d_tr_lessi_nucl(i,k,it) = d_tr_lessi_nucl(i,k,it) + & 853 ( 1 - frac_nucl(i,k) )*tr_seri(i,k,it) 854 d_tr_lessi_impa(i,k,it) = d_tr_lessi_impa(i,k,it) + & 855 ( 1 - frac_impa(i,k) )*tr_seri(i,k,it) 856 857 ! 858 ! Flux lessivage total 859 ! ------------------------------------------------------------ 860 flestottr(i,k,it) = flestottr(i,k,it) - & 861 ( d_tr_lessi_nucl(i,k,it) + & 862 d_tr_lessi_impa(i,k,it) ) * & 863 ( paprs(i,k)-paprs(i,k+1) ) / & 864 (RG * pdtphys) 865 ! 866 ! Mise a jour des traceurs due a l'impaction,nucleation 867 ! ---------------------------------------------------------------------- 868 tr_seri(i,k,it)=tr_seri(i,k,it)*frac_impa(i,k)*frac_nucl(i,k) 869 END DO 870 END DO 871 END IF 872 END DO 873 874 ! ********* end old version 875 ENDIF ! iflag_lscav . EQ. 1, 2, 3 or 4 876 ! 877 END IF ! lessivage 878 879 !============================================================= 880 ! Ecriture des sorties 881 !============================================================= 756 882 #ifdef CPP_IOIPSL 757 ! INCLUDE "write_histrac.h"883 ! INCLUDE "write_histrac.h" 758 884 #endif 759 885 760 END SUBROUTINE phytrac886 END SUBROUTINE phytrac 761 887 762 888 END MODULE -
LMDZ5/trunk/libf/phylmd/radlwsw_m.F90
r2043 r2146 16 16 flag_aerosol_strat,& 17 17 tau_aero, piz_aero, cg_aero,& 18 tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,& ! rajoute par OB pour RRTM 18 tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB pour RRTM 19 tau_aero_lw_rrtm, & ! rajoute par C. Kleinschmitt pour RRTM 19 20 cldtaupi, new_aod, & 20 21 qsat, flwc, fiwc, & … … 32 33 solsw_aero, solsw0_aero, & 33 34 topswcf_aero, solswcf_aero,& 35 !-C. Kleinschmitt for LW diagnostics 36 toplwad_aero, sollwad_aero,& 37 toplwai_aero, sollwai_aero, & 38 toplwad0_aero, sollwad0_aero,& 39 !-end 34 40 ZLWFT0_i, ZFLDN0, ZFLUP0,& 35 41 ZSWFT0_i, ZFSDN0, ZFSUP0) … … 51 57 ! USE YOERAD , ONLY : NSW ,LRRTM ,LCCNL ,LCCNO ,& 52 58 ! NSW mis dans .def MPL 20140211 53 USE YOERAD , ONLY : LRRTM ,LCCNL ,LCCNO ,& 59 ! NLW ajoute par OB 60 USE YOERAD , ONLY : NLW, LRRTM ,LCCNL ,LCCNO ,& 54 61 NRADIP , NRADLP , NICEOPT, NLIQOPT ,RCCNLND , RCCNSEA 55 62 USE YOELW , ONLY : NSIL ,NTRA ,NUA ,TSTAND ,XP … … 67 74 USE YOERRTWN , ONLY : DELWAVE ,TOTPLNK 68 75 USE YOMPHY3 , ONLY : RII0 76 #else 77 USE aero_mod, ONLY : nbands_lw_rrtm 69 78 #endif 70 79 … … 182 191 REAL, INTENT(in) :: cg_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F) 183 192 !--OB 184 REAL, INTENT(in) :: tau_aero_ rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM185 REAL, INTENT(in) :: piz_aero_ rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM186 REAL, INTENT(in) :: cg_aero_ rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM193 REAL, INTENT(in) :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM 194 REAL, INTENT(in) :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM 195 REAL, INTENT(in) :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW) ! aerosol optical properties RRTM 187 196 !--OB fin 197 198 !--C. Kleinschmitt 199 #ifdef CPP_RRTM 200 REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW) ! LW aerosol optical properties RRTM 201 #else 202 REAL, INTENT(in) :: tau_aero_lw_rrtm(KLON,KLEV,2,nbands_lw_rrtm) 203 #endif 204 !--C. Kleinschmitt end 205 188 206 REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations 189 207 LOGICAL, INTENT(in) :: new_aod ! flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates … … 209 227 REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface 210 228 REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface 229 REAL, INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON) ! output: LW aerosol direct forcing at TOA and surface 230 REAL, INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON) ! output: LW aerosol indirect forcing atTOA and surface 211 231 REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero 212 232 REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero 233 REAL, DIMENSION(klon), INTENT(out) :: toplwad0_aero 234 REAL, DIMENSION(klon), INTENT(out) :: sollwad0_aero 213 235 REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero 214 236 REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero … … 271 293 REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface 272 294 REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect 295 !-LW by CK 296 REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon) ! LW Aerosol direct forcing at TOAand surface 297 REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon) ! LW Aerosol direct forcing at TOAand surface 298 REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon) ! dito, indirect 299 !-end 273 300 REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9) 274 301 REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9) … … 316 343 REAL(KIND=8) PCGA_NAT(klon,klev,NSW) 317 344 REAL(KIND=8) PTAU_NAT(klon,klev,NSW) 345 #ifdef CPP_RRTM 346 REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW) 347 REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW) 348 #endif 318 349 REAL(KIND=8) PSFSWDIR(klon,NSW) 319 350 REAL(KIND=8) PSFSWDIF(klon,NSW) … … 644 675 DO kk=1, NSW 645 676 ! 646 PTAU_TOT(i,kflev+1-k,kk)=tau_aero_ rrtm(i,k,2,kk)647 PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_ rrtm(i,k,2,kk)648 PCGA_TOT(i,kflev+1-k,kk)=cg_aero_ rrtm(i,k,2,kk)649 ! 650 PTAU_NAT(i,kflev+1-k,kk)=tau_aero_ rrtm(i,k,1,kk)651 PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_ rrtm(i,k,1,kk)652 PCGA_NAT(i,kflev+1-k,kk)=cg_aero_ rrtm(i,k,1,kk)677 PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk) 678 PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk) 679 PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk) 680 ! 681 PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk) 682 PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk) 683 PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk) 653 684 ! 654 685 ENDDO … … 657 688 !-end OB 658 689 ! 690 !--C. Kleinschmitt 691 !--aerosol TOT - anthropogenic+natural 692 !--aerosol NAT - natural only 693 ! 694 DO i = 1, kdlon 695 DO k = 1, kflev 696 DO kk=1, NLW 697 ! 698 PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk) 699 PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk) 700 ! 701 ENDDO 702 ENDDO 703 ENDDO 704 !-end C. Kleinschmitt 659 705 ! 660 706 DO i = 1, kdlon … … 761 807 PPIZA_TOT, PCGA_TOT,PTAU_TOT,& 762 808 PPIZA_NAT, PCGA_NAT,PTAU_NAT, & ! rajoute par OB pour diagnostiquer effet direct 809 PTAU_LW_TOT, PTAU_LW_NAT, & ! rajoute par C. Kleinschmitt 763 810 ZFLUX_i , ZFLUC_i ,& 764 811 ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i,& … … 767 814 ZTOPSWAIAERO,ZSOLSWAIAERO, & 768 815 ZTOPSWCF_AERO,ZSOLSWCF_AERO, & 816 ZTOPLWADAERO,ZSOLLWADAERO,& ! rajoute par C. Kleinscmitt pour LW diagnostics 817 ZTOPLWAD0AERO,ZSOLLWAD0AERO,& 818 ZTOPLWAIAERO,ZSOLLWAIAERO, & 769 819 ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) ! flags aerosols 770 820 … … 813 863 ! PPIZA_NAT (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosols 814 864 ! PCGA_NAT (KPROMA,KLEV,NSW); Assymetry factor for natural aerosols 815 ! PTAU_NAT (KPROMA,KLEV,NSW); Optical depth of natiral aerosols 865 ! PTAU_NAT (KPROMA,KLEV,NSW); Optical depth of natiral aerosols 866 ! PTAU_LW_TOT (KPROMA,KLEV,NLW); LW Optical depth of total aerosols 867 ! PTAU_LW_NAT (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols 816 868 ! PSFSWDIR (KPROMA,NSW) ; 817 869 ! PSFSWDIF (KPROMA,NSW) ; … … 974 1026 solsw0_aero(iof+i,:) = zsolsw0_aero(i,:) 975 1027 topswcf_aero(iof+i,:) = ztopswcf_aero(i,:) 976 solswcf_aero(iof+i,:) = zsolswcf_aero(i,:) 1028 solswcf_aero(iof+i,:) = zsolswcf_aero(i,:) 1029 !-LW 1030 toplwad_aero(iof+i) = ztoplwadaero(i) 1031 toplwad0_aero(iof+i) = ztoplwad0aero(i) 1032 sollwad_aero(iof+i) = zsollwadaero(i) 1033 sollwad0_aero(iof+i) = zsollwad0aero(i) 977 1034 ENDDO 978 1035 ELSE … … 986 1043 solsw_aero(iof+i,:) = 0. 987 1044 solsw0_aero(iof+i,:) = 0. 1045 !-LW 1046 toplwad_aero(iof+i) = 0.0 1047 sollwad_aero(iof+i) = 0.0 1048 toplwad0_aero(iof+i) = 0.0 1049 sollwad0_aero(iof+i) = 0.0 988 1050 ENDDO 989 1051 ENDIF … … 992 1054 topswai_aero(iof+i) = ztopswaiaero(i) 993 1055 solswai_aero(iof+i) = zsolswaiaero(i) 1056 !-LW 1057 toplwai_aero(iof+i) = ztoplwaiaero(i) 1058 sollwai_aero(iof+i) = zsollwaiaero(i) 994 1059 ENDDO 995 1060 ELSE … … 997 1062 topswai_aero(iof+i) = 0.0 998 1063 solswai_aero(iof+i) = 0.0 1064 !-LW 1065 toplwai_aero(iof+i) = 0.0 1066 sollwai_aero(iof+i) = 0.0 999 1067 ENDDO 1000 1068 ENDIF -
LMDZ5/trunk/libf/phylmd/readaerosol_optic.F90
r2003 r2146 14 14 USE dimphy 15 15 USE aero_mod 16 USE phys_local_var_mod, only: sconcso4,sconc oa,sconcbc,sconcss,sconcdust, &17 concso4,conc oa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &16 USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, & 17 concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, & 18 18 load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7 19 19 IMPLICIT NONE … … 82 82 flag_aerosol .EQ. 6 ) THEN 83 83 84 CALL readaerosol_interp(id_ASSO4M , itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4)84 CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4) 85 85 ELSE 86 86 sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0. … … 93 93 94 94 ! Get bc aerosol distribution 95 CALL readaerosol_interp(id_ASBCM , itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 )96 CALL readaerosol_interp(id_AIBCM , itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 )95 CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 ) 96 CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 ) 97 97 loadbc(:)=load_tmp1(:)+load_tmp2(:) 98 98 ELSE … … 107 107 flag_aerosol .EQ. 6 ) THEN 108 108 109 CALL readaerosol_interp(id_ASPOMM , itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)110 CALL readaerosol_interp(id_AIPOMM , itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4)109 CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3) 110 CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4) 111 111 loadoa(:)=load_tmp3(:)+load_tmp4(:) 112 112 ELSE … … 121 121 flag_aerosol .EQ. 6 ) THEN 122 122 123 CALL readaerosol_interp(id_SSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5)124 CALL readaerosol_interp(id_CSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6)125 CALL readaerosol_interp(id_ASSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7)123 CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5) 124 CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6) 125 CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7) 126 126 loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:) 127 127 ELSE … … 136 136 flag_aerosol .EQ. 6 ) THEN 137 137 138 CALL readaerosol_interp(id_CIDUSTM , itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)138 CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust) 139 139 140 140 ELSE … … 146 146 ! Store all aerosols in one variable 147 147 ! 148 m_allaer(:,:,id_ASBCM ) = bcsol(:,:) ! ASBCM149 m_allaer(:,:,id_ASPOMM ) = pomsol(:,:) ! ASPOMM150 m_allaer(:,:,id_ASSO4M ) = sulfate(:,:) ! ASSO4M (= SO4)151 m_allaer(:,:,id_CSSO4M ) = 0. ! CSSO4M152 m_allaer(:,:,id_SSSSM ) = sssupco(:,:) ! SSSSM153 m_allaer(:,:,id_CSSSM ) = sscoarse(:,:) ! CSSSM154 m_allaer(:,:,id_ASSSM ) = ssacu(:,:) ! ASSSM155 m_allaer(:,:,id_CIDUSTM )= cidust(:,:) ! CIDUSTM156 m_allaer(:,:,id_AIBCM ) = bcins(:,:) ! AIBCM157 m_allaer(:,:,id_AIPOMM ) = pomins(:,:) ! AIPOMM148 m_allaer(:,:,id_ASBCM_phy) = bcsol(:,:) ! ASBCM 149 m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:) ! ASPOMM 150 m_allaer(:,:,id_ASSO4M_phy) = sulfate(:,:) ! ASSO4M (= SO4) 151 m_allaer(:,:,id_CSSO4M_phy) = 0. ! CSSO4M 152 m_allaer(:,:,id_SSSSM_phy) = sssupco(:,:) ! SSSSM 153 m_allaer(:,:,id_CSSSM_phy) = sscoarse(:,:) ! CSSSM 154 m_allaer(:,:,id_ASSSM_phy) = ssacu(:,:) ! ASSSM 155 m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:) ! CIDUSTM 156 m_allaer(:,:,id_AIBCM_phy) = bcins(:,:) ! AIBCM 157 m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:) ! AIPOMM 158 158 159 159 !RAF … … 207 207 208 208 CALL aeropt(pplay, paprs, t_seri, sulfate, rhcl, & 209 tau_aero(:,:,id_ASSO4M ,:), piz_aero(:,:,id_ASSO4M,:), cg_aero(:,:,id_ASSO4M,:), aerindex)209 tau_aero(:,:,id_ASSO4M_phy,:), piz_aero(:,:,id_ASSO4M_phy,:), cg_aero(:,:,id_ASSO4M_phy,:), aerindex) 210 210 211 211 END IF … … 213 213 214 214 ! Diagnostics calculation for CMIP5 protocol 215 sconcso4(:)=m_allaer(:,1,id_ASSO4M)*1.e-9 216 sconcoa(:)=(m_allaer(:,1,id_ASPOMM)+m_allaer(:,1,id_AIPOMM))*1.e-9 217 sconcbc(:)=(m_allaer(:,1,id_ASBCM)+m_allaer(:,1,id_AIBCM))*1.e-9 218 sconcss(:)=(m_allaer(:,1,id_ASSSM)+m_allaer(:,1,id_CSSSM)+m_allaer(:,1,id_SSSSM))*1.e-9 219 sconcdust(:)=m_allaer(:,1,id_CIDUSTM)*1.e-9 220 concso4(:,:)=m_allaer(:,:,id_ASSO4M)*1.e-9 221 concoa(:,:)=(m_allaer(:,:,id_ASPOMM)+m_allaer(:,:,id_AIPOMM))*1.e-9 222 concbc(:,:)=(m_allaer(:,:,id_ASBCM)+m_allaer(:,:,id_AIBCM))*1.e-9 223 concss(:,:)=(m_allaer(:,:,id_ASSSM)+m_allaer(:,:,id_CSSSM)+m_allaer(:,:,id_SSSSM))*1.e-9 224 concdust(:,:)=m_allaer(:,:,id_CIDUSTM)*1.e-9 215 sconcso4(:)=m_allaer(:,1,id_ASSO4M_phy)*1.e-9 216 ! sconcno3(:)=m_allaer(:,1,id_ASNO3M_phy)*1.e-9 217 sconcoa(:)=(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9 218 sconcbc(:)=(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9 219 sconcss(:)=(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9 220 sconcdust(:)=m_allaer(:,1,id_CIDUSTM_phy)*1.e-9 221 concso4(:,:)=m_allaer(:,:,id_ASSO4M_phy)*1.e-9 222 ! concno3(:,:)=m_allaer(:,:,id_ASNO3M_phy)*1.e-9 223 concoa(:,:)=(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9 224 concbc(:,:)=(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9 225 concss(:,:)=(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9 226 concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9 225 227 226 228 -
LMDZ5/trunk/libf/phylmd/readaerosolstrato.F90
r1907 r2146 142 142 ENDIF !--debut ou nouveau mois 143 143 144 !--total vertical aod at the 5wavelengths144 !--total vertical aod at the 6 wavelengths 145 145 DO wave=1, nwave 146 146 DO k=1, klev 147 tausum_aero(:,wave,id_STRAT)=tausum_aero(:,wave,id_STRAT)+tau_aer_strat(:,k)*alpha_strat_wave(wave)/alpha_strat_wave(2) 148 ! tausum_aero(:,wave,id_ASBCM)=tausum_aero(:,wave,id_ASBCM)+tau_aer_strat(:,k)*alpha_strat_wave(wave)/alpha_strat_wave(2) 147 tausum_aero(:,wave,id_STRAT_phy)=tausum_aero(:,wave,id_STRAT_phy)+tau_aer_strat(:,k)*alpha_strat_wave(wave)/alpha_strat_wave(2) 149 148 ENDDO 150 149 ENDDO -
LMDZ5/trunk/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90
r2058 r2146 12 12 USE aero_mod 13 13 USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer 14 USE YOMCST , only : RD , RG15 14 16 15 ! … … 50 49 ! 51 50 IMPLICIT NONE 51 INCLUDE "YOMCST.h" 52 52 ! 53 53 ! Input arguments: … … 55 55 REAL, DIMENSION(klon,klev), INTENT(in) :: pdel 56 56 REAL, INTENT(in) :: delt 57 REAL, DIMENSION(klon,klev,naero_ spc), INTENT(in) :: m_allaer57 REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer 58 58 REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair 59 59 INTEGER,INTENT(in) :: flag_aerosol … … 73 73 LOGICAL :: soluble 74 74 75 INTEGER :: i, k, m 75 INTEGER :: i, k, m, aerindex 76 76 INTEGER :: spsol, spinsol, la 77 77 INTEGER :: RH_num(klon,klev) … … 96 96 REAL :: zdp1(klon,klev) 97 97 INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name 98 INTEGER :: nb_aer 98 INTEGER :: nb_aer, itau 99 LOGICAL :: ok_itau 99 100 100 101 REAL :: dh(KLON,KLEV) … … 105 106 REAL :: alpha_aeri_5wv(las,naero_insoluble) ! Ext. coeff. ** m2/g 106 107 107 REAL, DIMENSION(klon,klev,naero_ spc) :: mass_temp108 REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp 108 109 109 110 ! … … 113 114 LOGICAL :: used_tau(naero_tot) 114 115 INTEGER :: n 115 116 116 117 ! From here on we look at the optical parameters at 5 wavelengths: 117 118 ! 443nm, 550, 670, 765 and 865 nm … … 222 223 nb_aer = 2 223 224 ALLOCATE (aerosol_name(nb_aer)) 224 aerosol_name(1) = id_ASSO4M 225 aerosol_name(2) = id_CSSO4M 225 aerosol_name(1) = id_ASSO4M_phy 226 aerosol_name(2) = id_CSSO4M_phy 226 227 ELSEIF (flag_aerosol .EQ. 2) THEN 227 228 nb_aer = 2 228 229 ALLOCATE (aerosol_name(nb_aer)) 229 aerosol_name(1) = id_ASBCM 230 aerosol_name(2) = id_AIBCM 230 aerosol_name(1) = id_ASBCM_phy 231 aerosol_name(2) = id_AIBCM_phy 231 232 ELSEIF (flag_aerosol .EQ. 3) THEN 232 233 nb_aer = 2 233 234 ALLOCATE (aerosol_name(nb_aer)) 234 aerosol_name(1) = id_ASPOMM 235 aerosol_name(2) = id_AIPOMM 235 aerosol_name(1) = id_ASPOMM_phy 236 aerosol_name(2) = id_AIPOMM_phy 236 237 ELSEIF (flag_aerosol .EQ. 4) THEN 237 238 nb_aer = 3 238 239 ALLOCATE (aerosol_name(nb_aer)) 239 aerosol_name(1) = id_CSSSM 240 aerosol_name(2) = id_SSSSM 241 aerosol_name(3) = id_ASSSM 240 aerosol_name(1) = id_CSSSM_phy 241 aerosol_name(2) = id_SSSSM_phy 242 aerosol_name(3) = id_ASSSM_phy 242 243 ELSEIF (flag_aerosol .EQ. 5) THEN 243 244 nb_aer = 1 244 245 ALLOCATE (aerosol_name(nb_aer)) 245 aerosol_name(1) = id_CIDUSTM 246 aerosol_name(1) = id_CIDUSTM_phy 246 247 ELSEIF (flag_aerosol .EQ. 6) THEN 247 248 nb_aer = 10 248 249 ALLOCATE (aerosol_name(nb_aer)) 249 aerosol_name(1) = id_ASSO4M 250 aerosol_name(2) = id_ASBCM 251 aerosol_name(3) = id_AIBCM 252 aerosol_name(4) = id_ASPOMM 253 aerosol_name(5) = id_AIPOMM 254 aerosol_name(6) = id_CSSSM 255 aerosol_name(7) = id_SSSSM 256 aerosol_name(8) = id_ASSSM 257 aerosol_name(9) = id_CIDUSTM 258 aerosol_name(10) = id_CSSO4M 250 aerosol_name(1) = id_ASSO4M_phy 251 aerosol_name(2) = id_ASBCM_phy 252 aerosol_name(3) = id_AIBCM_phy 253 aerosol_name(4) = id_ASPOMM_phy 254 aerosol_name(5) = id_AIPOMM_phy 255 aerosol_name(6) = id_CSSSM_phy 256 aerosol_name(7) = id_SSSSM_phy 257 aerosol_name(8) = id_ASSSM_phy 258 aerosol_name(9) = id_CIDUSTM_phy 259 aerosol_name(10) = id_CSSO4M_phy 259 260 ENDIF 260 261 … … 293 294 DO m=1,nb_aer ! tau is only computed for each mass 294 295 fac=1.0 295 IF (aerosol_name(m).EQ.id_ASBCM ) THEN296 IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN 296 297 soluble=.TRUE. 297 298 spsol=1 298 ELSEIF (aerosol_name(m).EQ.id_ASPOMM ) THEN299 ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 299 300 soluble=.TRUE. 300 301 spsol=2 301 ELSEIF (aerosol_name(m).EQ.id_ASSO4M ) THEN302 ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN 302 303 soluble=.TRUE. 303 304 spsol=3 304 305 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 305 ELSEIF (aerosol_name(m).EQ.id_CSSO4M ) THEN306 ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN 306 307 soluble=.TRUE. 307 308 spsol=4 308 309 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 309 ELSEIF (aerosol_name(m).EQ.id_SSSSM ) THEN310 ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 310 311 soluble=.TRUE. 311 312 spsol=5 312 ELSEIF (aerosol_name(m).EQ.id_CSSSM ) THEN313 ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 313 314 soluble=.TRUE. 314 315 spsol=6 315 ELSEIF (aerosol_name(m).EQ.id_ASSSM ) THEN316 ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN 316 317 soluble=.TRUE. 317 318 spsol=7 318 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM ) THEN319 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 319 320 soluble=.FALSE. 320 321 spinsol=1 321 ELSEIF (aerosol_name(m).EQ.id_AIBCM ) THEN322 ELSEIF (aerosol_name(m).EQ.id_AIBCM_phy) THEN 322 323 soluble=.FALSE. 323 324 spinsol=2 324 ELSEIF (aerosol_name(m).EQ.id_AIPOMM ) THEN325 ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 325 326 soluble=.FALSE. 326 327 spinsol=3 … … 335 336 ENDIF 336 337 338 aerindex=aerosol_name(m) 339 337 340 DO la=1,las 338 341 … … 344 347 (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - & 345 348 alpha_aers_5wv(RH_num(i,k),la,spsol)) 346 tau(i,k,la, spsol) = mass_temp(i,k,spsol)*1000.*zdp1(i,k)&347 *tau_ae5wv_int*delt*fac348 tausum(i,la, spsol)=tausum(i,la,spsol)+tau(i,k,la,spsol)349 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k)* & 350 tau_ae5wv_int*delt*fac 351 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 349 352 ENDDO 350 353 ENDDO 351 354 352 355 ELSE ! For insoluble aerosol 353 356 … … 355 358 DO i=1, KLON 356 359 tau_ae5wv_int = alpha_aeri_5wv(la,spinsol) 357 tau(i,k,la,naero_soluble+spinsol) = mass_temp(i,k,naero_soluble+spinsol)*1000.*zdp1(i,k)* & 358 tau_ae5wv_int*delt*fac 359 tausum(i,la,naero_soluble+spinsol)= tausum(i,la,naero_soluble+spinsol) & 360 +tau(i,k,la,naero_soluble+spinsol) 360 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k)* & 361 tau_ae5wv_int*delt*fac 362 tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex) 361 363 ENDDO 362 364 ENDDO … … 405 407 ENDDO 406 408 407 od550lt1aer(:)=tausum(:,la550,id_ASSO4M )+tausum(:,la550,id_ASBCM) +tausum(:,la550,id_AIBCM)+ &408 tausum(:,la550,id_ASPOMM )+tausum(:,la550,id_AIPOMM)+tausum(:,la550,id_ASSSM)+ &409 0.03*tausum(:,la550,id_CSSSM )+0.4*tausum(:,la550,id_CIDUSTM)409 od550lt1aer(:)=tausum(:,la550,id_ASSO4M_phy)+tausum(:,la550,id_ASBCM_phy) +tausum(:,la550,id_AIBCM_phy)+ & 410 tausum(:,la550,id_ASPOMM_phy)+tausum(:,la550,id_AIPOMM_phy)+tausum(:,la550,id_ASSSM_phy)+ & 411 0.03*tausum(:,la550,id_CSSSM_phy)+0.4*tausum(:,la550,id_CIDUSTM_phy) 410 412 411 413 DEALLOCATE(aerosol_name) -
LMDZ5/trunk/libf/phylmd/rrtm/aeropt_6bands_rrtm.F90
r2058 r2146 6 6 tau_allaer, piz_allaer, & 7 7 cg_allaer, m_allaer_pi, & 8 flag_aerosol, pplay, t_seri)8 flag_aerosol, zrho ) 9 9 10 10 USE dimphy 11 11 USE aero_mod 12 12 USE phys_local_var_mod, only: absvisaer 13 USE YOMCST , only: RD , RG14 13 15 14 ! Yves Balkanski le 12 avril 2006 … … 22 21 IMPLICIT NONE 23 22 23 INCLUDE "YOMCST.h" 24 24 INCLUDE "iniprint.h" 25 25 INCLUDE "clesphys.h" … … 30 30 REAL, DIMENSION(klon,klev), INTENT(in) :: pdel 31 31 REAL, INTENT(in) :: delt 32 REAL, DIMENSION(klon,klev,naero_ spc), INTENT(in) :: m_allaer33 REAL, DIMENSION(klon,klev,naero_ spc), INTENT(in) :: m_allaer_pi32 REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer 33 REAL, DIMENSION(klon,klev,naero_tot), INTENT(in) :: m_allaer_pi 34 34 REAL, DIMENSION(klon,klev), INTENT(in) :: RHcl ! humidite relative ciel clair 35 35 INTEGER, INTENT(in) :: flag_aerosol 36 REAL, DIMENSION(klon,klev), INTENT(in) :: pplay 37 REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri 36 REAL, DIMENSION(klon,klev), INTENT(in) :: zrho 38 37 ! 39 38 ! Output arguments: … … 41 40 ! 2= natural aerosols 42 41 ! 43 REAL, DIMENSION(klon,klev,2,nbands_ rrtm), INTENT(out) :: tau_allaer ! epaisseur optique aerosol44 REAL, DIMENSION(klon,klev,2,nbands_ rrtm), INTENT(out) :: piz_allaer ! single scattering albedo aerosol45 REAL, DIMENSION(klon,klev,2,nbands_ rrtm), INTENT(out) :: cg_allaer ! asymmetry parameter aerosol42 REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(out) :: tau_allaer ! epaisseur optique aerosol 43 REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(out) :: piz_allaer ! single scattering albedo aerosol 44 REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(out) :: cg_allaer ! asymmetry parameter aerosol 46 45 47 46 ! … … 67 66 REAL :: cg_ae2b_int ! Intermediate computation of Assymetry parameter 68 67 REAL :: Fact_RH(nbre_RH) 69 REAL :: zrho70 68 REAL :: fac 71 69 REAL :: zdp1(klon,klev) … … 73 71 INTEGER :: nb_aer 74 72 75 REAL, DIMENSION(klon,klev,naero_ spc) :: mass_temp76 REAL, DIMENSION(klon,klev,naero_ spc) :: mass_temp_pi77 REAL, DIMENSION(klon,klev,naero_tot,nbands_ rrtm) :: tau_ae78 REAL, DIMENSION(klon,klev,naero_tot,nbands_ rrtm) :: tau_ae_pi79 REAL, DIMENSION(klon,klev,naero_tot,nbands_ rrtm) :: piz_ae80 REAL, DIMENSION(klon,klev,naero_tot,nbands_ rrtm) :: cg_ae73 REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp 74 REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp_pi 75 REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae 76 REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae_pi 77 REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: piz_ae 78 REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: cg_ae 81 79 82 80 … … 84 82 ! Proprietes optiques 85 83 ! 86 REAL:: alpha_aers_6bands(nbre_RH,nbands_ rrtm,naero_soluble) !--unit m2/g SO487 REAL:: alpha_aeri_6bands(nbands_ rrtm,naero_insoluble)88 REAL:: cg_aers_6bands(nbre_RH,nbands_ rrtm,naero_soluble) !--unit89 REAL:: cg_aeri_6bands(nbands_ rrtm,naero_insoluble)90 REAL:: piz_aers_6bands(nbre_RH,nbands_ rrtm,naero_soluble) !-- unit91 REAL:: piz_aeri_6bands(nbands_ rrtm,naero_insoluble) !-- unit84 REAL:: alpha_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble) !--unit m2/g SO4 85 REAL:: alpha_aeri_6bands(nbands_sw_rrtm,naero_insoluble) 86 REAL:: cg_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble) !--unit 87 REAL:: cg_aeri_6bands(nbands_sw_rrtm,naero_insoluble) 88 REAL:: piz_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble) !-- unit 89 REAL:: piz_aeri_6bands(nbands_sw_rrtm,naero_insoluble) !-- unit 92 90 93 91 INTEGER :: id … … 280 278 spsol = 0 281 279 spinsol = 0 282 if(NSW.NE.nbands_rrtm) then280 IF (NSW.NE.nbands_sw_rrtm) THEN 283 281 print *,'Erreur NSW doit etre egal a 6 pour cette routine' 284 282 stop 285 endif283 ENDIF 286 284 287 285 DO k=1, klev 288 286 DO i=1, klon 289 zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3 290 !CDIR UNROLL=naero_spc 291 mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9 292 !CDIR UNROLL=naero_spc 293 mass_temp_pi(i,k,:) = m_allaer_pi(i,k,:) / zrho / 1.e+9 287 !CDIR UNROLL=naero_tot 288 mass_temp(i,k,:) = m_allaer(i,k,:) / zrho(i,k) / 1.e+9 !--kg/kg 289 !CDIR UNROLL=naero_tot 290 mass_temp_pi(i,k,:) = m_allaer_pi(i,k,:) / zrho(i,k) / 1.e+9 294 291 zdp1(i,k)=pdel(i,k)/(RG*delt) ! air mass auxiliary variable --> zdp1 [kg/(m^2 *s)] 295 292 ENDDO … … 299 296 nb_aer = 2 300 297 ALLOCATE (aerosol_name(nb_aer)) 301 aerosol_name(1) = id_ASSO4M 302 aerosol_name(2) = id_CSSO4M 298 aerosol_name(1) = id_ASSO4M_phy 299 aerosol_name(2) = id_CSSO4M_phy 303 300 ELSEIF (flag_aerosol .EQ. 2) THEN 304 301 nb_aer = 2 305 302 ALLOCATE (aerosol_name(nb_aer)) 306 aerosol_name(1) = id_ASBCM 307 aerosol_name(2) = id_AIBCM 303 aerosol_name(1) = id_ASBCM_phy 304 aerosol_name(2) = id_AIBCM_phy 308 305 ELSEIF (flag_aerosol .EQ. 3) THEN 309 306 nb_aer = 2 310 307 ALLOCATE (aerosol_name(nb_aer)) 311 aerosol_name(1) = id_ASPOMM 312 aerosol_name(2) = id_AIPOMM 308 aerosol_name(1) = id_ASPOMM_phy 309 aerosol_name(2) = id_AIPOMM_phy 313 310 ELSEIF (flag_aerosol .EQ. 4) THEN 314 311 nb_aer = 3 315 312 ALLOCATE (aerosol_name(nb_aer)) 316 aerosol_name(1) = id_CSSSM 317 aerosol_name(2) = id_SSSSM 318 aerosol_name(3) = id_ASSSM 313 aerosol_name(1) = id_CSSSM_phy 314 aerosol_name(2) = id_SSSSM_phy 315 aerosol_name(3) = id_ASSSM_phy 319 316 ELSEIF (flag_aerosol .EQ. 5) THEN 320 317 nb_aer = 1 321 318 ALLOCATE (aerosol_name(nb_aer)) 322 aerosol_name(1) = id_CIDUSTM 319 aerosol_name(1) = id_CIDUSTM_phy 323 320 ELSEIF (flag_aerosol .EQ. 6) THEN 324 321 nb_aer = 10 325 322 ALLOCATE (aerosol_name(nb_aer)) 326 aerosol_name(1) = id_ASSO4M 327 aerosol_name(2) = id_ASBCM 328 aerosol_name(3) = id_AIBCM 329 aerosol_name(4) = id_ASPOMM 330 aerosol_name(5) = id_AIPOMM 331 aerosol_name(6) = id_CSSSM 332 aerosol_name(7) = id_SSSSM 333 aerosol_name(8) = id_ASSSM 334 aerosol_name(9) = id_CIDUSTM 335 aerosol_name(10)= id_CSSO4M 323 aerosol_name(1) = id_ASSO4M_phy 324 aerosol_name(2) = id_ASBCM_phy 325 aerosol_name(3) = id_AIBCM_phy 326 aerosol_name(4) = id_ASPOMM_phy 327 aerosol_name(5) = id_AIPOMM_phy 328 aerosol_name(6) = id_CSSSM_phy 329 aerosol_name(7) = id_SSSSM_phy 330 aerosol_name(8) = id_ASSSM_phy 331 aerosol_name(9) = id_CIDUSTM_phy 332 aerosol_name(10)= id_CSSO4M_phy 336 333 ENDIF 337 334 … … 354 351 DO i=1, KLON 355 352 rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX) 356 RH_num(i,k) = INT( 353 RH_num(i,k) = INT(rh(i,k)/10. + 1.) 357 354 IF (rh(i,k).GT.85.) RH_num(i,k)=10 358 355 IF (rh(i,k).GT.90.) RH_num(i,k)=11 … … 365 362 DO m=1,nb_aer ! tau is only computed for each mass 366 363 fac=1.0 367 IF (aerosol_name(m).EQ.id_ASBCM ) THEN364 IF (aerosol_name(m).EQ.id_ASBCM_phy) THEN 368 365 soluble=.TRUE. 369 366 spsol=1 370 ELSEIF (aerosol_name(m).EQ.id_ASPOMM ) THEN367 ELSEIF (aerosol_name(m).EQ.id_ASPOMM_phy) THEN 371 368 soluble=.TRUE. 372 369 spsol=2 373 ELSEIF (aerosol_name(m).EQ.id_ASSO4M ) THEN370 ELSEIF (aerosol_name(m).EQ.id_ASSO4M_phy) THEN 374 371 soluble=.TRUE. 375 372 spsol=3 376 373 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 377 ELSEIF (aerosol_name(m).EQ.id_CSSO4M ) THEN374 ELSEIF (aerosol_name(m).EQ.id_CSSO4M_phy) THEN 378 375 soluble=.TRUE. 379 376 spsol=4 380 377 fac=1.375 ! (NH4)2-SO4/SO4 132/96 mass conversion factor for OD 381 ELSEIF (aerosol_name(m).EQ.id_SSSSM ) THEN378 ELSEIF (aerosol_name(m).EQ.id_SSSSM_phy) THEN 382 379 soluble=.TRUE. 383 380 spsol=5 384 ELSEIF (aerosol_name(m).EQ.id_CSSSM ) THEN381 ELSEIF (aerosol_name(m).EQ.id_CSSSM_phy) THEN 385 382 soluble=.TRUE. 386 383 spsol=6 387 ELSEIF (aerosol_name(m).EQ.id_ASSSM ) THEN384 ELSEIF (aerosol_name(m).EQ.id_ASSSM_phy) THEN 388 385 soluble=.TRUE. 389 386 spsol=7 390 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM ) THEN387 ELSEIF (aerosol_name(m).EQ.id_CIDUSTM_phy) THEN 391 388 soluble=.FALSE. 392 389 spinsol=1 393 ELSEIF (aerosol_name(m).EQ.id_AIBCM ) THEN390 ELSEIF (aerosol_name(m).EQ.id_AIBCM_phy) THEN 394 391 soluble=.FALSE. 395 392 spinsol=2 396 ELSEIF (aerosol_name(m).EQ.id_AIPOMM ) THEN393 ELSEIF (aerosol_name(m).EQ.id_AIPOMM_phy) THEN 397 394 soluble=.FALSE. 398 395 spinsol=3 … … 471 468 DO i=1, KLON 472 469 !--anthropogenic aerosol 473 tau_allaer(i,k,2,inu)=tau_ae(i,k,id_ASSO4M ,inu)+tau_ae(i,k,id_CSSO4M,inu)+ &474 tau_ae(i,k,id_ASBCM ,inu)+tau_ae(i,k,id_AIBCM,inu)+ &475 tau_ae(i,k,id_ASPOMM ,inu)+tau_ae(i,k,id_AIPOMM,inu)+ &476 tau_ae(i,k,id_ASSSM ,inu)+tau_ae(i,k,id_CSSSM,inu)+ &477 tau_ae(i,k,id_SSSSM ,inu)+ tau_ae(i,k,id_CIDUSTM,inu)470 tau_allaer(i,k,2,inu)=tau_ae(i,k,id_ASSO4M_phy,inu)+tau_ae(i,k,id_CSSO4M_phy,inu)+ & 471 tau_ae(i,k,id_ASBCM_phy,inu)+tau_ae(i,k,id_AIBCM_phy,inu)+ & 472 tau_ae(i,k,id_ASPOMM_phy,inu)+tau_ae(i,k,id_AIPOMM_phy,inu)+ & 473 tau_ae(i,k,id_ASSSM_phy,inu)+tau_ae(i,k,id_CSSSM_phy,inu)+ & 474 tau_ae(i,k,id_SSSSM_phy,inu)+ tau_ae(i,k,id_CIDUSTM_phy,inu) 478 475 tau_allaer(i,k,2,inu)=MAX(tau_allaer(i,k,2,inu),1e-5) 479 476 480 piz_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)+ &481 tau_ae(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)+ &482 tau_ae(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)+ &483 tau_ae(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)+ &484 tau_ae(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)+ &485 tau_ae(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)+ &486 tau_ae(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)+ &487 tau_ae(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)+ &488 tau_ae(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)+ &489 tau_ae(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)) &477 piz_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ & 478 tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+ & 479 tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)+ & 480 tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+ & 481 tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+ & 482 tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+ & 483 tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+ & 484 tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+ & 485 tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+ & 486 tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) & 490 487 /tau_allaer(i,k,2,inu) 491 488 piz_allaer(i,k,2,inu)=MAX(piz_allaer(i,k,2,inu),0.1) 492 489 493 cg_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)*cg_ae(i,k,id_ASSO4M,inu)+ &494 tau_ae(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)*cg_ae(i,k,id_CSSO4M,inu)+ &495 tau_ae(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)*cg_ae(i,k,id_ASBCM,inu)+ &496 tau_ae(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)*cg_ae(i,k,id_AIBCM,inu)+ &497 tau_ae(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)*cg_ae(i,k,id_ASPOMM,inu)+ &498 tau_ae(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)*cg_ae(i,k,id_AIPOMM,inu)+ &499 tau_ae(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)*cg_ae(i,k,id_ASSSM,inu)+ &500 tau_ae(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)*cg_ae(i,k,id_CSSSM,inu)+ &501 tau_ae(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)*cg_ae(i,k,id_SSSSM,inu)+ &502 tau_ae(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)*cg_ae(i,k,id_CIDUSTM,inu))/ &490 cg_allaer(i,k,2,inu)=(tau_ae(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ & 491 tau_ae(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)*cg_ae(i,k,id_CSSO4M_phy,inu)+ & 492 tau_ae(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)*cg_ae(i,k,id_ASBCM_phy,inu)+ & 493 tau_ae(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu)+ & 494 tau_ae(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)+ & 495 tau_ae(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu)+ & 496 tau_ae(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)*cg_ae(i,k,id_ASSSM_phy,inu)+ & 497 tau_ae(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu)+ & 498 tau_ae(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu)+ & 499 tau_ae(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)*cg_ae(i,k,id_CIDUSTM_phy,inu))/ & 503 500 (tau_allaer(i,k,2,inu)*piz_allaer(i,k,2,inu)) 504 501 505 502 !--natural aerosol 506 tau_allaer(i,k,1,inu)=tau_ae_pi(i,k,id_ASSO4M ,inu)+tau_ae_pi(i,k,id_CSSO4M,inu)+ &507 tau_ae_pi(i,k,id_ASBCM ,inu)+tau_ae_pi(i,k,id_AIBCM,inu)+ &508 tau_ae_pi(i,k,id_ASPOMM ,inu)+tau_ae_pi(i,k,id_AIPOMM,inu)+ &509 tau_ae_pi(i,k,id_ASSSM ,inu)+tau_ae_pi(i,k,id_CSSSM,inu)+ &510 tau_ae_pi(i,k,id_SSSSM ,inu)+ tau_ae_pi(i,k,id_CIDUSTM,inu)503 tau_allaer(i,k,1,inu)=tau_ae_pi(i,k,id_ASSO4M_phy,inu)+tau_ae_pi(i,k,id_CSSO4M_phy,inu)+ & 504 tau_ae_pi(i,k,id_ASBCM_phy,inu)+tau_ae_pi(i,k,id_AIBCM_phy,inu)+ & 505 tau_ae_pi(i,k,id_ASPOMM_phy,inu)+tau_ae_pi(i,k,id_AIPOMM_phy,inu)+ & 506 tau_ae_pi(i,k,id_ASSSM_phy,inu)+tau_ae_pi(i,k,id_CSSSM_phy,inu)+ & 507 tau_ae_pi(i,k,id_SSSSM_phy,inu)+ tau_ae_pi(i,k,id_CIDUSTM_phy,inu) 511 508 tau_allaer(i,k,1,inu)=MAX(tau_allaer(i,k,1,inu),1e-5) 512 509 513 piz_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)+ &514 tau_ae_pi(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)+ &515 tau_ae_pi(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)+ &516 tau_ae_pi(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)+ &517 tau_ae_pi(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)+ &518 tau_ae_pi(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)+ &519 tau_ae_pi(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)+ &520 tau_ae_pi(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)+ &521 tau_ae_pi(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)+ &522 tau_ae_pi(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)) &510 piz_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)+ & 511 tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)+ & 512 tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)+ & 513 tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)+ & 514 tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)+ & 515 tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)+ & 516 tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)+ & 517 tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)+ & 518 tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)+ & 519 tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)) & 523 520 /tau_allaer(i,k,1,inu) 524 521 piz_allaer(i,k,1,inu)=MAX(piz_allaer(i,k,1,inu),0.1) 525 522 526 cg_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M ,inu)*piz_ae(i,k,id_ASSO4M,inu)*cg_ae(i,k,id_ASSO4M,inu)+ &527 tau_ae_pi(i,k,id_CSSO4M ,inu)*piz_ae(i,k,id_CSSO4M,inu)*cg_ae(i,k,id_CSSO4M,inu)+ &528 tau_ae_pi(i,k,id_ASBCM ,inu)*piz_ae(i,k,id_ASBCM,inu)*cg_ae(i,k,id_ASBCM,inu)+ &529 tau_ae_pi(i,k,id_AIBCM ,inu)*piz_ae(i,k,id_AIBCM,inu)*cg_ae(i,k,id_AIBCM,inu)+ &530 tau_ae_pi(i,k,id_ASPOMM ,inu)*piz_ae(i,k,id_ASPOMM,inu)*cg_ae(i,k,id_ASPOMM,inu)+ &531 tau_ae_pi(i,k,id_AIPOMM ,inu)*piz_ae(i,k,id_AIPOMM,inu)*cg_ae(i,k,id_AIPOMM,inu)+ &532 tau_ae_pi(i,k,id_ASSSM ,inu)*piz_ae(i,k,id_ASSSM,inu)*cg_ae(i,k,id_ASSSM,inu)+ &533 tau_ae_pi(i,k,id_CSSSM ,inu)*piz_ae(i,k,id_CSSSM,inu)*cg_ae(i,k,id_CSSSM,inu)+ &534 tau_ae_pi(i,k,id_SSSSM ,inu)*piz_ae(i,k,id_SSSSM,inu)*cg_ae(i,k,id_SSSSM,inu)+ &535 tau_ae_pi(i,k,id_CIDUSTM ,inu)*piz_ae(i,k,id_CIDUSTM,inu)*cg_ae(i,k,id_CIDUSTM,inu))/ &523 cg_allaer(i,k,1,inu)=(tau_ae_pi(i,k,id_ASSO4M_phy,inu)*piz_ae(i,k,id_ASSO4M_phy,inu)*cg_ae(i,k,id_ASSO4M_phy,inu)+ & 524 tau_ae_pi(i,k,id_CSSO4M_phy,inu)*piz_ae(i,k,id_CSSO4M_phy,inu)*cg_ae(i,k,id_CSSO4M_phy,inu)+ & 525 tau_ae_pi(i,k,id_ASBCM_phy,inu)*piz_ae(i,k,id_ASBCM_phy,inu)*cg_ae(i,k,id_ASBCM_phy,inu)+ & 526 tau_ae_pi(i,k,id_AIBCM_phy,inu)*piz_ae(i,k,id_AIBCM_phy,inu)*cg_ae(i,k,id_AIBCM_phy,inu)+ & 527 tau_ae_pi(i,k,id_ASPOMM_phy,inu)*piz_ae(i,k,id_ASPOMM_phy,inu)*cg_ae(i,k,id_ASPOMM_phy,inu)+ & 528 tau_ae_pi(i,k,id_AIPOMM_phy,inu)*piz_ae(i,k,id_AIPOMM_phy,inu)*cg_ae(i,k,id_AIPOMM_phy,inu)+ & 529 tau_ae_pi(i,k,id_ASSSM_phy,inu)*piz_ae(i,k,id_ASSSM_phy,inu)*cg_ae(i,k,id_ASSSM_phy,inu)+ & 530 tau_ae_pi(i,k,id_CSSSM_phy,inu)*piz_ae(i,k,id_CSSSM_phy,inu)*cg_ae(i,k,id_CSSSM_phy,inu)+ & 531 tau_ae_pi(i,k,id_SSSSM_phy,inu)*piz_ae(i,k,id_SSSSM_phy,inu)*cg_ae(i,k,id_SSSSM_phy,inu)+ & 532 tau_ae_pi(i,k,id_CIDUSTM_phy,inu)*piz_ae(i,k,id_CIDUSTM_phy,inu)*cg_ae(i,k,id_CIDUSTM_phy,inu))/ & 536 533 (tau_allaer(i,k,1,inu)*piz_allaer(i,k,1,inu)) 537 534 -
LMDZ5/trunk/libf/phylmd/rrtm/radlsw.F90
r2043 r2146 11 11 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,& 12 12 & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV ,& 13 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,PFLUX,PFLUC,& 14 & PFSDN ,PFSUP , PFSCDN , PFSCUP) 13 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,& 14 & PTAU_LW,& 15 & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP) 15 16 16 17 use write_field_phy … … 57 58 ! PCGA_DST : (KPROMA,KLEV,NSW); Assymetry factor for dust 58 59 ! PTAUREL_DST: (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm 60 ! PTAU_LW (KPROMA,KLEV,NLW); LW Optical depth of aerosols 59 61 ! PREF_LIQ (KPROMA,KLEV) ; Liquid droplet radius (um) 60 62 ! PREF_ICE (KPROMA,KLEV) ; Ice crystal radius (um) … … 127 129 !USE YOERAD , ONLY : NSW ,LRRTM ,LCCNL ,LCCNO, LDIFFC, & 128 130 ! NSW mis dans .def MPL 20140211 129 USE YOERAD , ONLY : LRRTM ,LCCNL ,LCCNO, LDIFFC, &131 USE YOERAD , ONLY : NLW, LRRTM ,LCCNL ,LCCNO, LDIFFC, & 130 132 & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,& 131 133 & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,& … … 154 156 155 157 include "clesphys.h" 158 !!include "clesrrtm.h" 156 159 include "YOETHF.h" 157 160 INTEGER(KIND=JPIM),INTENT(IN) :: KLON … … 192 195 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW) 193 196 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW) 197 !--C.Kleinschmitt 198 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) 199 !--end 194 200 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KLON,KLEV) 195 201 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KLON,KLEV) … … 1101 1107 & PTS , PTH , PT,& 1102 1108 & ZEMIS , ZEMIW,& 1103 & PQ , PCCO2 , ZOZN , ZCLDSW , ZTAUCLD,& 1104 & ZEMIT , PFLUX , PFLUC , ZTCLEAR & 1105 & ) 1109 & PQ , PCCO2 , ZOZN ,& 1110 & ZCLDSW , ZTAUCLD,& 1111 & PTAU_LW,& 1112 & ZEMIT , PFLUX , PFLUC , ZTCLEAR ) 1106 1113 print *,'RADLSW: apres CALL RRTM_RRTM_140GP' 1107 1114 -
LMDZ5/trunk/libf/phylmd/rrtm/radlsw.intfb.h
r1990 r2146 1 1 INTERFACE 2 SUBROUTINE RADLSW &3 & ( KIDIA, KFDIA , KLON , KLEV , KMODE, KAER,&2 SUBROUTINE RADLSW & 3 & ( KIDIA, KFDIA , KLON , KLEV , KMODE, KAER,& 4 4 & PRII0,& 5 5 & PAER , PALBD , PALBP, PAPH , PAP,& 6 6 & PCCNL, PCCNO,& 7 & PCCO2, PCLFR , PDP , PEMIS, PEMIW , PLSM , PMU0, POZON,&8 & PQ , PQIWP , PQLWP, PQS, PQRAIN, PRAINT,&9 & PTH , PT , PTS, PNBAS, PNTOP,&10 & PREF_LIQ 11 & PEMIT, PFCT , PFLT , PFCS , PFLS,&7 & PCCO2, PCLFR , PDP , PEMIS, PEMIW , PLSM , PMU0, POZON,& 8 & PQ , PQIWP , PQLWP, PQS , PQRAIN, PRAINT,& 9 & PTH , PT , PTS , PNBAS, PNTOP,& 10 & PREF_LIQ, PREF_ICE,& 11 & PEMIT, PFCT , PFLT , PFCS , PFLS,& 12 12 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,& 13 & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV,& 14 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,PFLUX,PFLUC,& 15 & PFSDN ,PFSUP , PFSCDN , PFSCUP) 13 & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV ,& 14 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,& 15 & PTAU_LW,& 16 & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP) 17 16 18 USE PARKIND1 ,ONLY : JPIM ,JPRB 17 USE YOERAD , ONLY : LRRTM ,LCCNL ,LCCNO, LDIFFC,&19 USE YOERAD , ONLY : NLW, LRRTM ,LCCNL ,LCCNO, LDIFFC,& 18 20 & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,& 19 21 & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,& … … 59 61 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_DST(KLON,KLEV,NSW) 60 62 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUREL_DST(KLON,KLEV,NSW) 63 !--C.Kleinschmitt 64 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) 65 !--end 61 66 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) 62 67 REAL(KIND=JPRB) ,INTENT(OUT) :: PFCT(KLON,KLEV+1) -
LMDZ5/trunk/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90
r2005 r2146 1 1 ! $Id$ 2 2 ! 3 SUBROUTINE readaerosol_optic_rrtm(debut, new_aod, flag_aerosol, itap, rjourvrai, & 3 SUBROUTINE readaerosol_optic_rrtm(debut, aerosol_couple, & 4 new_aod, flag_aerosol, itap, rjourvrai, & 4 5 pdtphys, pplay, paprs, t_seri, rhcl, presnivs, & 5 mass_solu_aero, mass_solu_aero_pi, &6 tr_seri, mass_solu_aero, mass_solu_aero_pi, & 6 7 tau_aero, piz_aero, cg_aero, & 7 8 tausum_aero, tau3d_aero ) 8 9 9 ! This routine will :10 ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol11 ! 2) calculate the optical properties for the aerosols12 !13 10 ! This routine will : 11 ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol 12 ! 2) calculate the optical properties for the aerosols 13 ! 14 14 15 USE dimphy 15 16 USE aero_mod 16 USE phys_local_var_mod, only: sconcso4,sconcoa,sconcbc,sconcss,sconcdust, & 17 concso4,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, & 18 load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7 17 USE phys_local_var_mod, only: sconcso4,sconcno3,sconcoa,sconcbc,sconcss,sconcdust, & 18 concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, & 19 load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7 20 21 USE infotrac 22 19 23 IMPLICIT NONE 20 24 include "clesphys.h" 21 22 ! Input arguments 23 !**************************************************************************************** 25 include "YOMCST.h" 26 27 28 ! Input arguments 29 !**************************************************************************************** 24 30 LOGICAL, INTENT(IN) :: debut 31 LOGICAL, INTENT(IN) :: aerosol_couple 25 32 LOGICAL, INTENT(IN) :: new_aod 26 33 INTEGER, INTENT(IN) :: flag_aerosol … … 33 40 REAL, DIMENSION(klon,klev), INTENT(IN) :: rhcl ! humidite relative ciel clair 34 41 REAL, DIMENSION(klev), INTENT(IN) :: presnivs 35 36 ! Output arguments 37 !**************************************************************************************** 42 REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer 43 44 ! Output arguments 45 !**************************************************************************************** 38 46 REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero ! Total mass for all soluble aerosols 39 47 REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero_pi ! -"- preindustrial values … … 41 49 REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero ! Single scattering albedo aerosol 42 50 REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero ! asymmetry parameter aerosol 43 ! REAL, DIMENSION(klon,nwave,naero_spc), INTENT(OUT) :: tausum_aero44 ! REAL, DIMENSION(klon,klev,nwave,naero_spc), INTENT(OUT) :: tau3d_aero45 !--correction minibug OB46 51 REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT) :: tausum_aero 47 52 REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau3d_aero 48 53 49 ! Local variables 50 !**************************************************************************************** 51 REAL, DIMENSION(klon) :: aerindex ! POLDER aerosol index 52 REAL, DIMENSION(klon,klev) :: sulfate ! SO4 aerosol concentration [ug/m3] 53 REAL, DIMENSION(klon,klev) :: bcsol ! BC soluble concentration [ug/m3] 54 REAL, DIMENSION(klon,klev) :: bcins ! BC insoluble concentration [ug/m3] 55 REAL, DIMENSION(klon,klev) :: pomsol ! POM soluble concentration [ug/m3] 56 REAL, DIMENSION(klon,klev) :: pomins ! POM insoluble concentration [ug/m3] 57 REAL, DIMENSION(klon,klev) :: cidust ! DUST aerosol concentration [ug/m3] 58 REAL, DIMENSION(klon,klev) :: sscoarse ! SS Coarse concentration [ug/m3] 59 REAL, DIMENSION(klon,klev) :: sssupco ! SS Super Coarse concentration [ug/m3] 60 REAL, DIMENSION(klon,klev) :: ssacu ! SS Acumulation concentration [ug/m3] 61 REAL, DIMENSION(klon,klev) :: sulfate_pi 54 ! Local variables 55 !**************************************************************************************** 56 REAL, DIMENSION(klon) :: aerindex ! POLDER aerosol index 57 REAL, DIMENSION(klon,klev) :: sulfacc ! SO4 accumulation concentration [ug/m3] 58 REAL, DIMENSION(klon,klev) :: sulfcoarse ! SO4 coarse concentration [ug/m3] 59 REAL, DIMENSION(klon,klev) :: bcsol ! BC soluble concentration [ug/m3] 60 REAL, DIMENSION(klon,klev) :: bcins ! BC insoluble concentration [ug/m3] 61 REAL, DIMENSION(klon,klev) :: pomsol ! POM soluble concentration [ug/m3] 62 REAL, DIMENSION(klon,klev) :: pomins ! POM insoluble concentration [ug/m3] 63 REAL, DIMENSION(klon,klev) :: cidust ! DUST aerosol concentration [ug/m3] 64 REAL, DIMENSION(klon,klev) :: sscoarse ! SS Coarse concentration [ug/m3] 65 REAL, DIMENSION(klon,klev) :: sssupco ! SS Super Coarse concentration [ug/m3] 66 REAL, DIMENSION(klon,klev) :: ssacu ! SS Acumulation concentration [ug/m3] 67 REAL, DIMENSION(klon,klev) :: nitracc ! nitrate accumulation concentration [ug/m3] 68 REAL, DIMENSION(klon,klev) :: nitrcoarse ! nitrate coarse concentration [ug/m3] 69 REAL, DIMENSION(klon,klev) :: nitrinscoarse ! nitrate insoluble coarse concentration [ug/m3] 70 REAL, DIMENSION(klon,klev) :: sulfacc_pi 71 REAL, DIMENSION(klon,klev) :: sulfcoarse_pi 62 72 REAL, DIMENSION(klon,klev) :: bcsol_pi 63 73 REAL, DIMENSION(klon,klev) :: bcins_pi … … 68 78 REAL, DIMENSION(klon,klev) :: sssupco_pi 69 79 REAL, DIMENSION(klon,klev) :: ssacu_pi 70 REAL, DIMENSION(klon,klev) :: pdel 71 REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer 72 REAL, DIMENSION(klon,klev,naero_spc) :: m_allaer_pi !RAF 73 ! REAL, DIMENSION(klon,naero_tot) :: fractnat_allaer !RAF delete?? 74 80 REAL, DIMENSION(klon,klev) :: nitracc_pi 81 REAL, DIMENSION(klon,klev) :: nitrcoarse_pi 82 REAL, DIMENSION(klon,klev) :: nitrinscoarse_pi 83 REAL, DIMENSION(klon,klev) :: pdel, zrho 84 REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer 85 REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF 86 ! REAL, DIMENSION(klon,naero_tot) :: fractnat_allaer !RAF delete?? 87 character(len=8), dimension(nbtr) :: tracname 88 integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM 89 integer :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M 75 90 INTEGER :: k, i 76 77 !**************************************************************************************** 78 ! 1) Get aerosol mass 79 ! 80 !**************************************************************************************** 81 ! Read and interpolate sulfate 82 IF ( flag_aerosol .EQ. 1 .OR. & 83 flag_aerosol .EQ. 6 ) THEN 84 85 CALL readaerosol_interp(id_ASSO4M, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfate, sulfate_pi,loadso4) 86 ELSE 87 sulfate(:,:) = 0. ; sulfate_pi(:,:) = 0. 88 loadso4=0. 89 END IF 90 91 ! Read and interpolate bcsol and bcins 92 IF ( flag_aerosol .EQ. 2 .OR. & 93 flag_aerosol .EQ. 6 ) THEN 94 95 ! Get bc aerosol distribution 96 CALL readaerosol_interp(id_ASBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 ) 97 CALL readaerosol_interp(id_AIBCM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 ) 98 loadbc(:)=load_tmp1(:)+load_tmp2(:) 99 ELSE 100 bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0. 101 bcins(:,:) = 0. ; bcins_pi(:,:) = 0. 102 loadbc=0. 103 END IF 104 105 106 ! Read and interpolate pomsol and pomins 107 IF ( flag_aerosol .EQ. 3 .OR. & 108 flag_aerosol .EQ. 6 ) THEN 109 110 CALL readaerosol_interp(id_ASPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3) 111 CALL readaerosol_interp(id_AIPOMM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4) 112 loadoa(:)=load_tmp3(:)+load_tmp4(:) 113 ELSE 114 pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0. 115 pomins(:,:) = 0. ; pomins_pi(:,:) = 0. 116 loadoa=0. 117 END IF 118 119 120 ! Read and interpolate csssm, ssssm, assssm 121 IF (flag_aerosol .EQ. 4 .OR. & 122 flag_aerosol .EQ. 6 ) THEN 123 124 CALL readaerosol_interp(id_SSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5) 125 CALL readaerosol_interp(id_CSSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6) 126 CALL readaerosol_interp(id_ASSSM ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7) 127 loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:) 128 ELSE 129 sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0. 130 ssacu(:,:) = 0. ; ssacu_pi(:,:) = 0. 131 sssupco(:,:) = 0. ; sssupco_pi = 0. 132 loadss=0. 133 ENDIF 134 135 ! Read and interpolate cidustm 136 IF (flag_aerosol .EQ. 5 .OR. & 137 flag_aerosol .EQ. 6 ) THEN 138 139 CALL readaerosol_interp(id_CIDUSTM, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust) 140 141 ELSE 142 cidust(:,:) = 0. ; cidust_pi(:,:) = 0. 143 loaddust=0. 144 ENDIF 145 146 ! 147 ! Store all aerosols in one variable 148 ! 149 m_allaer(:,:,id_ASBCM) = bcsol(:,:) ! ASBCM 150 m_allaer(:,:,id_ASPOMM) = pomsol(:,:) ! ASPOMM 151 m_allaer(:,:,id_ASSO4M) = sulfate(:,:) ! ASSO4M (= SO4) 152 m_allaer(:,:,id_CSSO4M) = 0. ! CSSO4M 153 m_allaer(:,:,id_SSSSM) = sssupco(:,:) ! SSSSM 154 m_allaer(:,:,id_CSSSM) = sscoarse(:,:) ! CSSSM 155 m_allaer(:,:,id_ASSSM) = ssacu(:,:) ! ASSSM 156 m_allaer(:,:,id_CIDUSTM)= cidust(:,:) ! CIDUSTM 157 m_allaer(:,:,id_AIBCM) = bcins(:,:) ! AIBCM 158 m_allaer(:,:,id_AIPOMM) = pomins(:,:) ! AIPOMM 159 160 !RAF 161 m_allaer_pi(:,:,1) = bcsol_pi(:,:) ! ASBCM pre-ind 162 m_allaer_pi(:,:,2) = pomsol_pi(:,:) ! ASPOMM pre-ind 163 m_allaer_pi(:,:,3) = sulfate_pi(:,:) ! ASSO4M (= SO4) pre-ind 164 m_allaer_pi(:,:,4) = 0. ! CSSO4M pre-ind 165 m_allaer_pi(:,:,5) = sssupco_pi(:,:) ! SSSSM pre-ind 166 m_allaer_pi(:,:,6) = sscoarse_pi(:,:) ! CSSSM pre-ind 167 m_allaer_pi(:,:,7) = ssacu_pi(:,:) ! ASSSM pre-ind 168 m_allaer_pi(:,:,8) = cidust_pi(:,:) ! CIDUSTM pre-ind 169 m_allaer_pi(:,:,9) = bcins_pi(:,:) ! AIBCM pre-ind 170 m_allaer_pi(:,:,10) = pomins_pi(:,:) ! AIPOMM pre-ind 171 172 ! 173 ! Calculate the total mass of all soluble aersosols 174 ! 175 mass_solu_aero(:,:) = sulfate(:,:) + bcsol(:,:) + pomsol(:,:) ! + & 176 ! sscoarse(:,:) + ssacu(:,:) + sssupco(:,:) 177 mass_solu_aero_pi(:,:) = sulfate_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) ! + & 178 ! sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:) 179 180 !**************************************************************************************** 181 ! 2) Calculate optical properties for the aerosols 182 ! 183 !**************************************************************************************** 91 92 !--air density 93 zrho(:,:)=pplay(:,:)/t_seri(:,:)/RD !--kg/m3 94 95 !**************************************************************************************** 96 ! 1) Get aerosol mass 97 ! 98 !**************************************************************************************** 99 ! 100 ! 101 IF (aerosol_couple) THEN !--we get aerosols from tr_seri array from INCA 102 ! 103 !--copy fields from INCA tr_seri 104 !--convert to ug m-3 unit for consistency with offline fields 105 ! 106 #ifdef INCA 107 call tracinca_name(tracname) 108 #endif 109 110 do i=1,nbtr 111 select case(trim(tracname(i))) 112 case ("ASBCM") 113 id_ASBCM = i 114 case ("ASPOMM") 115 id_ASPOMM = i 116 case ("ASSO4M") 117 id_ASSO4M = i 118 case ("ASMSAM") 119 id_ASMSAM = i 120 case ("CSSO4M") 121 id_CSSO4M = i 122 case ("CSMSAM") 123 id_CSMSAM = i 124 case ("SSSSM") 125 id_SSSSM = i 126 case ("CSSSM") 127 id_CSSSM = i 128 case ("ASSSM") 129 id_ASSSM = i 130 case ("CIDUSTM") 131 id_CIDUSTM = i 132 case ("AIBCM") 133 id_AIBCM = i 134 case ("AIPOMM") 135 id_AIPOMM = i 136 case ("ASNO3M") 137 id_ASNO3M = i 138 case ("CSNO3M") 139 id_CSNO3M = i 140 case ("CINO3M") 141 id_CINO3M = i 142 end select 143 enddo 144 145 146 bcsol(:,:) = tr_seri(:,:,id_ASBCM) *zrho(:,:)*1.e9 ! ASBCM 147 pomsol(:,:) = tr_seri(:,:,id_ASPOMM) *zrho(:,:)*1.e9 ! ASPOMM 148 sulfacc(:,:) = (tr_seri(:,:,id_ASSO4M)+tr_seri(:,:,id_ASMSAM))*zrho(:,:)*1.e9 ! ASSO4M (=SO4) + ASMSAM (=MSA) 149 sulfcoarse(:,:) = (tr_seri(:,:,id_CSSO4M)+tr_seri(:,:,id_CSMSAM))*zrho(:,:)*1.e9 ! CSSO4M (=SO4) + CSMSAM (=MSA) 150 sssupco(:,:) = tr_seri(:,:,id_SSSSM) *zrho(:,:)*1.e9 ! SSSSM 151 sscoarse(:,:) = tr_seri(:,:,id_CSSSM) *zrho(:,:)*1.e9 ! CSSSM 152 ssacu(:,:) = tr_seri(:,:,id_ASSSM) *zrho(:,:)*1.e9 ! ASSSM 153 cidust(:,:) = tr_seri(:,:,id_CIDUSTM) *zrho(:,:)*1.e9 ! CIDUSTM 154 bcins(:,:) = tr_seri(:,:,id_AIBCM) *zrho(:,:)*1.e9 ! AIBCM 155 pomins(:,:) = tr_seri(:,:,id_AIPOMM) *zrho(:,:)*1.e9 ! AIPOMM 156 nitracc(:,:) = tr_seri(:,:,id_ASNO3M) *zrho(:,:)*1.e9 ! ASNO3M 157 nitrcoarse(:,:) = tr_seri(:,:,id_CSNO3M) *zrho(:,:)*1.e9 ! CSNO3M 158 nitrinscoarse(:,:)= tr_seri(:,:,id_CINO3M) *zrho(:,:)*1.e9 ! CINO3M 159 ! 160 bcsol_pi(:,:) = 0.0 ! ASBCM pre-ind 161 pomsol_pi(:,:) = 0.0 ! ASPOMM pre-ind 162 sulfacc_pi(:,:) = 0.0 ! ASSO4M (=SO4) + ASMSAM (=MSA) pre-ind 163 sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind 164 sssupco_pi(:,:) = 0.0 ! SSSSM pre-ind 165 sscoarse_pi(:,:) = 0.0 ! CSSSM pre-ind 166 ssacu_pi(:,:) = 0.0 ! ASSSM pre-ind 167 cidust_pi(:,:) = 0.0 ! CIDUSTM pre-ind 168 bcins_pi(:,:) = 0.0 ! AIBCM pre-ind 169 pomins_pi(:,:) = 0.0 ! AIPOMM pre-ind 170 nitracc_pi(:,:) = 0.0 ! ASNO3M pre-ind 171 nitrcoarse_pi(:,:) = 0.0 ! CSNO3M pre-ind 172 nitrinscoarse_pi(:,:)= 0.0 ! CINO3M 173 ! 174 ELSE !--not aerosol_couple 175 ! 176 ! Read and interpolate sulfate 177 IF ( flag_aerosol .EQ. 1 .OR. & 178 flag_aerosol .EQ. 6 ) THEN 179 180 CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4) 181 ELSE 182 sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0. 183 loadso4=0. 184 END IF 185 186 ! Read and interpolate bcsol and bcins 187 IF ( flag_aerosol .EQ. 2 .OR. & 188 flag_aerosol .EQ. 6 ) THEN 189 190 ! Get bc aerosol distribution 191 CALL readaerosol_interp(id_ASBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcsol, bcsol_pi, load_tmp1 ) 192 CALL readaerosol_interp(id_AIBCM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, bcins, bcins_pi, load_tmp2 ) 193 loadbc(:)=load_tmp1(:)+load_tmp2(:) 194 ELSE 195 bcsol(:,:) = 0. ; bcsol_pi(:,:) = 0. 196 bcins(:,:) = 0. ; bcins_pi(:,:) = 0. 197 loadbc=0. 198 END IF 199 200 201 ! Read and interpolate pomsol and pomins 202 IF ( flag_aerosol .EQ. 3 .OR. & 203 flag_aerosol .EQ. 6 ) THEN 204 205 CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3) 206 CALL readaerosol_interp(id_AIPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomins, pomins_pi, load_tmp4) 207 loadoa(:)=load_tmp3(:)+load_tmp4(:) 208 ELSE 209 pomsol(:,:) = 0. ; pomsol_pi(:,:) = 0. 210 pomins(:,:) = 0. ; pomins_pi(:,:) = 0. 211 loadoa=0. 212 END IF 213 214 215 ! Read and interpolate csssm, ssssm, assssm 216 IF (flag_aerosol .EQ. 4 .OR. & 217 flag_aerosol .EQ. 6 ) THEN 218 219 CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sssupco, sssupco_pi, load_tmp5) 220 CALL readaerosol_interp(id_CSSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sscoarse,sscoarse_pi, load_tmp6) 221 CALL readaerosol_interp(id_ASSSM_phy ,itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, ssacu, ssacu_pi, load_tmp7) 222 loadss(:)=load_tmp5(:)+load_tmp6(:)+load_tmp7(:) 223 ELSE 224 sscoarse(:,:) = 0. ; sscoarse_pi(:,:) = 0. 225 ssacu(:,:) = 0. ; ssacu_pi(:,:) = 0. 226 sssupco(:,:) = 0. ; sssupco_pi = 0. 227 loadss=0. 228 ENDIF 229 230 ! Read and interpolate cidustm 231 IF (flag_aerosol .EQ. 5 .OR. & 232 flag_aerosol .EQ. 6 ) THEN 233 234 CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust) 235 236 ELSE 237 cidust(:,:) = 0. ; cidust_pi(:,:) = 0. 238 loaddust=0. 239 ENDIF 240 ! 241 sulfcoarse(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) 242 sulfcoarse_pi(:,:) = 0.0 ! CSSO4M (=SO4) + CSMSAM (=MSA) pre-ind 243 ! 244 !--placeholder for offline nitrate 245 ! 246 nitracc(:,:) = 0.0 247 nitracc_pi(:,:) = 0.0 248 nitrcoarse(:,:) = 0.0 249 nitrcoarse_pi(:,:) = 0.0 250 nitrinscoarse(:,:) = 0.0 251 nitrinscoarse_pi(:,:)= 0.0 252 253 ENDIF !--not aerosol_couple 254 255 ! 256 ! Store all aerosols in one variable 257 ! 258 m_allaer(:,:,id_ASBCM_phy) = bcsol(:,:) ! ASBCM 259 m_allaer(:,:,id_ASPOMM_phy) = pomsol(:,:) ! ASPOMM 260 m_allaer(:,:,id_ASSO4M_phy) = sulfacc(:,:) ! ASSO4M (= SO4) 261 m_allaer(:,:,id_CSSO4M_phy) = sulfcoarse(:,:) ! CSSO4M 262 m_allaer(:,:,id_SSSSM_phy) = sssupco(:,:) ! SSSSM 263 m_allaer(:,:,id_CSSSM_phy) = sscoarse(:,:) ! CSSSM 264 m_allaer(:,:,id_ASSSM_phy) = ssacu(:,:) ! ASSSM 265 m_allaer(:,:,id_CIDUSTM_phy)= cidust(:,:) ! CIDUSTM 266 m_allaer(:,:,id_AIBCM_phy) = bcins(:,:) ! AIBCM 267 m_allaer(:,:,id_ASNO3M_phy) = nitracc(:,:) ! ASNO3M 268 m_allaer(:,:,id_CSNO3M_phy) = nitrcoarse(:,:) ! CSNO3M 269 m_allaer(:,:,id_CINO3M_phy) = nitrinscoarse(:,:)! CINO3M 270 m_allaer(:,:,id_AIPOMM_phy) = pomins(:,:) ! AIPOMM 271 m_allaer(:,:,id_STRAT_phy) = 0.0 272 273 !RAF 274 m_allaer_pi(:,:,id_ASBCM_phy) = bcsol_pi(:,:) ! ASBCM pre-ind 275 m_allaer_pi(:,:,id_ASPOMM_phy) = pomsol_pi(:,:) ! ASPOMM pre-ind 276 m_allaer_pi(:,:,id_ASSO4M_phy) = sulfacc_pi(:,:) ! ASSO4M (= SO4) pre-ind 277 m_allaer_pi(:,:,id_CSSO4M_phy) = sulfcoarse_pi(:,:) ! CSSO4M pre-ind 278 m_allaer_pi(:,:,id_SSSSM_phy) = sssupco_pi(:,:) ! SSSSM pre-ind 279 m_allaer_pi(:,:,id_CSSSM_phy) = sscoarse_pi(:,:) ! CSSSM pre-ind 280 m_allaer_pi(:,:,id_ASSSM_phy) = ssacu_pi(:,:) ! ASSSM pre-ind 281 m_allaer_pi(:,:,id_CIDUSTM_phy)= cidust_pi(:,:) ! CIDUSTM pre-ind 282 m_allaer_pi(:,:,id_AIBCM_phy) = bcins_pi(:,:) ! AIBCM pre-ind 283 m_allaer_pi(:,:,id_ASNO3M_phy) = nitracc_pi(:,:) ! ASNO3M pre-ind 284 m_allaer_pi(:,:,id_CSNO3M_phy) = nitrcoarse_pi(:,:) ! CSNO3M pre-ind 285 m_allaer_pi(:,:,id_CINO3M_phy) = nitrinscoarse_pi(:,:)! CINO3M pre-ind 286 m_allaer_pi(:,:,id_AIPOMM_phy) = pomins_pi(:,:) ! AIPOMM pre-ind 287 m_allaer_pi(:,:,id_STRAT_phy) = 0.0 288 289 ! 290 ! Calculate the total mass of all soluble aersosols 291 ! to be revisited for AR6 292 mass_solu_aero(:,:) = sulfacc(:,:) + bcsol(:,:) + pomsol(:,:) + nitracc(:,:) ! + & 293 ! sscoarse(:,:) + ssacu(:,:) + sssupco(:,:) 294 mass_solu_aero_pi(:,:) = sulfacc_pi(:,:) + bcsol_pi(:,:) + pomsol_pi(:,:) + nitracc_pi(:,:) ! + & 295 ! sscoarse_pi(:,:) + ssacu_pi(:,:) + sssupco_pi(:,:) 296 297 !**************************************************************************************** 298 ! 2) Calculate optical properties for the aerosols 299 ! 300 !**************************************************************************************** 184 301 DO k = 1, klev 185 302 DO i = 1, klon … … 188 305 END DO 189 306 307 ! aeropt_6bands for rrtm 190 308 CALL aeropt_6bands_rrtm( & 191 pdel, m_allaer, pdtphys, rhcl, & 192 tau_aero, piz_aero, cg_aero, & 193 m_allaer_pi, flag_aerosol, & 194 pplay, t_seri, presnivs) 195 196 ! aeropt_5wv only for validation and diagnostics. 197 CALL aeropt_5wv_rrtm( & 198 pdel, m_allaer, & 199 pdtphys, rhcl, aerindex, & 200 flag_aerosol, pplay, t_seri, & 201 tausum_aero, tau3d_aero ) 202 203 ! Diagnostics calculation for CMIP5 protocol 204 sconcso4(:)=m_allaer(:,1,id_ASSO4M)*1.e-9 205 sconcoa(:)=(m_allaer(:,1,id_ASPOMM)+m_allaer(:,1,id_AIPOMM))*1.e-9 206 sconcbc(:)=(m_allaer(:,1,id_ASBCM)+m_allaer(:,1,id_AIBCM))*1.e-9 207 sconcss(:)=(m_allaer(:,1,id_ASSSM)+m_allaer(:,1,id_CSSSM)+m_allaer(:,1,id_SSSSM))*1.e-9 208 sconcdust(:)=m_allaer(:,1,id_CIDUSTM)*1.e-9 209 concso4(:,:)=m_allaer(:,:,id_ASSO4M)*1.e-9 210 concoa(:,:)=(m_allaer(:,:,id_ASPOMM)+m_allaer(:,:,id_AIPOMM))*1.e-9 211 concbc(:,:)=(m_allaer(:,:,id_ASBCM)+m_allaer(:,:,id_AIBCM))*1.e-9 212 concss(:,:)=(m_allaer(:,:,id_ASSSM)+m_allaer(:,:,id_CSSSM)+m_allaer(:,:,id_SSSSM))*1.e-9 213 concdust(:,:)=m_allaer(:,:,id_CIDUSTM)*1.e-9 309 pdel, m_allaer, pdtphys, rhcl, & 310 tau_aero, piz_aero, cg_aero, & 311 m_allaer_pi, flag_aerosol, & 312 zrho ) 313 314 ! aeropt_5wv only for validation and diagnostics 315 CALL aeropt_5wv_rrtm( & 316 pdel, m_allaer, & 317 pdtphys, rhcl, aerindex, & 318 flag_aerosol, pplay, t_seri, & 319 tausum_aero, tau3d_aero ) 320 321 ! Diagnostics calculation for CMIP5 protocol 322 sconcso4(:) =m_allaer(:,1,id_ASSO4M_phy)*1.e-9 323 sconcno3(:) =(m_allaer(:,1,id_ASNO3M_phy)+m_allaer(:,1,id_CSNO3M_phy)+m_allaer(:,1,id_CINO3M_phy))*1.e-9 324 sconcoa(:) =(m_allaer(:,1,id_ASPOMM_phy)+m_allaer(:,1,id_AIPOMM_phy))*1.e-9 325 sconcbc(:) =(m_allaer(:,1,id_ASBCM_phy)+m_allaer(:,1,id_AIBCM_phy))*1.e-9 326 sconcss(:) =(m_allaer(:,1,id_ASSSM_phy)+m_allaer(:,1,id_CSSSM_phy)+m_allaer(:,1,id_SSSSM_phy))*1.e-9 327 sconcdust(:) =m_allaer(:,1,id_CIDUSTM_phy)*1.e-9 328 concso4(:,:) =m_allaer(:,:,id_ASSO4M_phy)*1.e-9 329 concno3(:,:) =(m_allaer(:,:,id_ASNO3M_phy)+m_allaer(:,:,id_CSNO3M_phy)+m_allaer(:,:,id_CINO3M_phy))*1.e-9 330 concoa(:,:) =(m_allaer(:,:,id_ASPOMM_phy)+m_allaer(:,:,id_AIPOMM_phy))*1.e-9 331 concbc(:,:) =(m_allaer(:,:,id_ASBCM_phy)+m_allaer(:,:,id_AIBCM_phy))*1.e-9 332 concss(:,:) =(m_allaer(:,:,id_ASSSM_phy)+m_allaer(:,:,id_CSSSM_phy)+m_allaer(:,:,id_SSSSM_phy))*1.e-9 333 concdust(:,:)=m_allaer(:,:,id_CIDUSTM_phy)*1.e-9 214 334 215 335 END SUBROUTINE readaerosol_optic_rrtm -
LMDZ5/trunk/libf/phylmd/rrtm/readaerosolstrato_rrtm.F90
r2058 r2146 16 16 USE aero_mod 17 17 USE dimphy 18 USE YOERAD , ONLY : NLW 18 19 19 20 implicit none 20 21 22 include "YOMCST.h" 21 23 include "dimensions.h" 22 24 … … 33 35 real, pointer:: time(:) 34 36 real, pointer:: lev(:) 35 integer k, band, wave 37 integer k, band, wave, i 36 38 integer, save :: mth_pre 37 39 … … 45 47 real, allocatable:: tauaerstrat_mois_glo_bands(:,:,:) 46 48 49 real, allocatable:: sum_tau_aer_strat(:) 50 47 51 ! For NetCDF: 48 52 integer ncid_in ! IDs for input files … … 50 54 51 55 ! Stratospheric aerosols optical properties 52 ! alpha_strat over the 2 bands is normalised by the 550 nm extinction coefficient 53 ! alpha_strat_wave is *not* normalised by the 550 nm extinction coefficient 54 real, dimension(nbands_rrtm) :: alpha_strat, piz_strat, cg_strat 55 data alpha_strat/0.938538969, 0.990073204, 0.992904723, 0.829215884, 0.439313501, 0.156857833/ 56 data cg_strat /0.699142992, 0.716326416, 0.735462785, 0.736726701, 0.712068975, 0.575097859/ 57 data piz_strat /1.000000000, 1.000000000, 1.000000000, 1.000000000, 0.997781098, 0.452584684/ 58 real, dimension(nwave) :: alpha_strat_wave 59 data alpha_strat_wave/3.36780953,3.34667683,3.20444202,3.0293026,2.82108808/ 60 56 ! alpha_sw_strat over the 6 bands is normalised by the 550 nm extinction coefficient 57 real, dimension(nbands_sw_rrtm) :: alpha_sw_strat, piz_sw_strat, cg_sw_strat 58 data alpha_sw_strat/0.8545564, 0.8451642, 0.9821724, 0.8145110, 0.3073565, 7.7966176E-02/ 59 data cg_sw_strat /0.6997170, 0.6810035, 0.7403592, 0.7562674, 0.6676504, 0.3478689/ 60 data piz_sw_strat /0.9999998, 0.9999998, 1.000000000, 0.9999958, 0.9977155, 0.4510679/ 61 ! 62 !--diagnostics AOD in the SW 63 ! alpha_sw_strat_wave is *not* normalised by the 550 nm extinction coefficient 64 real, dimension(nwave) :: alpha_sw_strat_wave 65 data alpha_sw_strat_wave/3.708007,4.125824,4.136584,3.887478,3.507738/ 66 ! 67 !--diagnostics AOD in the LW at 10 um 68 real :: alpha_lw_strat_wave 69 data alpha_lw_strat_wave/0.2746812/ 70 ! 71 real, dimension(nbands_lw_rrtm) :: alpha_lw_abs_rrtm 72 data alpha_lw_abs_rrtm/ 8.8340312E-02, 6.9856711E-02, 6.2652975E-02, 5.7188231E-02, & 73 6.3157059E-02, 5.5072524E-02, 5.0571125E-02, 0.1349073, & 74 0.1381676, 9.6506312E-02, 5.1312990E-02, 2.4256418E-02, & 75 2.7191756E-02, 3.3862915E-02, 1.6132960E-02, 1.4275438E-02/ ! calculated with Mie_SW_LW_RRTM_V2.4 (bimodal, corrected) 76 ! for r_0=/0.13E-6, 0.41E-6/ m, sigma_g=/1.26, 1.30/ 77 ! order: increasing wavelength! 61 78 !-------------------------------------------------------- 62 79 63 80 IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon,klev)) 81 IF (.not.ALLOCATED(sum_tau_aer_strat)) ALLOCATE(sum_tau_aer_strat(klon)) 64 82 65 83 IF (is_mpi_root) THEN … … 67 85 IF (debut.OR.mth_cur.NE.mth_pre) THEN 68 86 69 IF (nbands_ rrtm.NE.6) THEN70 print *,'nbands_ rrtm doit etre egal a 6 dans readaerosolstrat_rrtm'87 IF (nbands_sw_rrtm.NE.6) THEN 88 print *,'nbands_sw_rrtm doit etre egal a 6 dans readaerosolstrat_rrtm' 71 89 STOP 72 90 ENDIF … … 112 130 ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev)) 113 131 ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev)) 114 ALLOCATE(tauaerstrat_mois_glo_bands(klon_glo, n_lev,nbands_ rrtm))132 ALLOCATE(tauaerstrat_mois_glo_bands(klon_glo, n_lev,nbands_sw_rrtm)) 115 133 116 134 !--reading stratospheric AOD at 550 nm … … 143 161 ENDIF !--is_mpi_root 144 162 145 !--total vertical aod at the 5 wavelengths163 !--total vertical aod at the 5 SW wavelengths 146 164 DO wave=1, nwave 147 165 DO k=1, klev 148 tausum_aero(:,wave,id_ strat)=tausum_aero(:,wave,id_strat)+tau_aer_strat(:,k)*alpha_strat_wave(wave)/alpha_strat_wave(2)166 tausum_aero(:,wave,id_STRAT_phy)=tausum_aero(:,wave,id_STRAT_phy)+tau_aer_strat(:,k)*alpha_sw_strat_wave(wave)/alpha_sw_strat_wave(2) 149 167 ENDDO 150 168 ENDDO 151 169 152 170 !--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones 153 DO band=1, nbands_rrtm 154 !--anthropogenic aerosols bands 1 to nbands_rrtm 155 cg_aero_rrtm(:,:,2,band) = ( cg_aero_rrtm(:,:,2,band)*piz_aero_rrtm(:,:,2,band)*tau_aero_rrtm(:,:,2,band) + & 156 cg_strat(band)*piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / & 157 MAX( piz_aero_rrtm(:,:,2,band)*tau_aero_rrtm(:,:,2,band) + & 158 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 ) 159 piz_aero_rrtm(:,:,2,band) = ( piz_aero_rrtm(:,:,2,band)*tau_aero_rrtm(:,:,2,band) + & 160 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / & 161 MAX( tau_aero_rrtm(:,:,2,band) + alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 ) 162 tau_aero_rrtm(:,:,2,band) = tau_aero_rrtm(:,:,2,band) + alpha_strat(band)*tau_aer_strat(:,:) 163 !--natural aerosols bands 1 to nbands_rrtm 164 cg_aero_rrtm(:,:,1,band) = ( cg_aero_rrtm(:,:,1,band)*piz_aero_rrtm(:,:,1,band)*tau_aero_rrtm(:,:,1,band) + & 165 cg_strat(band)*piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / & 166 MAX( piz_aero_rrtm(:,:,1,band)*tau_aero_rrtm(:,:,1,band) + & 167 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:), 1.e-15 ) 168 piz_aero_rrtm(:,:,1,band) = ( piz_aero_rrtm(:,:,1,band)*tau_aero_rrtm(:,:,1,band) + & 169 piz_strat(band)*alpha_strat(band)*tau_aer_strat(:,:) ) / & 170 MAX( tau_aero_rrtm(:,:,1,band) + alpha_strat(band)*tau_aer_strat(:,:),1.e-15 ) 171 tau_aero_rrtm(:,:,1,band) = tau_aero_rrtm(:,:,1,band) + alpha_strat(band)*tau_aer_strat(:,:) 171 DO band=1, nbands_sw_rrtm 172 !--anthropogenic aerosols bands 1 to nbands_sw_rrtm 173 cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & 174 cg_sw_strat(band)*piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) / & 175 MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & 176 piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:), 1.e-15 ) 177 piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & 178 piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) / & 179 MAX( tau_aero_sw_rrtm(:,:,2,band) + alpha_sw_strat(band)*tau_aer_strat(:,:), 1.e-15 ) 180 tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + alpha_sw_strat(band)*tau_aer_strat(:,:) 181 !--natural aerosols bands 1 to nbands_sw_rrtm 182 cg_aero_sw_rrtm(:,:,1,band) = ( cg_aero_sw_rrtm(:,:,1,band)*piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & 183 cg_sw_strat(band)*piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) / & 184 MAX( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & 185 piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:), 1.e-15 ) 186 piz_aero_sw_rrtm(:,:,1,band) = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & 187 piz_sw_strat(band)*alpha_sw_strat(band)*tau_aer_strat(:,:) ) / & 188 MAX( tau_aero_sw_rrtm(:,:,1,band) + alpha_sw_strat(band)*tau_aer_strat(:,:),1.e-15 ) 189 tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) + alpha_sw_strat(band)*tau_aer_strat(:,:) 190 !--no stratospheric aerosol in index 1 for these tests 191 ! cg_aero_sw_rrtm(:,:,1,band) = cg_aero_sw_rrtm(:,:,1,band) 192 ! piz_aero_sw_rrtm(:,:,1,band) = piz_aero_sw_rrtm(:,:,1,band) 193 ! tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) 194 ENDDO 195 196 !--stratospheric AOD in LW 197 IF (nbands_lw_rrtm .NE. NLW) then 198 print*, 'different values for NLW (=',NLW,') and nbands_lw_rrtm (=', nbands_lw_rrtm, ')' 199 STOP 200 ENDIF 201 202 DO band=1, nbands_lw_rrtm 203 tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + alpha_lw_abs_rrtm(band)*tau_aer_strat(:,:) 204 tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,1,band) + alpha_lw_abs_rrtm(band)*tau_aer_strat(:,:) 205 !--no stratospheric aerosols in index 1 for these tests 206 ! tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,1,band) 172 207 ENDDO 173 208 -
LMDZ5/trunk/libf/phylmd/rrtm/recmwf_aero.F90
r2005 r2146 20 20 & PPIZA_NAT,PCGA_NAT,PTAU_NAT, & 21 21 !--fin OB 22 !--C.Kleinschmitt 23 & PTAU_LW_TOT, PTAU_LW_NAT, & 24 !--end 22 25 & PFLUX,PFLUC,& 23 26 & PFSDN ,PFSUP , PFSCDN , PFSCUP,& … … 27 30 & PTOPSWAIAERO,PSOLSWAIAERO,& 28 31 & PTOPSWCFAERO,PSOLSWCFAERO,& 32 !--LW diagnostics CK 33 & PTOPLWADAERO,PSOLLWADAERO,& 34 & PTOPLWAD0AERO,PSOLLWAD0AERO,& 35 & PTOPLWAIAERO,PSOLLWAIAERO,& 36 !..end 29 37 & ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) 30 38 !--fin … … 79 87 ! PCGA_NAT : (KPROMA,KLEV,NSW); Assymetry factor for natural aerosol 80 88 ! PTAU_NAT: (KPROMA,KLEV,NSW) ; Optical depth of natural aerosol 89 ! PTAU_LW_TOT (KPROMA,KLEV,NLW); LW Optical depth of total aerosols 90 ! PTAU_LW_NAT (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols 81 91 !--fin OB 82 92 … … 136 146 USE YOMCST , ONLY : RMD ,RMO3 137 147 USE YOMPHY3 , ONLY : RII0 148 USE YOERAD , ONLY : NLW, NAER, RCCNLND ,RCCNSEA 138 149 USE YOERAD , ONLY : NAER, RCCNLND ,RCCNSEA 139 150 USE YOERDU , ONLY : REPSCQ … … 150 161 IMPLICIT NONE 151 162 INCLUDE "clesphys.h" 163 152 164 153 165 INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA … … 186 198 REAL(KIND=JPRB) :: PTAU_ZERO(KPROMA,KLEV,NSW) 187 199 !--fin 200 !--C.Kleinschmitt 201 REAL(KIND=JPRB) :: PTAU_LW_ZERO(KPROMA,KLEV,NLW) 202 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_TOT(KPROMA,KLEV,NLW) 203 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_NAT(KPROMA,KLEV,NLW) 204 !--end 188 205 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(KPROMA,KLEV) 189 206 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(KPROMA,KLEV) … … 199 216 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWCFAERO(KPROMA,3), PSOLSWCFAERO(KPROMA,3) !--do we keep this ? 200 217 !--fin 218 !--CK 219 REAL(KIND=JPRB) ,INTENT(out) :: PTOPLWADAERO(KPROMA), PSOLLWADAERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface 220 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAD0AERO(KPROMA), PSOLLWAD0AERO(KPROMA) ! LW Aerosol direct forcing at TOA + surface 221 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAIAERO(KPROMA), PSOLLWAIAERO(KPROMA) ! LW Aer. indirect forcing at TOA + surface 222 !--end 201 223 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTD(KPROMA,KLEV+1) 202 224 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTU(KPROMA,KLEV+1) … … 295 317 REAL(KIND=JPRB) :: ZFSUP0_AERO(KPROMA,KLEV+1,5) 296 318 REAL(KIND=JPRB) :: ZFSDN0_AERO(KPROMA,KLEV+1,5) 319 !--LW (CK): 320 REAL(KIND=JPRB) :: LWUP_AERO(KPROMA,KLEV+1,5) 321 REAL(KIND=JPRB) :: LWDN_AERO(KPROMA,KLEV+1,5) 322 REAL(KIND=JPRB) :: LWUP0_AERO(KPROMA,KLEV+1,5) 323 REAL(KIND=JPRB) :: LWDN0_AERO(KPROMA,KLEV+1,5) 297 324 298 325 #include "radlsw.intfb.h" … … 313 340 ZFSDN0_AERO(:,:,:)=0. 314 341 342 LWUP_AERO (:,:,:)=0. 343 LWDN_AERO (:,:,:)=0. 344 LWUP0_AERO(:,:,:)=0. 345 LWDN0_AERO(:,:,:)=0. 346 315 347 PTAU_ZERO(:,:,:) =1.e-15 316 348 PPIZA_ZERO(:,:,:)=1.0 317 349 PCGA_ZERO(:,:,:) =0.0 350 351 PTAU_LW_ZERO(:,:,:) =1.e-15 318 352 319 353 … … 431 465 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 432 466 & PSFSWDIF,PFSDNN, PFSDNV ,& 433 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,P FLUX,PFLUC,&467 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,& 434 468 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 435 469 … … 440 474 ZFSUP_AERO(:,:,1) = PFSUP(:,:) 441 475 ZFSDN_AERO(:,:,1) = PFSDN(:,:) 476 477 LWUP0_AERO(:,:,1) = PFLUC(:,1,:) 478 LWDN0_AERO(:,:,1) = PFLUC(:,2,:) 479 480 LWUP_AERO(:,:,1) = PFLUX(:,1,:) 481 LWDN_AERO(:,:,1) = PFLUX(:,2,:) 442 482 443 483 ENDIF … … 463 503 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 464 504 & PSFSWDIF,PFSDNN, PFSDNV ,& 465 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,P FLUX,PFLUC,&505 & LRDUST,PPIZA_NAT,PCGA_NAT,PTAU_NAT,PTAU_LW_NAT,PFLUX,PFLUC,& 466 506 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 467 507 … … 472 512 ZFSUP_AERO(:,:,2) = PFSUP(:,:) 473 513 ZFSDN_AERO(:,:,2) = PFSDN(:,:) 514 515 LWUP0_AERO(:,:,2) = PFLUC(:,1,:) 516 LWDN0_AERO(:,:,2) = PFLUC(:,2,:) 517 518 LWUP_AERO(:,:,2) = PFLUX(:,1,:) 519 LWDN_AERO(:,:,2) = PFLUX(:,2,:) 474 520 475 521 ENDIF ! ok_aie … … 495 541 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 496 542 & PSFSWDIF,PFSDNN, PFSDNV ,& 497 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,P FLUX,PFLUC,&543 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,& 498 544 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 499 545 … … 504 550 ZFSUP_AERO(:,:,3) = PFSUP(:,:) 505 551 ZFSDN_AERO(:,:,3) = PFSDN(:,:) 552 553 LWUP0_AERO(:,:,3) = PFLUC(:,1,:) 554 LWDN0_AERO(:,:,3) = PFLUC(:,2,:) 555 556 LWUP_AERO(:,:,3) = PFLUX(:,1,:) 557 LWDN_AERO(:,:,3) = PFLUX(:,2,:) 506 558 507 559 ENDIF !-end ok_ade … … 527 579 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 528 580 & PSFSWDIF,PFSDNN, PFSDNV ,& 529 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,P FLUX,PFLUC,&581 & LRDUST,PPIZA_TOT,PCGA_TOT,PTAU_TOT,PTAU_LW_TOT,PFLUX,PFLUC,& 530 582 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 531 583 … … 536 588 ZFSUP_AERO(:,:,4) = PFSUP(:,:) 537 589 ZFSDN_AERO(:,:,4) = PFSDN(:,:) 590 591 LWUP0_AERO(:,:,4) = PFLUC(:,1,:) 592 LWDN0_AERO(:,:,4) = PFLUC(:,2,:) 593 594 LWUP_AERO(:,:,4) = PFLUX(:,1,:) 595 LWDN_AERO(:,:,4) = PFLUX(:,2,:) 538 596 539 597 ENDIF ! ok_ade .and. ok_aie … … 563 621 & ZFRSOD, ZSUDU , ZUVDF , ZPARF , ZPARCF, ZTINCF, PSFSWDIR,& 564 622 & PSFSWDIF,PFSDNN, PFSDNV ,& 565 & LRDUST,PPIZA_ZERO,PCGA_ZERO,PTAU_ZERO, PFLUX,PFLUC,&623 & LRDUST,PPIZA_ZERO,PCGA_ZERO,PTAU_ZERO, PTAU_LW_ZERO,PFLUX,PFLUC,& 566 624 & PFSDN , PFSUP , PFSCDN , PFSCUP ) 567 625 … … 572 630 ZFSUP_AERO(:,:,5) = PFSUP(:,:) 573 631 ZFSDN_AERO(:,:,5) = PFSDN(:,:) 632 633 LWUP0_AERO(:,:,5) = PFLUC(:,1,:) 634 LWDN0_AERO(:,:,5) = PFLUC(:,2,:) 635 636 LWUP_AERO(:,:,5) = PFLUX(:,1,:) 637 LWDN_AERO(:,:,5) = PFLUX(:,2,:) 574 638 575 639 ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE … … 643 707 PFSCUP(:,:) = ZFSUP0_AERO(:,:,4) 644 708 PFSCDN(:,:) = ZFSDN0_AERO(:,:,4) 709 710 PFLUX(:,1,:) = LWUP_AERO(:,:,4) 711 PFLUX(:,2,:) = LWDN_AERO(:,:,4) 712 PFLUC(:,1,:) = LWUP0_AERO(:,:,4) 713 PFLUC(:,2,:) = LWDN0_AERO(:,:,4) 645 714 ENDIF 646 715 … … 650 719 PFSCUP(:,:) = ZFSUP0_AERO(:,:,3) 651 720 PFSCDN(:,:) = ZFSDN0_AERO(:,:,3) 721 722 PFLUX(:,1,:) = LWUP_AERO(:,:,3) 723 PFLUX(:,2,:) = LWDN_AERO(:,:,3) 724 PFLUC(:,1,:) = LWUP0_AERO(:,:,3) 725 PFLUC(:,2,:) = LWDN0_AERO(:,:,3) 652 726 ENDIF 653 727 … … 657 731 PFSCUP(:,:) = ZFSUP0_AERO(:,:,2) 658 732 PFSCDN(:,:) = ZFSDN0_AERO(:,:,2) 733 734 PFLUX(:,1,:) = LWUP_AERO(:,:,2) 735 PFLUX(:,2,:) = LWDN_AERO(:,:,2) 736 PFLUC(:,1,:) = LWUP0_AERO(:,:,2) 737 PFLUC(:,2,:) = LWDN0_AERO(:,:,2) 659 738 ENDiF 660 739 … … 664 743 PFSCUP(:,:) = ZFSUP0_AERO(:,:,1) 665 744 PFSCDN(:,:) = ZFSDN0_AERO(:,:,1) 745 746 PFLUX(:,1,:) = LWUP_AERO(:,:,1) 747 PFLUX(:,2,:) = LWDN_AERO(:,:,1) 748 PFLUC(:,1,:) = LWUP0_AERO(:,:,1) 749 PFLUC(:,2,:) = LWDN0_AERO(:,:,1) 666 750 ENDIF 667 751 … … 677 761 PFSCDN(:,:) = ZFSDN0_AERO(:,:,5) 678 762 763 PFLUX(:,1,:) = LWUP_AERO(:,:,5) 764 PFLUX(:,2,:) = LWDN_AERO(:,:,5) 765 PFLUC(:,1,:) = LWUP0_AERO(:,:,5) 766 PFLUC(:,2,:) = LWDN0_AERO(:,:,5) 767 679 768 ENDIF 680 769 … … 683 772 ! requires a natural aerosol field read and used 684 773 ! Difference of net fluxes from double call to radiation 685 ! Will need to be extended to LW radiation 774 ! Will need to be extended to LW radiation -> done by CK (2014-05-23) 686 775 687 776 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN … … 709 798 PTOPSWCFAERO(:,3) = 0.0 710 799 800 ! LW direct anthropogenic forcing 801 PSOLLWADAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2)) 802 PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,4) -LWUP_AERO(:,KLEV+1,4)) -(-LWDN_AERO(:,KLEV+1,2) -LWUP_AERO(:,KLEV+1,2)) 803 PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,4) -LWUP0_AERO(:,1,4)) -(-LWDN0_AERO(:,1,2) -LWUP0_AERO(:,1,2)) 804 PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,4)-LWUP0_AERO(:,KLEV+1,4))-(-LWDN0_AERO(:,KLEV+1,2)-LWUP0_AERO(:,KLEV+1,2)) 805 806 ! LW indirect anthropogenic forcing 807 PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,4) -LWUP_AERO(:,1,4)) -(-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3)) 808 PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,4)-LWUP_AERO(:,KLEV+1,4))-(-LWDN_AERO(:,KLEV+1,3)-LWUP_AERO(:,KLEV+1,3)) 809 711 810 ENDIF 712 811 … … 733 832 PTOPSWCFAERO(:,3) = 0.0 734 833 834 ! LW direct anthropogenic forcing 835 PSOLLWADAERO(:) = (-LWDN_AERO(:,1,3) -LWUP_AERO(:,1,3)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1)) 836 PTOPLWADAERO(:) = (-LWDN_AERO(:,KLEV+1,3) -LWUP_AERO(:,KLEV+1,3)) -(-LWDN_AERO(:,KLEV+1,1) -LWUP_AERO(:,KLEV+1,1)) 837 PSOLLWAD0AERO(:) = (-LWDN0_AERO(:,1,3) -LWUP0_AERO(:,1,3)) -(-LWDN0_AERO(:,1,1) -LWUP0_AERO(:,1,1)) 838 PTOPLWAD0AERO(:) = (-LWDN0_AERO(:,KLEV+1,3)-LWUP0_AERO(:,KLEV+1,3))-(-LWDN0_AERO(:,KLEV+1,1)-LWUP0_AERO(:,KLEV+1,1)) 839 840 ! LW indirect anthropogenic forcing 841 PSOLLWAIAERO(:) = 0.0 842 PTOPLWAIAERO(:) = 0.0 843 735 844 ENDIF 736 845 … … 757 866 PTOPSWCFAERO(:,3) = 0.0 758 867 868 ! LW direct anthropogenic forcing 869 PSOLLWADAERO(:) = 0.0 870 PTOPLWADAERO(:) = 0.0 871 PSOLLWAD0AERO(:) = 0.0 872 PTOPLWAD0AERO(:) = 0.0 873 874 ! LW indirect anthropogenic forcing 875 PSOLLWAIAERO(:) = (-LWDN_AERO(:,1,2) -LWUP_AERO(:,1,2)) -(-LWDN_AERO(:,1,1) -LWUP_AERO(:,1,1)) 876 PTOPLWAIAERO(:) = (-LWDN_AERO(:,KLEV+1,2)-LWUP_AERO(:,KLEV+1,2))-(-LWDN_AERO(:,KLEV+1,1)-LWUP_AERO(:,KLEV+1,1)) 877 759 878 ENDIF 760 879 … … 781 900 PTOPSWCFAERO(:,3) = 0.0 782 901 902 ! LW direct anthropogenic forcing 903 PSOLLWADAERO(:) = 0.0 904 PTOPLWADAERO(:) = 0.0 905 PSOLLWAD0AERO(:) = 0.0 906 PTOPLWAD0AERO(:) = 0.0 907 908 ! LW indirect anthropogenic forcing 909 PSOLLWAIAERO(:) = 0.0 910 PTOPLWAIAERO(:) = 0.0 911 783 912 ENDIF 784 913 … … 790 919 PSOLSWCFAERO(:,3) = (ZFSDN_AERO(:,1,5) -ZFSUP_AERO(:,1,5)) -(ZFSDN0_AERO(:,1,5) -ZFSUP0_AERO(:,1,5)) 791 920 PTOPSWCFAERO(:,3) = (ZFSDN_AERO(:,KLEV+1,5)-ZFSUP_AERO(:,KLEV+1,5))-(ZFSDN0_AERO(:,KLEV+1,5)-ZFSUP0_AERO(:,KLEV+1,5)) 921 792 922 ENDIF 793 923 -
LMDZ5/trunk/libf/phylmd/rrtm/rrtm_ecrt_140gp.F90
r2027 r2146 10 10 & P_ZEMIS, P_ZEMIW,& 11 11 & pq , pcco2, pozn, pcldf, ptaucld, ptclear,& 12 & P_CLDFRAC,P_TAUCLD,P_COLDRY,P_WKL,P_WX,& 13 & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT) 12 & P_CLDFRAC,P_TAUCLD,& 13 & PTAU_LW,& 14 & P_COLDRY,P_WKL,P_WX,& 15 & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT ) 14 16 15 17 ! Reformatted for F90 by JJMorcrette, ECMWF, 980714 … … 28 30 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPLAY ,& 29 31 & JPINPX 30 USE YOERAD , ONLY : N OVLP31 !USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC1232 USE YOERAD , ONLY : NLW ,NOVLP 33 USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC12 32 34 USE YOESW , ONLY : RAER 33 35 34 36 !------------------------------Arguments-------------------------------- 35 37 36 37 38 38 IMPLICIT NONE 39 39 40 #include "clesphys.h" 40 41 41 INTEGER(KIND=JPIM),INTENT(IN) :: KLON! Number of atmospheres (longitudes) 42 42 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV! Number of atmospheric layers … … 56 56 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV) ! Cloud fraction 57 57 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND) ! Cloud optical depth 58 !--C.Kleinschmitt 59 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols 60 !--end 58 61 REAL(KIND=JPRB) ,INTENT(OUT) :: PTCLEAR 59 62 REAL(KIND=JPRB) ,INTENT(OUT) :: P_CLDFRAC(JPLAY) ! Cloud fraction … … 258 261 P_TAUAERL(I_L,16)=ZTAUAER(5) 259 262 ENDDO 263 !--Use LW AOD from own Mie calculations (C. Kleinschmitt) 264 DO I_L=1,KLEV 265 JK=KLEV-I_L+1 266 ! DO JAE=1, NLW 267 DO JAE=1, 16 268 P_TAUAERL(I_L,JAE) = MAX( PTAU_LW(K_IPLON, JK, JAE), 1e-30 ) 269 ENDDO 270 ENDDO 271 !--end C. Kleinschmitt 260 272 261 273 DO J2=1,KLEV … … 390 402 ! ------------------------------------------------------------------ 391 403 392 393 394 404 IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP',1,ZHOOK_HANDLE) 395 405 END SUBROUTINE RRTM_ECRT_140GP -
LMDZ5/trunk/libf/phylmd/rrtm/rrtm_ecrt_140gp.intfb.h
r1990 r2146 1 INTERFACE 2 SUBROUTINE RRTM_ECRT_140GP &1 INTERFACE 2 SUBROUTINE RRTM_ECRT_140GP & 3 3 & ( K_IPLON, klon , klev, kcld,& 4 4 & paer , paph , pap,& 5 & pts , pth, pt,&5 & pts , pth , pt,& 6 6 & P_ZEMIS, P_ZEMIW,& 7 & pq , pcco2, pozn, pcldf, ptaucld, ptclear,& 8 & P_CLDFRAC,P_TAUCLD,P_COLDRY,P_WKL,P_WX,& 9 & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT) 10 USE PARKIND1 ,ONLY : JPIM ,JPRB 11 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPLAY ,& 12 & JPINPX 7 & pq , pcco2, pozn, pcldf, ptaucld, ptclear,& 8 & P_CLDFRAC,P_TAUCLD,& 9 & PTAU_LW,& 10 & P_COLDRY,P_WKL,P_WX,& 11 & P_TAUAERL,PAVEL,P_TAVEL,PZ,P_TZ,P_TBOUND,K_NLAYERS,P_SEMISS,K_IREFLECT ) 12 USE PARKIND1 ,ONLY : JPIM ,JPRB 13 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPLAY ,& 14 & JPINPX 15 USE YOERAD , ONLY : NLW ,NOVLP 16 USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC12 17 USE YOESW , ONLY : RAER 13 18 INTEGER(KIND=JPIM),INTENT(IN) :: KLON 14 19 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV … … 28 33 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV) 29 34 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND) 35 !--C.Kleinschmitt 36 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols 37 !--end 30 38 REAL(KIND=JPRB) ,INTENT(OUT) :: PTCLEAR 31 39 REAL(KIND=JPRB) ,INTENT(OUT) :: P_CLDFRAC(JPLAY) -
LMDZ5/trunk/libf/phylmd/rrtm/rrtm_rrtm_140gp.F90
r1990 r2146 40 40 & PQ , PCCO2 , POZN,& 41 41 & PCLDF , PTAUCLD,& 42 & PTAU_LW,& 42 43 & PEMIT , PFLUX , PFLUC, PTCLEAR & 43 44 & ) … … 55 56 USE PARKIND1 ,ONLY : JPIM ,JPRB 56 57 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 57 58 USE YOERAD ,ONLY : NLW 58 59 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPGPT ,JPLAY ,& 59 60 & JPINPX … … 80 81 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV) ! Cloud fraction 81 82 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND) ! Cloud optical depth 83 !--C.Kleinschmitt 84 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols 85 !--end 82 86 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) ! Surface LW emissivity 83 87 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down) … … 204 208 & P_ZEMIS, P_ZEMIW,& 205 209 & pq , pcco2, pozn, pcldf, ptaucld, ztclear,& 206 & Z_CLDFRAC,Z_TAUCLD,Z_COLDRY,Z_WKL,Z_WX,& 210 & Z_CLDFRAC,Z_TAUCLD,& 211 & PTAU_LW,& 212 & Z_COLDRY,Z_WKL,Z_WX,& 207 213 & Z_TAUAERL,Z_PAVEL,Z_TAVEL,Z_PZ,Z_TZ,Z_TBOUND,I_NLAYERS,Z_SEMISS,IREFLECT) 208 214 -
LMDZ5/trunk/libf/phylmd/rrtm/rrtm_rrtm_140gp.intfb.h
r1990 r2146 1 1 INTERFACE 2 SUBROUTINE RRTM_RRTM_140GP &2 SUBROUTINE RRTM_RRTM_140GP & 3 3 & ( KIDIA , KFDIA , KLON , KLEV,& 4 & PAER , PAPH, PAP,&5 & PTS , PTH, PT,&4 & PAER , PAPH , PAP,& 5 & PTS , PTH , PT,& 6 6 & P_ZEMIS , P_ZEMIW,& 7 & PQ , PCCO2 , POZN,&7 & PQ , PCCO2 , POZN,& 8 8 & PCLDF , PTAUCLD,& 9 & P EMIT , PFLUX , PFLUC, PTCLEAR&10 & )9 & PTAU_LW,& 10 & PEMIT , PFLUX , PFLUC, PTCLEAR ) 11 11 USE PARKIND1 ,ONLY : JPIM ,JPRB 12 USE YOERAD ,ONLY : NLW !--C.Kleinschmitt 12 13 USE PARRRTM , ONLY : JPBAND ,JPXSEC ,JPGPT ,JPLAY ,& 13 & JPINPX 14 & JPINPX 15 !-NLW in clesphys now OB 16 include "clesphys.h" 14 17 INTEGER(KIND=JPIM),INTENT(IN) :: KLON 15 18 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV … … 29 32 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KLEV) 30 33 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,JPBAND) 34 !--C.Kleinschmitt 35 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW(KLON,KLEV,NLW) ! LW Optical depth of aerosols 36 !--end 31 37 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) 32 38 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) -
LMDZ5/trunk/libf/phylmd/tracinca_mod.F90
r1907 r2146 28 28 nstep, julien, gmtime, lafin, & 29 29 pdtphys, t_seri, paprs, pplay, & 30 pmfu, ftsol, pctsrf,pphis, &30 pmfu, upwd, ftsol, pctsrf, pphis, & 31 31 pphi, albsol, sh, rh, & 32 32 cldfra, rneb, diafra, cldliq, & … … 88 88 !Convection: 89 89 !---------- 90 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant 90 REAL,DIMENSION(klon,klev),INTENT(IN) :: pmfu ! flux de masse dans le panache montant - Tiedtke 91 REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! flux de masse dans le panache montant - Emanuel 91 92 92 93 !...Tiedke … … 120 121 INTEGER :: k 121 122 REAL,DIMENSION(klon,klev) :: pdel 123 REAL,DIMENSION(klon,klev) :: zpmfu ! flux de masse dans le panache montant 122 124 REAL :: calday 123 125 INTEGER :: ncsec … … 133 135 END DO 134 136 137 zpmfu(:,:)=pmfu(:,:) 138 135 139 IF (config_inca == 'aero') THEN 136 140 #ifdef INCA … … 138 142 aerosol_couple,tr_seri,pdtphys, & 139 143 pplay,pdel,prfl,pmflxr,psfl, & 140 pmflxs, pmfu,itop_con,ibas_con, &144 pmflxs,zpmfu,itop_con,ibas_con, & 141 145 pphi,airephy,nstep,rneb,t_seri, & 142 146 rh,tau_aero,piz_aero,cg_aero, & … … 144 148 #endif 145 149 END IF 150 151 IF (config_inca == 'aeNP') THEN 152 #ifdef INCA 153 zpmfu(:,:)=upwd(:,:) 154 CALL aerosolmainNP( & 155 aerosol_couple,tr_seri,pdtphys, & 156 pplay,pdel,prfl,pmflxr,psfl, & 157 pmflxs,zpmfu,itop_con,ibas_con, & 158 pphi,airephy,nstep,rneb,t_seri, & 159 rh,lafin) 160 #endif 161 END IF 162 146 163 147 164 #ifdef INCA … … 172 189 psfl, & !flxsst 173 190 pmflxs, & !flxscv 174 pmfu, & !flxupd191 zpmfu, & !flxupd !--now depends on whether AP or NP 175 192 flxmass_w, & !flxmass_w 176 193 t_seri, & !tfld
Note: See TracChangeset
for help on using the changeset viewer.
