Changeset 2634 for LMDZ5/trunk/libf/phylmd/aeropt_5wv.F90
- Timestamp:
- Sep 24, 2016, 7:14:59 PM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/aeropt_5wv.F90
r2550 r2634 13 13 USE phys_local_var_mod, only: od550aer,od865aer,ec550aer,od550lt1aer 14 14 USE pres2lev_mod 15 16 15 17 16 ! … … 66 65 ! Output arguments: 67 66 ! 68 REAL, DIMENSION(klon), INTENT(out) :: ai ! POLDER aerosol index 67 REAL, DIMENSION(klon), INTENT(out) :: ai ! POLDER aerosol index 69 68 REAL, DIMENSION(klon,nwave,naero_tot), INTENT(out) :: tausum 70 69 REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(out) :: tau 71 72 73 70 ! 74 71 ! Local … … 134 131 REAL :: cg_ae5wv_int ! Intermediate asymmetry parameter aerosol 135 132 REAL, PARAMETER :: RH_MAX=95. 136 REAL :: taue670( KLON) ! epaisseur optique aerosol absorption 550 nm137 REAL :: taue865( KLON) ! epaisseur optique aerosol extinction 865 nm133 REAL :: taue670(klon) ! epaisseur optique aerosol absorption 550 nm 134 REAL :: taue865(klon) ! epaisseur optique aerosol extinction 865 nm 138 135 REAL :: fac 139 REAL :: zdp1(klon,klev)140 REAL, PARAMETER :: gravit = 9.80616 ! m2/s141 136 INTEGER, ALLOCATABLE, DIMENSION(:) :: aerosol_name 142 137 INTEGER :: nb_aer 143 138 144 REAL :: tau3d( KLON,KLEV), piz3d(KLON,KLEV), cg3d(KLON,KLEV)145 REAL :: abs3d( KLON,KLEV) ! epaisseur optique d'absorption146 REAL :: dh( KLON,KLEV)139 REAL :: tau3d(klon,klev), piz3d(klon,klev), cg3d(klon,klev) 140 REAL :: abs3d(klon,klev) ! epaisseur optique d'absorption 141 REAL :: dh(klon,klev) 147 142 148 143 REAL :: alpha_aers_5wv(nbre_RH,las,naero_soluble) ! ext. coeff. Soluble comp. units *** m2/g … … 155 150 ! 1- BC soluble; 2- POM soluble; 3- SO4 acc.; 4- SO4 coarse; 5 seasalt super-C; 6 seasalt coarse; 7 seasalt acc. 156 151 REAL :: piz_aeri_5wv(las,naero_insoluble) ! Insoluble comp. 1- Dust: 2- BC; 3- POM 157 158 REAL, DIMENSION(klon,klev,naero_tot) :: mass_temp159 160 152 ! 161 153 ! Proprietes optiques 162 154 ! 163 REAL :: radry = 287.054164 REAL :: tau_tmp ! dry air mass constant165 155 REAL :: fact_RH(nbre_RH) 166 156 LOGICAL :: used_tau(naero_spc) … … 303 293 !********************************************************************* 304 294 ! 305 !306 !307 !308 !309 295 ! 310 296 ! From here on we look at the optical parameters at 5 wavelengths: … … 478 464 0.737,0.750,0.765,0.775,0.787,0.803/ 479 465 ! 480 481 466 DATA cg_aeri_5wv/& 482 467 ! dust insoluble … … 616 601 END IF ! firstcall 617 602 618 619 603 ! Initialisations 620 ai(:) =0.621 tausum(:,:,:) 622 604 tau(:,:,:,:) =0. 605 tausum(:,:,:)= 0. 606 ai(:)=0.0 623 607 624 608 DO k=1, klev 625 609 DO i=1, klon 626 zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3 627 dh(i,k)=pdel(i,k)/(gravit*zrho) 628 mass_temp(i,k,:) = m_allaer(i,k,:) / zrho / 1.e+9 629 zdp1(i,k)=pdel(i,k)/(gravit*delt) ! air mass auxiliary variable --> zdp1 [kg/(m^2 *s)] 630 610 zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3 611 dh(i,k)=pdel(i,k)/(RG*zrho) ! m 631 612 ENDDO 632 613 ENDDO 633 634 614 635 615 IF (flag_aerosol .EQ. 1) THEN … … 680 660 ! compute optical_thickness_at_gridpoint_per_species 681 661 682 683 662 ! 684 663 ! Calculations that need to be done since we are not in the subroutines INCA 685 664 ! 686 665 687 !CDIR ON_ADB(RH_tab)688 !CDIR ON_ADB(fact_RH)689 !CDIR NOVECTOR690 666 DO n=1,nbre_RH-1 691 667 fact_RH(n)=1./(RH_tab(n+1)-RH_tab(n)) 692 668 ENDDO 693 669 694 DO k=1, KLEV 695 !CDIR ON_ADB(RH_tab) 696 !CDIR ON_ADB(fact_RH) 697 DO i=1, KLON 670 DO k=1, klev 671 DO i=1, klon 698 672 rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX) 699 673 RH_num(i,k) = INT( rh(i,k)/10. + 1.) 674 !--test olivier pour pas de reindicage 675 ! RH_num(i,k) =1 700 676 IF (rh(i,k).GT.85.) RH_num(i,k)=10 701 677 IF (rh(i,k).GT.90.) RH_num(i,k)=11 … … 704 680 ENDDO 705 681 706 !CDIR SHORTLOOP707 682 used_tau(:)=.FALSE. 708 683 … … 765 740 DO la=1,las 766 741 742 !--only 550 and 865 nm are used 743 IF (la.NE.la550.AND.la.NE.la865) CYCLE 744 767 745 IF (soluble) THEN 768 746 769 IF ((la.EQ.2).AND.(spss.NE.0)) THEN !la=2 corresponds to 550 nm747 IF ((la.EQ.2).AND.(spss.NE.0)) THEN !la=2 corresponds to 550 nm 770 748 IF (spss.EQ.1) THEN !accumulation mode 771 DO k=1, KLEV 772 !CDIR ON_ADB(A1_ASSSM) 773 !CDIR ON_ADB(A2_ASSSM) 774 !CDIR ON_ADB(A3_ASSSM) 775 DO i=1, KLON 776 H=rh(i,k)/100 749 DO k=1, klev 750 DO i=1, klon 751 H=rh(i,k)/100. 777 752 tau_ae5wv_int=A1_ASSSM(k)+A2_ASSSM(k)*H+A3_ASSSM(k)/(H-1.05) 778 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 779 *tau_ae5wv_int*delt*fac 753 tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac 780 754 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 781 755 ENDDO … … 784 758 785 759 IF (spss.EQ.2) THEN !coarse mode 786 DO k=1, KLEV 787 !CDIR ON_ADB(A1_CSSSM) 788 !CDIR ON_ADB(A2_CSSSM) 789 !CDIR ON_ADB(A3_CSSSM) 790 DO i=1, KLON 791 H=rh(i,k)/100 760 DO k=1, klev 761 DO i=1, klon 762 H=rh(i,k)/100. 792 763 tau_ae5wv_int=A1_CSSSM(k)+A2_CSSSM(k)*H+A3_CSSSM(k)/(H-1.05) 793 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 794 *tau_ae5wv_int*delt*fac 795 tausum(i,la,aerindex) = tausum(i,la,aerindex)+tau(i,k,la,aerindex) 796 ENDDO 797 ENDDO 798 ENDIF 799 800 IF (spss.EQ.3) THEN !super coarse mode 801 DO k=1, KLEV 802 !CDIR ON_ADB(A1_SSSSM) 803 !CDIR ON_ADB(A2_SSSSM) 804 !CDIR ON_ADB(A3_SSSSM) 805 DO i=1, KLON 806 H=rh(i,k)/100 807 tau_ae5wv_int=A1_SSSSM(k)+A2_SSSSM(k)*H+A3_SSSSM(k)/(H-1.05) 808 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 809 *tau_ae5wv_int*delt*fac 764 tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac 810 765 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 811 766 ENDDO … … 813 768 ENDIF 814 769 770 IF (spss.EQ.3) THEN !super coarse mode 771 DO k=1, klev 772 DO i=1, klon 773 H=rh(i,k)/100. 774 tau_ae5wv_int=A1_SSSSM(k)+A2_SSSSM(k)*H+A3_SSSSM(k)/(H-1.05) 775 tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac 776 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 777 ENDDO 778 ENDDO 779 ENDIF 780 815 781 ELSE 816 DO k=1, KLEV 817 !CDIR ON_ADB(alpha_aers_5wv) 818 DO i=1, KLON 782 DO k=1, klev 783 DO i=1, klon 819 784 tau_ae5wv_int = alpha_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* & 820 785 (alpha_aers_5wv(RH_num(i,k)+1,la,spsol) - & 821 786 alpha_aers_5wv(RH_num(i,k),la,spsol)) 822 823 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k) & 824 *tau_ae5wv_int*delt*fac 787 tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac 825 788 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 826 789 ENDDO … … 829 792 830 793 ELSE ! For insoluble aerosol 831 DO k=1, KLEV 832 !CDIR ON_ADB(alpha_aeri_5wv) 833 DO i=1, KLON794 795 DO k=1, klev 796 DO i=1, klon 834 797 tau_ae5wv_int = alpha_aeri_5wv(la,spinsol) 835 tau(i,k,la,aerindex) = mass_temp(i,k,aerindex)*1000.*zdp1(i,k)* & 836 tau_ae5wv_int*delt*fac 837 tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex) 798 tau(i,k,la,aerindex) = m_allaer(i,k,aerindex)/1.e6*dh(i,k)*tau_ae5wv_int*fac 799 tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex) 838 800 ENDDO 839 801 ENDDO 802 840 803 ENDIF 804 841 805 ENDDO ! boucle sur les longueurs d'onde 842 806 ENDDO ! Boucle sur les masses de traceurs … … 845 809 IF (.NOT.used_tau(m)) tau(:,:,:,m)=0. 846 810 ENDDO 847 ! 848 ! 849 ! taue670(:) = SUM(tausum(:,la670,:),dim=2) 850 ! taue865(:) = SUM(tausum(:,la865,:),dim=2) 851 ! 852 ! DO i=1, klon 853 ! ai(i)=-LOG(MAX(taue670(i),0.0001)/ & 854 ! MAX(taue865(i),0.0001))/LOG(670./865.) 855 ! ENDDO 856 857 DO i=1, klon 858 od550aer(i)=0. 859 DO m=1,naero_spc 860 od550aer(i)=od550aer(i)+tausum(i,2,m) 861 ENDDO 862 ENDDO 863 864 DO i=1, klon 865 od865aer(i)=0. 866 DO m=1,naero_spc 867 od865aer(i)=od865aer(i)+tausum(i,5,m) 868 ENDDO 869 ENDDO 870 871 DO i=1, klon 872 DO k=1, KLEV 873 ec550aer(i,k)=0. 874 DO m=1,naero_spc 875 ec550aer(i,k)=ec550aer(i,k)+tau(i,k,2,m)/dh(i,k) 876 ENDDO 877 ENDDO 878 ENDDO 811 812 !--AOD calculations for diagnostics 813 od550aer(:)=SUM(tausum(:,la550,:),dim=2) 814 od865aer(:)=SUM(tausum(:,la865,:),dim=2) 815 816 !--extinction coefficient for diagnostic 817 ec550aer(:,:)=SUM(tau(:,:,la550,:),dim=3)/dh(:,:) 879 818 880 od550lt1aer(:)=tausum(:,2,id_ASSO4M_phy)+tausum(:,2,id_ASBCM_phy)+tausum(:,2,id_AIBCM_phy)+ & 881 tausum(:,2,id_ASPOMM_phy)+tausum(:,2,id_AIPOMM_phy)+tausum(:,2,id_ASSSM_phy)+ & 882 0.03*tausum(:,2,id_CSSSM_phy)+0.4*tausum(:,2,id_CIDUSTM_phy) 819 !--acc mode AOD calculation for diagnostic 820 od550lt1aer(:)=tausum(:,la550,id_ASSO4M_phy)+tausum(:,la550,id_ASBCM_phy)+tausum(:,la550,id_AIBCM_phy)+ & 821 tausum(:,la550,id_ASPOMM_phy)+tausum(:,la550,id_AIPOMM_phy)+tausum(:,la550,id_ASSSM_phy)+ & 822 0.03*tausum(:,la550,id_CSSSM_phy)+0.4*tausum(:,la550,id_CIDUSTM_phy) 883 823 884 824 DEALLOCATE(aerosol_name)
Note: See TracChangeset
for help on using the changeset viewer.