Changeset 1667 for trunk/LMDZ.VENUS/libf
- Timestamp:
- Feb 17, 2017, 3:04:05 PM (8 years ago)
- Location:
- trunk/LMDZ.VENUS/libf/phyvenus
- Files:
-
- 4 edited
- 2 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/mad_muphy.F90
r1664 r1667 122 122 IF (SEDIM .and. MERGE) THEN 123 123 redge = (r1*r2)**0.5D0 ! Edge radius of mode 1 124 write(*,*)'The intersection size or virtual bonduary', redge124 ! write(*,*)'The intersection size or virtual bonduary', redge 125 125 126 126 IF (r1 .EQ. redge) THEN 127 write(*,*)'Mode 1 merge to mode 2', redge, r1127 ! write(*,*)'Mode 1 merge to mode 2', redge, r1 128 128 CALL MERGING(r1,N1,sigma1,sigma2,dM0_merge_m1,dM3_merge_m1, & 129 129 & dM0_merge_m2,dM3_merge_m2) … … 143 143 144 144 IF (r2 .EQ. redge) THEN 145 write(*,*)'Mode 2 merge to mode 1',redge,r2145 ! write(*,*)'Mode 2 merge to mode 1',redge,r2 146 146 CALL MERGING(r2,N2,sigma2,sigma1,dM0_merge_m2,dM3_merge_m2, & 147 147 & dM0_merge_m1,dM3_merge_m1) … … 325 325 M3_m2(3) = M3_m2(3) + dM3_m2_ccn 326 326 !------------------------------------! 327 write(*,*)'l.653: after up', M3_m1(1),M3_m1(2),M3_m1(3),dM3_m1_SA,dM3_m1_WV,dM3_m1_ccn328 write(*,*)'l.654: after up', M0_m1(1),M0_m1(2),dM0_m1_drop327 ! write(*,*)'l.653: after up', M3_m1(1),M3_m1(2),M3_m1(3),dM3_m1_SA,dM3_m1_WV,dM3_m1_ccn 328 ! write(*,*)'l.654: after up', M0_m1(1),M0_m1(2),dM0_m1_drop 329 329 !----------------------------------------------------------------------- 330 330 ! To controle/check the mass conservation ! … … 375 375 N1 = 0.D0 376 376 ENDIF 377 write(*,*)'rmean not ZERO',r1,N1,M0_m1(1),M3_m1(1),WSA377 ! write(*,*)'rmean not ZERO',r1,N1,M0_m1(1),M3_m1(1),WSA 378 378 ENDIF 379 379 … … 408 408 frac_ccn_m2 = M0_m2(2)/(M0_m2(1)+M0_m2(2)) 409 409 410 write(*,*)'rmean',r1,'NTOT',N1, 'SH2SO4', SH2SO4410 ! write(*,*)'rmean',r1,'NTOT',N1, 'SH2SO4', SH2SO4 411 411 412 412 … … 416 416 IF (MERGE) THEN 417 417 redge = (r1*r2)**0.5D0 ! Edge radius of mode 1 418 write(*,*)'The intersection size or virtual bonduary', redge418 ! write(*,*)'The intersection size or virtual bonduary', redge 419 419 420 420 IF (r1 .EQ. redge) THEN 421 write(*,*)'Mode 1 merge to mode 2', redge, r1421 ! write(*,*)'Mode 1 merge to mode 2', redge, r1 422 422 CALL MERGING(r1,N1,sigma1,sigma2,dM0_merge_m1,dM3_merge_m1, & 423 423 & dM0_merge_m2,dM3_merge_m2) … … 437 437 438 438 IF (r2 .EQ. redge) THEN 439 write(*,*)'Mode 2 merge to mode 1',redge,r2439 ! write(*,*)'Mode 2 merge to mode 1',redge,r2 440 440 CALL MERGING(r2,N2,sigma2,sigma1,dM0_merge_m2,dM3_merge_m2, & 441 441 & dM0_merge_m1,dM3_merge_m1) … … 476 476 !----------------------------------------------------------------------- 477 477 if (dt .eq. 1) then 478 write(*,*) 'Ntot, rc mode 1: ', N1,r1478 ! write(*,*) 'Ntot, rc mode 1: ', N1,r1 479 479 ! Log-normal distribution function 480 480 CALL build_radius_grid(nbin,rmin,rmax,vratio) 481 481 CALL logdist(sigma1,N1,r1,rad_cld,n_g1) 482 DO i = 1, nbin483 open(888,file='ND_t3600_nuc-het-flux_dt1_1step_sssat')484 write(888,'(I10,2X,3(ES15.7,1X))') i, rad_cld(i), n_g1(i)485 ENDDO482 ! DO i = 1, nbin 483 ! open(888,file='ND_t3600_nuc-het-flux_dt1_1step_sssat') 484 ! write(888,'(I10,2X,3(ES15.7,1X))') i, rad_cld(i), n_g1(i) 485 ! ENDDO 486 486 endif 487 487 … … 507 507 508 508 MFPAIR = FPLAIR(TAIR,PAIR) ! Mean free path of air molecules 509 write(*,*) 'MFPAIR',MFPAIR, TAIR, PAIR509 ! write(*,*) 'MFPAIR',MFPAIR, TAIR, PAIR 510 510 Kn = MFPAIR/ri1 ! Knudsen number 511 511 … … 531 531 real, intent(in) :: TAIR, PAIR, MRSA_loc 532 532 real :: ROSAS, PSASAS_ZELE, STSAS 533 write(*,*)'checkpoint change_wsa', ST, RHOSA, RHOsasat, PSASAS_ZELE(TAIR,WSA), TAIR, WSA533 ! write(*,*)'checkpoint change_wsa', ST, RHOSA, RHOsasat, PSASAS_ZELE(TAIR,WSA), TAIR, WSA 534 534 ST = STSAS(TAIR,WSA) ! Surface tension of sulfuric acid solution/vapor (N/m) 535 535 … … 539 539 SH2SO4 = (PAIR*MRSA_loc)/RHOsasat ! Saturation Ratio 540 540 541 write(*,*)'checkpoint change_wsa', PSASAS_ZELE(TAIR,WSA)541 ! write(*,*)'checkpoint change_wsa', PSASAS_ZELE(TAIR,WSA) 542 542 543 543 END SUBROUTINE change_wsa -
trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/new_cloud_venus.F
r1661 r1667 119 119 ! Elle fait appel à la fct/ssrtine ITERWV() 120 120 121 CALL BRACWV(WVMIN,WVMAX,NBRAC,RMODE, 122 & mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),TT(ilon,ilev), 123 & PP(ilon,ilev),FLAG,WSAFLAG,NBROOT) 121 CALL BRACWV(TT(ilon,ilev),PP(ilon,ilev),WVMIN,WVMAX,NBRAC, 122 & RMODE,mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),FLAG,WSAFLAG,NBROOT) 124 123 125 124 SELECT CASE(FLAG) … … 130 129 ! Elle fait appel la fct/ssrtine ITERWV() 131 130 132 WH2SO4(ilon,ilev)=IRFRMWV( WVMIN,WVMAX,WVACC,MAXITE,RMODE,133 & TT(ilon,ilev),PP(ilon,ilev),131 WH2SO4(ilon,ilev)=IRFRMWV(TT(ilon,ilev),PP(ilon,ilev), 132 & WVMIN,WVMAX,WVACC,MAXITE,RMODE, 134 133 & mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),NBROOT) 135 134 -
trunk/LMDZ.VENUS/libf/phyvenus/cloudvenus/wsa_new.F90
r1664 r1667 204 204 WSAMIN = 0.1D0 205 205 WSAMAX = 1.0D0 206 LPPWV = LOG(PAIR*WV)206 LPPWV = DLOG(PAIR*WV) 207 207 208 208 ! Appel Bracket de KEEQ … … 293 293 ! Si NROOT>1 on place la borne sup output la borne min du calcul en i 294 294 IF (NROOT.GT.1) THEN 295 XB=(1.- LOG(DBLE(I+1))/LOG(DBLE(N)))*XMAX295 XB=(1.-DLOG(DBLE(I+1))/DLOG(DBLE(N)))*XMAX 296 296 ENDIF 297 297 … … 314 314 315 315 DO J=N-1,1,-1 316 X=(1.- LOG(DBLE(N-J))/LOG(DBLE(N)))*XMAX316 X=(1.-DLOG(DBLE(N-J))/DLOG(DBLE(N)))*XMAX 317 317 ! write(*,*) 'BRACWV, bf 4th ITERWV (cas 2) ' 318 318 CALL ITERWV(TAIR,PAIR,X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,RADIUS) … … 365 365 DX=(XB-XA)/N 366 366 X=XB 367 FP=KEEQ( RADIUS,X,LPPWVINP)367 FP=KEEQ(TAIR,RADIUS,X,LPPWVINP) 368 368 369 369 DO I=N,1,-1 370 370 X=X-DX 371 371 372 FC=KEEQ( RADIUS,X,LPPWVINP)372 FC=KEEQ(TAIR,RADIUS,X,LPPWVINP) 373 373 374 374 IF ((FP*FC).LE.0.) THEN … … 752 752 753 753 ! Physical constants: 754 REAL :: MH2O,KEEQ754 REAL :: KEEQ 755 755 756 756 ! External functions needed: … … 764 764 REAL :: C1 765 765 766 MH2O= MWV 767 C1=2.0D0*MH2O/RGAS 766 C1=2.0D0*MWV/RGAS 768 767 769 768 KEEQ=LPPWV-C1*STSAS(TAIR,WX)/(TAIR*RADIUS*ROSAS(TAIR,WX))- & … … 818 817 819 818 !pure acid satur vapor pressure 820 lpar= -11.695D0 + LOG(pstand) ! Zeleznik821 acidps = 1/360.15D0 - 1.0/T + 0.38D0/545.D0*(1.0+ LOG(360.15D0/T)-360.15D0/T)819 lpar= -11.695D0 + DLOG(pstand) ! Zeleznik 820 acidps = 1/360.15D0 - 1.0/T + 0.38D0/545.D0*(1.0+DLOG(360.15D0/T)-360.15D0/T) 822 821 acidps = 10156.D0*acidps + lpar 823 acidps = EXP(acidps) !Pa822 acidps = DEXP(acidps) !Pa 824 823 825 824 !acid sat.vap.PP over mixture (flat surface): -
trunk/LMDZ.VENUS/libf/phyvenus/ini_histmth.h
r1530 r1667 225 225 . "ave(X)", zsto,zout) 226 226 c 227 228 229 230 c 231 232 233 234 c 235 236 237 238 239 240 241 242 243 244 245 246 227 c CALL histdef(nid_mth,"dtlwrNLTE", "LWNLTE radiation dT", 228 c . "K/s",nbp_lon,jj_nb,nhori,klev,1,klev,nvert,32, 229 c . "ave(X)", zsto,zout) 230 c 231 c CALL histdef(nid_mth,"dtlwrLTE","LW_LTE radiation dT", 232 c . "K/s",nbp_lon,jj_nb,nhori,klev,1,klev,nvert,32, 233 c . "ave(X)", zsto,zout) 234 c 235 c CALL histdef(nid_mth, "dteuv", "UV radiation dT", "K/s", 236 c . nbp_lon,jj_nb,nhori, klev,1,klev,nvert, 32, 237 c . "ave(X)", zsto,zout) 238 c CALL histdef(nid_mth, "dtcond", "Therm conduction", "K/s", 239 c . nbp_lon,jj_nb,nhori, klev,1,klev,nvert, 32, 240 c . "ave(X)", zsto,zout) 241 c CALL histdef(nid_mth, "dumolvis", "molec viscosity (u)" 242 c . ,"m/s2",nbp_lon,jj_nb,nhori,klev,1,klev,nvert,32, 243 c . "ave(X)", zsto,zout) 244 c CALL histdef(nid_mth, "dvmolvis", "molec viscosity (v)", 245 c . "m/s2",nbp_lon,jj_nb,nhori,klev,1,klev,nvert,32, 246 c . "ave(X)", zsto,zout) 247 247 248 248 c -
trunk/LMDZ.VENUS/libf/phyvenus/write_histmth.h
r1661 r1667 110 110 call histwrite_phy(nid_mth,.false.,"dtlwr",itau_w,dtlw) 111 111 c en K/s 112 113 114 115 116 117 112 c call histwrite_phy(nid_mth,.false.,"dtlwrNLTE",itau_w,d_t_nlte) 113 c call histwrite_phy(nid_mth,.false.,"dtlwrLTE",itau_w,-1.*cool) 114 c call histwrite_phy(nid_mth,.false.,"dteuv",itau_w,d_t_euv) 115 c call histwrite_phy(nid_mth,.false.,"dtcond",itau_w,d_t_conduc) 116 c call histwrite_phy(nid_mth,.false.,"dumolvis",itau_w,d_u_molvis) 117 c call histwrite_phy(nid_mth,.false.,"dvmolvis",itau_w,-1.*d_v_molvis) 118 118 119 119 c call histwrite_phy(nid_mth,.false.,"dtec",itau_w,d_t_ec)
Note: See TracChangeset
for help on using the changeset viewer.