Changeset 5488
- Timestamp:
- Jan 17, 2025, 6:12:48 PM (12 days ago)
- Location:
- LMDZ6/branches/contrails/libf/phylmd
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails/libf/phylmd/lmdz_aviation.f90
r5466 r5488 678 678 ! INCLUDE 'netcdf.inc' 679 679 ! 680 ! !--------------------------------------------------------681 ! !--input variables682 ! !--------------------------------------------------------683 ! LOGICAL, INTENT(IN) :: debut684 ! REAL, INTENT(IN) :: pphis(klon), pplay(klon,klev), paprs(klon,klev+1), t_seri(klon,klev)685 !686 ! !--------------------------------------------------------687 ! ! ... Local variables688 ! !--------------------------------------------------------689 !690 ! CHARACTER (LEN=20) :: modname='airplane_mod'691 ! INTEGER :: i, k, kori, iret, varid, error, ncida, klona692 ! INTEGER,SAVE :: nleva, ntimea693 !!$OMP THREADPRIVATE(nleva,ntimea)694 ! REAL, ALLOCATABLE :: pkm_airpl_glo(:,:,:) !--km/s695 ! REAL, ALLOCATABLE :: ph2o_airpl_glo(:,:,:) !--molec H2O/cm3/s696 ! REAL, ALLOCATABLE, SAVE :: zmida(:), zinta(:)697 ! REAL, ALLOCATABLE, SAVE :: pkm_airpl(:,:,:)698 ! REAL, ALLOCATABLE, SAVE :: ph2o_airpl(:,:,:)699 !!$OMP THREADPRIVATE(pkm_airpl,ph2o_airpl,zmida,zinta)700 ! REAL :: zalt(klon,klev+1)701 ! REAL :: zrho, zdz(klon,klev), zfrac702 !703 ! !704 ! IF (debut) THEN705 ! !--------------------------------------------------------------------------------706 ! ! ... Open the file and read airplane emissions707 ! !--------------------------------------------------------------------------------708 ! !709 ! IF (is_mpi_root .AND. is_omp_root) THEN710 ! !711 ! iret = nf_open('aircraft_phy.nc', 0, ncida)712 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to open aircraft_phy.nc file',1)713 ! ! ... Get lengths714 ! iret = nf_inq_dimid(ncida, 'time', varid)715 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get time dimid in aircraft_phy.nc file',1)716 ! iret = nf_inq_dimlen(ncida, varid, ntimea)717 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get time dimlen aircraft_phy.nc file',1)718 ! iret = nf_inq_dimid(ncida, 'vector', varid)719 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get vector dimid aircraft_phy.nc file',1)720 ! iret = nf_inq_dimlen(ncida, varid, klona)721 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get vector dimlen aircraft_phy.nc file',1)722 ! iret = nf_inq_dimid(ncida, 'lev', varid)723 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get lev dimid aircraft_phy.nc file',1)724 ! iret = nf_inq_dimlen(ncida, varid, nleva)725 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get lev dimlen aircraft_phy.nc file',1)726 ! !727 ! IF ( klona /= klon_glo ) THEN728 ! WRITE(lunout,*) 'klona & klon_glo =', klona, klon_glo729 ! CALL abort_physic(modname,'problem klon in aircraft_phy.nc file',1)730 ! ENDIF731 ! !732 ! IF ( ntimea /= 12 ) THEN733 ! WRITE(lunout,*) 'ntimea=', ntimea734 ! CALL abort_physic(modname,'problem ntime<>12 in aircraft_phy.nc file',1)735 ! ENDIF736 ! !737 ! ALLOCATE(zmida(nleva), STAT=error)738 ! IF (error /= 0) CALL abort_physic(modname,'problem to allocate zmida',1)739 ! ALLOCATE(pkm_airpl_glo(klona,nleva,ntimea), STAT=error)740 ! IF (error /= 0) CALL abort_physic(modname,'problem to allocate pkm_airpl_glo',1)741 ! ALLOCATE(ph2o_airpl_glo(klona,nleva,ntimea), STAT=error)742 ! IF (error /= 0) CALL abort_physic(modname,'problem to allocate ph2o_airpl_glo',1)743 ! !744 ! iret = nf_inq_varid(ncida, 'lev', varid)745 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get lev dimid aircraft_phy.nc file',1)746 ! iret = nf_get_var_double(ncida, varid, zmida)747 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read zmida file',1)748 ! !749 ! iret = nf_inq_varid(ncida, 'emi_co2_aircraft', varid) !--CO2 as a proxy for m flown -750 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get emi_distance dimid aircraft_phy.nc file',1)751 ! iret = nf_get_var_double(ncida, varid, pkm_airpl_glo)752 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read pkm_airpl file',1)753 ! !754 ! iret = nf_inq_varid(ncida, 'emi_h2o_aircraft', varid)755 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get emi_h2o_aircraft dimid aircraft_phy.nc file',1)756 ! iret = nf_get_var_double(ncida, varid, ph2o_airpl_glo)757 ! IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read ph2o_airpl file',1)758 ! !759 ! ENDIF !--is_mpi_root and is_omp_root760 ! !761 ! CALL bcast(nleva)762 ! CALL bcast(ntimea)763 ! !764 ! IF (.NOT.ALLOCATED(zmida)) ALLOCATE(zmida(nleva), STAT=error)765 ! IF (.NOT.ALLOCATED(zinta)) ALLOCATE(zinta(nleva+1), STAT=error)766 ! !767 ! ALLOCATE(pkm_airpl(klon,nleva,ntimea))768 ! ALLOCATE(ph2o_airpl(klon,nleva,ntimea))769 ! !770 ! ALLOCATE(flight_m(klon,klev))771 ! ALLOCATE(flight_h2o(klon,klev))772 ! !773 ! CALL bcast(zmida)774 ! zinta(1)=0.0 !--surface775 ! DO k=2, nleva776 ! zinta(k) = (zmida(k-1)+zmida(k))/2.0*1000.0 !--conversion from km to m777 ! ENDDO778 ! zinta(nleva+1)=zinta(nleva)+(zmida(nleva)-zmida(nleva-1))*1000.0 !--extrapolation for last interface779 ! !print *,'zinta=', zinta780 ! !781 ! CALL scatter(pkm_airpl_glo,pkm_airpl)782 ! CALL scatter(ph2o_airpl_glo,ph2o_airpl)783 ! !784 !!$OMP MASTER785 ! IF (is_mpi_root .AND. is_omp_root) THEN786 ! DEALLOCATE(pkm_airpl_glo)787 ! DEALLOCATE(ph2o_airpl_glo)788 ! ENDIF !--is_mpi_root789 !!$OMP END MASTER790 !791 ! ENDIF !--debut792 !!793 !!--compute altitude of model level interfaces794 !!795 ! DO i = 1, klon796 ! zalt(i,1)=pphis(i)/RG !--in m797 ! ENDDO798 !!799 ! DO k=1, klev800 ! DO i = 1, klon801 ! zrho=pplay(i,k)/t_seri(i,k)/RD802 ! zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho/RG803 ! zalt(i,k+1)=zalt(i,k)+zdz(i,k) !--in m804 ! ENDDO805 ! ENDDO806 !!807 !!--vertical reprojection808 !!809 ! flight_m(:,:)=0.0810 ! flight_h2o(:,:)=0.0811 !!812 ! DO k=1, klev813 ! DO kori=1, nleva814 ! DO i=1, klon815 ! !--fraction of layer kori included in layer k816 ! zfrac=max(0.0,min(zalt(i,k+1),zinta(kori+1))-max(zalt(i,k),zinta(kori)))/(zinta(kori+1)-zinta(kori))817 ! !--reproject818 ! flight_m(i,k)=flight_m(i,k) + pkm_airpl(i,kori,mth_cur)*zfrac819 ! !--reproject820 ! flight_h2o(i,k)=flight_h2o(i,k) + ph2o_airpl(i,kori,mth_cur)*zfrac821 ! ENDDO822 ! ENDDO823 ! ENDDO824 !!825 ! DO k=1, klev826 ! DO i=1, klon827 ! !--molec.cm-3.s-1 / (molec/mol) * kg CO2/mol * m2 * m * cm3/m3 / (kg CO2/m) => m s-1 per cell828 ! flight_m(i,k)=flight_m(i,k)/RNAVO*44.e-3*cell_area(i)*zdz(i,k)*1.e6/16.37e-3829 ! flight_m(i,k)=flight_m(i,k)*100.0 !--x100 to augment signal to noise830 ! !--molec.cm-3.s-1 / (molec/mol) * kg H2O/mol * m2 * m * cm3/m3 => kg H2O s-1 per cell831 ! flight_h2o(i,k)=flight_h2o(i,k)/RNAVO*18.e-3*cell_area(i)*zdz(i,k)*1.e6832 ! ENDDO833 ! ENDDO834 680 !! 835 681 !END SUBROUTINE airplane -
LMDZ6/branches/contrails/libf/phylmd/lmdz_call_cloud_optics_prop.f90
r5268 r5488 10 10 reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, & 11 11 reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra, & 12 icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon )12 icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, rcontrail) 13 13 14 14 ! Interface between the LMDZ physics monitor and the cloud properties calculation routines … … 47 47 LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection 48 48 LOGICAL, INTENT(IN) :: ok_newmicro, ok_aie 49 50 REAL, INTENT(IN) :: rcontrail(klon, klev) ! ratio of contrail to total cloud fraction, used only if ok_plane_contrail=y [-] 49 51 50 52 ! inout: … … 116 118 reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, & 117 119 reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra, & 118 icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon )120 icefrac_optics, dNovrN, ptconv,rnebcon, ccwcon, rcontrail) 119 121 ELSE 120 122 CALL nuage (paprs, pplay, & -
LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop.f90
r5400 r5488 9 9 reliq_pi, reice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, & 10 10 reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra, & 11 icefrac_optics, dNovrN, ptconv, rnebcon, ccwcon)11 icefrac_optics, dNovrN, ptconv, rnebcon, ccwcon, rcontrail) 12 12 13 13 USE lmdz_cloud_optics_prop_ini , ONLY : flag_aerosol, ok_cdnc … … 28 28 USE lmdz_cloud_optics_prop_ini , ONLY : ok_icefra_lscp, rei_max, rei_min 29 29 USE lmdz_cloud_optics_prop_ini , ONLY : zepsec, novlp, iflag_ice_thermo, ok_new_lscp 30 USE lmdz_cloud_optics_prop_ini , ONLY : ok_plane_contrail, re_ice_crystals_contrails 30 31 31 32 … … 69 70 70 71 LOGICAL, INTENT(IN) :: ptconv(klon, klev) ! flag for grid points affected by deep convection 72 73 REAL, INTENT(IN) :: rcontrail(klon, klev) ! ratio of contrails to total cloud fraction, used only if ok_plane_contrail=y [-] 71 74 72 75 ! inout: … … 333 336 334 337 IF (zfiwp_var==0. .OR. rei<=0.) rei = 1. 338 IF ( ok_plane_contrail ) THEN 339 !--If contrails are activated, rei is a weighted average between the natural 340 !--rei and the contrails rei, with the weights being the fraction of natural 341 !--vs contrail cirrus in the gridbox 342 rei = rei * ( 1. - rcontrail(i,k) ) + re_ice_crystals_contrails * rcontrail(i,k) 343 ENDIF 335 344 pcldtaupi(i, k) = 3.0/2.0*zflwp_var/rad_chaud_pi(i, k) + & 336 345 zfiwp_var*(3.448E-03+2.431/rei) … … 442 451 IF (zflwp_var==0.) rel = 1. 443 452 IF (zfiwp_var==0. .OR. rei<=0.) rei = 1. 453 IF ( ok_plane_contrail ) THEN 454 !--If contrails are activated, rei is a weighted average between the natural 455 !--rei and the contrails rei, with the weights being the fraction of natural 456 !--vs contrail cirrus in the gridbox 457 rei = rei * ( 1. - rcontrail(i,k) ) + re_ice_crystals_contrails * rcontrail(i,k) 458 ENDIF 444 459 pcltau(i, k) = 3.0/2.0*(zflwp_var/rel) + zfiwp_var*(3.448E-03+2.431/ & 445 460 rei) -
LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop_ini.f90
r5400 r5488 11 11 LOGICAL, PROTECTED :: ok_cdnc 12 12 LOGICAL, PROTECTED :: ok_icefra_lscp, ok_new_lscp 13 LOGICAL, PROTECTED :: ok_plane_contrail 13 14 REAL, PROTECTED :: bl95_b0, bl95_b1 ! Parameter in B&L 95-Formula 14 15 REAL, ALLOCATABLE :: latitude_deg(:) … … 22 23 REAL, PROTECTED :: rei_max, rei_min 23 24 REAL, PROTECTED :: zepsec 25 REAL, PROTECTED :: re_ice_crystals_contrails=7.5E-6 ! [m] effective radius of ice crystals in contrails 24 26 REAL, PARAMETER :: thres_tau=0.3, thres_neb=0.001 25 27 REAL, PARAMETER :: prmhc=440.*100. ! Pressure between medium and high level cloud in Pa … … 39 41 !$OMP THREADPRIVATE(rad_chau1, rad_chau2, rad_froid, rei_max, rei_min) 40 42 !$OMP THREADPRIVATE(zepsec) 43 !$OMP THREADPRIVATE(re_ice_crystals_contrails) 41 44 42 45 … … 46 49 & ok_cdnc_in, bl95_b0_in, & 47 50 & bl95_b1_in, latitude_deg_in, rpi_in, rg_in, rd_in, zepsec_in, novlp_in, & 48 & iflag_ice_thermo_in, ok_new_lscp_in) 51 & iflag_ice_thermo_in, ok_new_lscp_in, & 52 & ok_plane_contrail_in) 49 53 50 54 USE ioipsl_getin_p_mod, ONLY : getin_p … … 56 60 INTEGER, INTENT(IN) :: novlp_in, iflag_ice_thermo_in 57 61 LOGICAL, INTENT(IN) :: ok_cdnc_in, ok_new_lscp_in 62 LOGICAL, INTENT(IN) :: ok_plane_contrail_in 58 63 REAL, INTENT(IN) :: bl95_b0_in, bl95_b1_in 59 64 REAL, INTENT(IN) :: latitude_deg_in(klon) … … 77 82 iflag_ice_thermo = iflag_ice_thermo_in 78 83 ok_new_lscp = ok_new_lscp_in 84 ok_plane_contrail = ok_plane_contrail_in 79 85 80 86 call getin_p('cdnc_min',cdnc_min) … … 98 104 rei_max = 61.29 99 105 CALL getin_p('rei_max',rei_max) 106 CALL getin_p('re_ice_crystals_contrails', re_ice_crystals_contrails) 100 107 101 108 -
LMDZ6/branches/contrails/libf/phylmd/physiq_mod.F90
r5456 r5488 1877 1877 & ok_cdnc, bl95_b0, & 1878 1878 & bl95_b1, latitude_deg, rpi, rg, rd, & 1879 & zepsec, novlp, iflag_ice_thermo, ok_new_lscp) 1879 & zepsec, novlp, iflag_ice_thermo, ok_new_lscp, & 1880 & ok_plane_contrail) 1880 1881 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1881 1882 … … 4465 4466 ref_liq_pi, ref_ice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, & 4466 4467 reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra, & 4467 zfice, dNovrN, ptconv, rnebcon, clwcon )4468 zfice, dNovrN, ptconv, rnebcon, clwcon, rcont_seri) 4468 4469 4469 4470 !
Note: See TracChangeset
for help on using the changeset viewer.