Changeset 693 for trunk/LMDZ.MARS/libf/phymars/nlte_aux.F
- Timestamp:
- Jun 5, 2012, 11:48:53 AM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/phymars/nlte_aux.F
r498 r693 252 252 253 253 c ********************************************************************** 254 real*8 function we(ig,me,pe,plaux,idummy,nt_local,p_local,254 real*8 function iaa_we(ig,me,pe,plaux,idummy,nt_local,p_local, 255 255 $ Desp,wsL) 256 256 c icls=5 -->para mztf … … 428 428 429 429 if (icls.eq.2) then 430 we = wl430 iaa_we = wl 431 431 return 432 432 endif … … 485 485 endif 486 486 487 we = sqrt( parentesis )488 ! write (*,*) ' from we: xdop,alda,wd', sngl(x),alda(kr),sngl(wd)489 ! write (*,*) ' from we: we',we487 iaa_we = sqrt( parentesis ) 488 ! write (*,*) ' from iaa_we: xdop,alda,wd', sngl(x),alda(kr),sngl(wd) 489 ! write (*,*) ' from iaa_we: we', iaa_we 490 490 491 491 else 492 492 493 we = wl493 iaa_we = wl 494 494 ! if there is supersaturation we can ignore wd completely; 495 495 ! mztf.f will compute the eqw of the whole box afterwards … … 497 497 endif 498 498 499 if (icls.eq.3) we = wd499 if (icls.eq.3) iaa_we = wd 500 500 501 501 if ( idummy.gt.9 ) 502 @ write (*,*) ' wl,wd,w =', wl,wd, we502 @ write (*,*) ' wl,wd,w =', wl,wd,iaa_we 503 503 504 504 wsL = wl … … 594 594 real*8 ept,eps,xa 595 595 real*8 acc, c 596 real*8 we597 real*8 f,fi, simrul598 599 external f,fi596 real*8 iaa_we 597 real*8 iaa_f, iaa_fi, simrul 598 599 external iaa_f,iaa_fi 600 600 601 601 c ********** *********** ********* … … 604 604 ! if(ig.eq.1682)write(*,*)'mztfsub_overlap/768',ua(kr),iirw 605 605 if (iirw.eq.2) then !iirw=icf=2 ==> we use the w&r formula 606 w = we(ig,ua(kr),pt,pp, idummy, c1,p1, Desp, wsL )606 w = iaa_we(ig,ua(kr),pt,pp, idummy, c1,p1, Desp, wsL ) 607 607 return 608 608 end if 609 ept= we(ig,ua(kr),pt,pp, idummy,c1,p1, Desp, wsL)609 ept=iaa_we(ig,ua(kr),pt,pp, idummy,c1,p1, Desp, wsL) 610 610 else !para fot 611 611 if (iirw.eq.2) then ! icf=2 ==> we use the w&r formula 612 w = we(ig,sl_ua,pt,pp, idummy,c1,p1, Desp, wsL)612 w = iaa_we(ig,sl_ua,pt,pp, idummy,c1,p1, Desp, wsL) 613 613 return 614 614 end if 615 ept= we(ig,sl_ua,pt,pp, idummy,c1,p1, Desp, wsL)615 ept=iaa_we(ig,sl_ua,pt,pp, idummy,c1,p1, Desp, wsL) 616 616 end if 617 617 … … 630 630 631 631 eps = acc * ept !accuracy 10-4 atmospheric eqw. 632 xa=0.5*ept/f(0.d0) !width of doppler shifted atmospheric line. 633 w=2.0*(simrul(0.0d0,xa,f,c,eps)+simrul(0.1d0,1.0/xa,fi,c,eps)) 632 xa=0.5*ept/iaa_f(0.d0) !width of doppler shifted atmospheric line. 633 w = 2.0*( simrul(0.0d0,xa,iaa_f,c,eps) 634 . + simrul(0.1d0,1.0/xa,iaa_fi,c,eps) ) 634 635 !no shift. 635 636 … … 639 640 640 641 c ********************************************************************** 641 double precision function fi(y)642 double precision function iaa_fi(y) 642 643 c returns the value of f(1/y) 643 644 c ********************************************************************** 644 645 645 646 implicit none 646 real*8 f, y647 648 fi=f(1.0/y)/y**2647 real*8 iaa_f, y 648 649 iaa_fi=iaa_f(1.0/y)/y**2 649 650 return 650 651 end … … 652 653 653 654 c ********************************************************************** 654 double precision function f(nuaux)655 double precision function iaa_f(nuaux) 655 656 c calculates 1-exp(-k(nu)u) for all series paths or combinations thereof 656 657 c **********************************************************************
Note: See TracChangeset
for help on using the changeset viewer.