Changeset 695 for trunk/LMDZ.MARS/libf
- Timestamp:
- Jun 5, 2012, 1:41:39 PM (13 years ago)
- Location:
- trunk/LMDZ.MARS/libf/phymars
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/phymars/calltherm_interface.F90
r660 r695 2 2 ! AC 2011-01-05 3 3 ! 4 SUBROUTINE calltherm_interface (firstcall, & 4 SUBROUTINE calltherm_interface (firstcall, & 5 5 & zzlev,zzlay, & 6 6 & ptimestep,pu,pv,pt,pq,pdu,pdv,pdt,pdq,q2, & … … 24 24 ! REAL, INTENT(IN) :: long(ngridmx),lati(ngridmx) 25 25 REAL, INTENT(IN) :: ptimestep 26 REAL, INTENT(IN) :: pplev(ngridmx,nlayermx+1),pplay(ngridmx,nlayermx) 26 REAL, INTENT(IN) :: pplev(ngridmx,nlayermx+1) 27 REAL, INTENT(IN) :: pplay(ngridmx,nlayermx) 27 28 REAL, INTENT(IN) :: pphi(ngridmx,nlayermx) 28 29 REAL, INTENT(IN) :: pu(ngridmx,nlayermx),pv(ngridmx,nlayermx) … … 32 33 LOGICAL, INTENT(IN) :: firstcall 33 34 REAL, INTENT(IN) :: pdu(ngridmx,nlayermx),pdv(ngridmx,nlayermx) 34 REAL, INTENT(IN) :: pdq(ngridmx,nlayermx,nqmx),pdt(ngridmx,nlayermx) 35 REAL, INTENT(IN) :: pdq(ngridmx,nlayermx,nqmx) 36 REAL, INTENT(IN) :: pdt(ngridmx,nlayermx) 35 37 REAL, INTENT(IN) :: q2(ngridmx,nlayermx+1) 36 38 REAL, INTENT(IN) :: zpopsk(ngridmx,nlayermx) -
trunk/LMDZ.MARS/libf/phymars/nlte_aux.F
r694 r695 277 277 c arguments 278 278 integer ig ! ADDED FOR TRACEBACK 279 real*8 279 real*8 me ! I. path's absorber amount 280 280 real*8 pe ! I. path's presion total 281 281 real*8 plaux ! I. path's partial pressure of CO2 … … 287 287 288 288 c local variables 289 integer 290 real*8 291 real*8 292 real*8 289 integer i 290 real*8 y,x,wl,wd 291 real*8 cn(0:7),dn(0:7) 292 real*8 pi, xx 293 293 real*8 f_sat_box 294 294 real*8 dv_sat_box, dv_corte_box … … 558 558 write(2,7) c1,c,c2,fsim(c1),fsim(c),fsim(c2) 559 559 write(*,7) c1,c,c2,fsim(c1),fsim(c),fsim(c2) 560 7 format(2x, 17hsimrule fails at,/,3e15.6,/,3e15.6)560 7 format(2x,'17hsimrule fails at ',/,3e15.6,/,3e15.6) 561 561 goto 8 562 562 5 a0=s1(n) -
trunk/LMDZ.MARS/libf/phymars/nlte_calc.F
r690 r695 155 155 156 156 c vibr. temp of the bending mode : 157 if (isot.eq.1) call interdp ( tvtbs,zyd,nzy, v626t1,zld,nl, 1)158 if (isot.eq.2) call interdp ( tvtbs,zyd,nzy, v628t1,zld,nl, 1)159 if (isot.eq.3) call interdp ( tvtbs,zyd,nzy, v636t1,zld,nl, 1)160 if (isot.eq.4) call interdp ( tvtbs,zyd,nzy, v627t1,zld,nl, 1)157 if (isot.eq.1) call interdp (tvtbs,zyd,nzy,v626t1,zld,nl,1) 158 if (isot.eq.2) call interdp (tvtbs,zyd,nzy,v628t1,zld,nl,1) 159 if (isot.eq.3) call interdp (tvtbs,zyd,nzy,v636t1,zld,nl,1) 160 if (isot.eq.4) call interdp (tvtbs,zyd,nzy,v627t1,zld,nl,1) 161 161 162 162 c 2nd: correccion a la n10(i) (cantidad de absorbente en el lower state) … … 683 683 c*********************************************************************** 684 684 685 call mzescape (ig,taustar21,tauinf210,tauii210,1,2,irw_mztf,imu) 686 call mzescape (ig,taustar31,tauinf310,tauii310,1,3,irw_mztf,imu) 687 call mzescape (ig,taustar41,tauinf410,tauii410,1,4,irw_mztf,imu) 685 call mzescape (ig,taustar21,tauinf210,tauii210,1,2 686 & ,irw_mztf,imu) 687 call mzescape (ig,taustar31,tauinf310,tauii310,1,3 688 & ,irw_mztf,imu) 689 call mzescape (ig,taustar41,tauinf410,tauii410,1,4 690 & ,irw_mztf,imu) 688 691 689 692 istyle = 2 … … 915 918 enddo 916 919 c vibr. temp of the bending mode : 917 if (isot.eq.1) call interdp ( tvtbs,zyd,nzy, v626t1,zld,nl, 1)918 if (isot.eq.2) call interdp ( tvtbs,zyd,nzy, v628t1,zld,nl, 1)919 if (isot.eq.3) call interdp ( tvtbs,zyd,nzy, v636t1,zld,nl, 1)920 if (isot.eq.4) call interdp ( tvtbs,zyd,nzy, v627t1,zld,nl, 1)920 if (isot.eq.1) call interdp(tvtbs,zyd,nzy, v626t1,zld,nl,1) 921 if (isot.eq.2) call interdp(tvtbs,zyd,nzy, v628t1,zld,nl,1) 922 if (isot.eq.3) call interdp(tvtbs,zyd,nzy, v636t1,zld,nl,1) 923 if (isot.eq.4) call interdp(tvtbs,zyd,nzy, v627t1,zld,nl,1) 921 924 !if (isot.eq.5) call interdp ( tvtbs,zxd,nz, vcot1,zld,nl, 1 ) 922 925 … … 2037 2040 2038 2041 c vibr. temp of the bending mode : 2039 if (isot.eq.1) call interdp ( tvtbs,zyd,nzy, v626t1,zld,nl, 1)2040 if (isot.eq.2) call interdp ( tvtbs,zyd,nzy, v628t1,zld,nl, 1)2041 if (isot.eq.3) call interdp ( tvtbs,zyd,nzy, v636t1,zld,nl, 1)2042 if (isot.eq.4) call interdp ( tvtbs,zyd,nzy, v627t1,zld,nl, 1)2042 if (isot.eq.1) call interdp(tvtbs,zyd,nzy, v626t1,zld,nl,1) 2043 if (isot.eq.2) call interdp(tvtbs,zyd,nzy, v628t1,zld,nl,1) 2044 if (isot.eq.3) call interdp(tvtbs,zyd,nzy, v636t1,zld,nl,1) 2045 if (isot.eq.4) call interdp(tvtbs,zyd,nzy, v627t1,zld,nl,1) 2043 2046 !if (isot.eq.5) call interdp ( tvtbs,zxd,nz, vcot1,zld,nl, 1 ) 2044 2047 … … 2533 2536 2534 2537 ! tvtbs is the bending mode of the molecule. used in xqv. 2535 if (isot.eq.1) call interdp (tvtbs,zyd,nzy, v626t1,zld,nl, 1)2536 if (isot.eq.2) call interdp (tvtbs,zyd,nzy, v628t1,zld,nl, 1)2537 if (isot.eq.3) call interdp (tvtbs,zyd,nzy, v636t1,zld,nl, 1)2538 if (isot.eq.4) call interdp (tvtbs,zyd,nzy, v627t1,zld,nl, 1)2539 if (isot.eq.5) call interdp (tvtbs,zyd,nzy, vcot1,zld,nl, 1)2538 if (isot.eq.1) call interdp (tvtbs,zyd,nzy,v626t1,zld,nl,1) 2539 if (isot.eq.2) call interdp (tvtbs,zyd,nzy,v628t1,zld,nl,1) 2540 if (isot.eq.3) call interdp (tvtbs,zyd,nzy,v636t1,zld,nl,1) 2541 if (isot.eq.4) call interdp (tvtbs,zyd,nzy,v627t1,zld,nl,1) 2542 if (isot.eq.5) call interdp (tvtbs,zyd,nzy,vcot1,zld,nl,1) 2540 2543 2541 2544 ! tvt0 is the lower level of the transition. used in xlower. 2542 2545 if (ib.eq.2 .or. ib.eq.3 .or. ib.eq.4 .or. ib.eq.15) then 2543 if (isot.eq.1) call interdp (tvt0,zyd,nzy, v626t1,zld,nl, 1)2544 if (isot.eq.2) call interdp (tvt0,zyd,nzy, v628t1,zld,nl, 1)2545 if (isot.eq.3) call interdp (tvt0,zyd,nzy, v636t1,zld,nl, 1)2546 if (isot.eq.4) call interdp (tvt0,zyd,nzy, v627t1,zld,nl, 1)2546 if (isot.eq.1) call interdp(tvt0,zyd,nzy,v626t1,zld,nl,1) 2547 if (isot.eq.2) call interdp(tvt0,zyd,nzy,v628t1,zld,nl,1) 2548 if (isot.eq.3) call interdp(tvt0,zyd,nzy,v636t1,zld,nl,1) 2549 if (isot.eq.4) call interdp(tvt0,zyd,nzy,v627t1,zld,nl,1) 2547 2550 elseif (ib.eq.6 .or. ib.eq.8 .or. ib.eq.10 2548 2551 @ .or. ib.eq.13 .or. ib.eq.14 2549 2552 @ .or. ib.eq.17 .or. ib.eq.19 .or. ib.eq.20) then 2550 if (isot.eq.1) call interdp ( tvt0,zyd,nzy, v626t2,zld,nl, 1)2551 if (isot.eq.2) call interdp ( tvt0,zyd,nzy, v628t2,zld,nl, 1)2552 if (isot.eq.3) call interdp ( tvt0,zyd,nzy, v636t2,zld,nl, 1)2553 if (isot.eq.1) call interdp(tvt0,zyd,nzy,v626t2,zld,nl,1) 2554 if (isot.eq.2) call interdp(tvt0,zyd,nzy,v628t2,zld,nl,1) 2555 if (isot.eq.3) call interdp(tvt0,zyd,nzy,v636t2,zld,nl,1) 2553 2556 if (isot.eq.4) then 2554 2557 call interdp ( tvt0,zyd,nzy, v627t2,zld,nl, 1 ) … … 2566 2569 c tvt1 is the upper level of the transition. 2567 2570 if (ib.eq.13 .or. ib.eq.14) then 2568 if (isot.eq.1) call interdp ( tvt1,zyd,nzy, v626t4,zld,nl, 1)2569 if (isot.eq.2) call interdp ( tvt1,zyd,nzy, v628t4,zld,nl, 1)2570 if (isot.eq.3) call interdp ( tvt1,zyd,nzy, v636t4,zld,nl, 1)2571 if (isot.eq.4) call interdp ( tvt1,zyd,nzy, v627t4,zld,nl, 1)2571 if (isot.eq.1) call interdp(tvt1,zyd,nzy,v626t4,zld,nl,1) 2572 if (isot.eq.2) call interdp(tvt1,zyd,nzy,v628t4,zld,nl,1) 2573 if (isot.eq.3) call interdp(tvt1,zyd,nzy,v636t4,zld,nl,1) 2574 if (isot.eq.4) call interdp(tvt1,zyd,nzy,v627t4,zld,nl,1) 2572 2575 end if 2573 2576 … … 2586 2589 2587 2590 !!! vt of the 3 levels in (020) (see pag. 36a-sn1 for this) 2588 xalfa = 1.d0/2.d0* exp( dble(-ee*(nu12_1000-nu(1,2))/ty(i)))2589 xbeta = 1.d0/2.d0* exp( dble(-ee*(nu12_0200-nu(1,2))/ty(i)))2591 xalfa = 1.d0/2.d0*exp(dble(-ee*(nu12_1000-nu(1,2))/ty(i))) 2592 xbeta = 1.d0/2.d0*exp(dble(-ee*(nu12_0200-nu(1,2))/ty(i))) 2590 2593 xtv0200 = dble( - ee * nu12_0200 ) / 2591 2594 @ ( log( xbeta/(1.d0+xalfa+xbeta) ) - … … 2603 2606 @ ( log(2./(1.d0+xalfa+xbeta)) - ee*nu(1,2)/tvt0(i) ) ) 2604 2607 xtv1000 = dble( - ee * nu12_1000 / 2605 @ ( 2608 @ (log(4.*xalfa/(1.d0+xalfa+xbeta))-ee*nu(1,2)/tvt0(i))) 2606 2609 2607 2610 ! if ( icurt_pop.eq.30 ) then … … 4013 4016 !write (*,*) ' cm15um_hb/11 ' 4014 4017 !write (*,*) ' ib, ist, irw, imu =', ib, ist, irw_mztf, imu 4015 call mztf ( ig,cax1,cax2,cax3,v1,v2, ib,ist,irw_mztf,imu,4018 call mztf(ig,cax1,cax2,cax3,v1,v2,ib,ist,irw_mztf,imu, 4016 4019 @ itauout,icfout,itableout) 4017 4020 ! else -
trunk/LMDZ.MARS/libf/phymars/nlte_tcool.F
r498 r695 238 238 ! hrkday_factor(i) = hrkday_convert( t(i), 239 239 ! @ co2vmr(i), o3pvmr(i), n2vmr(i), covmr(i) ) 240 hrkday_factor(i) = hrkday_convert(mmean_nlte(i),cpnew_nlte(i)) 240 hrkday_factor(i) = hrkday_convert(mmean_nlte(i) 241 & ,cpnew_nlte(i)) 241 242 242 243 enddo -
trunk/LMDZ.MARS/libf/phymars/nuclea.F
r633 r695 161 161 !! ... + TERM B 162 162 yeah = (rap-cost)/yeah 163 fshape = fshape + rap*rap*rap*(2.-3.*yeah+yeah*yeah*yeah) 163 fshape = fshape + 164 & rap*rap*rap*(2.-3.*yeah+yeah*yeah*yeah) 164 165 !! ... + TERM C 165 166 fshape = fshape + 3. * cost * rap * rap * (yeah-1.) -
trunk/LMDZ.MARS/libf/phymars/physiq.F
r674 r695 1527 1527 c "stats") only possible in 3D runs ! 1528 1528 1529 1530 1531 1532 1533 1529 IF (callstats) THEN 1530 1531 call wstats(ngrid,"ps","Surface pressure","Pa",2,ps) 1532 call wstats(ngrid,"tsurf","Surface temperature","K",2,tsurf) 1533 call wstats(ngrid,"co2ice","CO2 ice cover", 1534 1534 & "kg.m-2",2,co2ice) 1535 1535 call wstats(ngrid,"fluxsurf_lw", 1536 1536 & "Thermal IR radiative flux to surface","W.m-2",2, 1537 1537 & fluxsurf_lw) 1538 1538 call wstats(ngrid,"fluxsurf_sw", 1539 1539 & "Solar radiative flux to surface","W.m-2",2, 1540 1540 & fluxsurf_sw_tot) 1541 1541 call wstats(ngrid,"fluxtop_lw", 1542 1542 & "Thermal IR radiative flux to space","W.m-2",2, 1543 1543 & fluxtop_lw) 1544 1544 call wstats(ngrid,"fluxtop_sw", 1545 1545 & "Solar radiative flux to space","W.m-2",2, 1546 1546 & fluxtop_sw_tot) 1547 1548 1549 1547 call wstats(ngrid,"temp","Atmospheric temperature","K",3,zt) 1548 call wstats(ngrid,"u","Zonal (East-West) wind","m.s-1",3,zu) 1549 call wstats(ngrid,"v","Meridional (North-South) wind", 1550 1550 & "m.s-1",3,zv) 1551 1551 c call wstats(ngrid,"w","Vertical (down-up) wind", 1552 1552 c & "m.s-1",3,pw) 1553 1553 call wstats(ngrid,"rho","Atmospheric density","kg/m3",3,rho) 1554 1554 c call wstats(ngrid,"pressure","Pressure","Pa",3,pplay) 1555 1555 c call wstats(ngrid,"q2",
Note: See TracChangeset
for help on using the changeset viewer.