Changeset 1650 for LMDZ5/trunk/libf


Ignore:
Timestamp:
Sep 6, 2012, 3:25:45 PM (12 years ago)
Author:
Laurent Fairhead
Message:

Inclusion de modifications pour régler le problème convection/traceurs dans la nouvelle
physique

  1. Cozic

Modifications needed to correct the convection/tracers problem with the new physics

  1. Cozic
Location:
LMDZ5/trunk/libf/phylmd
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/concvl.F

    r1576 r1650  
    248248         DO i = 1, klon
    249249          cbmf(i) = 0.
    250 !          plcl(i) = 0.
     250          plcl(i) = 0.
    251251          sigd(i) = 0.
    252252         ENDDO
    … …  
    256256      plfc(:)  = 0.
    257257      wbeff(:) = 100.
    258       plcl(:) = 0.
    259258
    260259      DO k = 1, klev+1
    … …  
    369368     $              cape,cin,tvp,
    370369     $              dd_t,dd_q,Plim1,Plim2,asupmax,supmax0,
    371      $              asupmaxmin,lalim_conv)
     370     $              asupmaxmin,lalim_conv,
     371!AC!
     372     $              da,phi)
     373!AC!
    372374      endif 
    373375C------------------------------------------------------------------
    … …  
    399401       ENDDO
    400402       endif
     403
     404c!AC!
     405       if (iflag_con.eq.3) then
     406       DO itra = 1,ntra
     407        DO k = 1, klev
     408         DO i = 1, klon
     409            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
     410         ENDDO
     411        ENDDO
     412       ENDDO
     413       endif
     414c!AC!
    401415
    402416      DO k = 1, klev

  • LMDZ5/trunk/libf/phylmd/cv3_routines.F

    r1554 r1650  
    879879 110  continue
    880880
    881       do 121 j=1,ntra
    882 ccccc      do 111 k=1,nl+1
    883       do 111 k=1,nd
    884        nn=0
    885       do 101 i=1,len
    886       if(iflag1(i).eq.0)then
    887        nn=nn+1
    888        tra(nn,k,j)=tra1(i,k,j)
    889       endif
    890  101  continue
    891  111  continue
    892  121  continue
     881!AC!      do 121 j=1,ntra
     882!AC!ccccc      do 111 k=1,nl+1
     883!AC!      do 111 k=1,nd
     884!AC!       nn=0
     885!AC!      do 101 i=1,len
     886!AC!      if(iflag1(i).eq.0)then
     887!AC!       nn=nn+1
     888!AC!       tra(nn,k,j)=tra1(i,k,j)
     889!AC!      endif
     890!AC! 101  continue
     891!AC! 111  continue
     892!AC! 121  continue
    893893
    894894      if (nn.ne.ncum) then
    … …  
    16331633      sij(1:ncum,1:nd,1:nd)=0.0
    16341634     
    1635       do k=1,ntra
    1636        do j=1,nd  ! instead nlp
    1637         do i=1,nd ! instead nlp
    1638          do il=1,ncum
    1639             traent(il,i,j,k)=tra(il,j,k)
    1640          enddo
    1641         enddo
    1642        enddo
    1643       enddo
     1635!AC!      do k=1,ntra
     1636!AC!       do j=1,nd  ! instead nlp
     1637!AC!        do i=1,nd ! instead nlp
     1638!AC!         do il=1,ncum
     1639!AC!            traent(il,i,j,k)=tra(il,j,k)
     1640!AC!         enddo
     1641!AC!        enddo
     1642!AC!       enddo
     1643!AC!      enddo
    16441644      zm(:,:)=0.
    16451645
    … …  
    16971697 710  continue
    16981698
    1699        do k=1,ntra
    1700         do j=minorig,nl
    1701          do il=1,ncum
    1702           if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
    1703      :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
    1704             traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
    1705      :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
    1706           endif
    1707          enddo
    1708         enddo
    1709        enddo
     1699!AC!       do k=1,ntra
     1700!AC!        do j=minorig,nl
     1701!AC!         do il=1,ncum
     1702!AC!          if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
     1703!AC!     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
     1704!AC!            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
     1705!AC!     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
     1706!AC!          endif
     1707!AC!         enddo
     1708!AC!        enddo
     1709!AC!       enddo
    17101710
    17111711c
    … …  
    17301730 750  continue
    17311731
    1732       do j=1,ntra
    1733        do i=minorig+1,nl
    1734         do il=1,ncum
    1735          if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
    1736           traent(il,i,i,j)=tra(il,nk(il),j)
    1737          endif
    1738         enddo
    1739        enddo
    1740       enddo
     1732!AC!      do j=1,ntra
     1733!AC!       do i=minorig+1,nl
     1734!AC!        do il=1,ncum
     1735!AC!         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
     1736!AC!          traent(il,i,i,j)=tra(il,nk(il),j)
     1737!AC!         endif
     1738!AC!        enddo
     1739!AC!       enddo
     1740!AC!      enddo
    17411741
    17421742      do 100 j=minorig,nl
    … …  
    19041904      enddo ! il
    19051905
    1906       do j=1,ntra
    1907        do il=1,ncum
    1908         if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
    1909      :     .and. csum(il,i).lt.m(il,i) ) then
    1910          traent(il,i,i,j)=tra(il,nk(il),j)
    1911         endif
    1912        enddo
    1913       enddo
     1906!AC!      do j=1,ntra
     1907!AC!       do il=1,ncum
     1908!AC!        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
     1909!AC!     :     .and. csum(il,i).lt.m(il,i) ) then
     1910!AC!         traent(il,i,i,j)=tra(il,nk(il),j)
     1911!AC!        endif
     1912!AC!       enddo
     1913!AC!      enddo
    19141914789   continue
    19151915c     
    … …  
    20142014         enddo
    20152015        enddo
    2016         do k=1,ntra
    2017          do i=1,nd
    2018           do il=1,ncum
    2019            trap(il,i,k)=tra(il,i,k)
    2020           enddo
    2021          enddo
    2022         enddo
     2016!AC!        do k=1,ntra
     2017!AC!         do i=1,nd
     2018!AC!          do il=1,ncum
     2019!AC!           trap(il,i,k)=tra(il,i,k)
     2020!AC!          enddo
     2021!AC!         enddo
     2022!AC!        enddo
    20232023c
    20242024c   ***  check whether ep(inb)=0, if so, skip precipitating    ***
    … …  
    23412341c    ***       find tracer concentrations in precipitating downdraft     ***
    23422342c
    2343       do j=1,ntra
    2344        do il = 1,ncum
    2345        if (i.lt.inb(il) .and. lwork(il)) then
    2346 c
    2347          if(mplus(il))then
    2348           trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
    2349      :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
    2350           trap(il,i,j)=trap(il,i,j)/mp(il,i)
    2351          else ! if (mplus(il))
    2352           if(mp(il,i+1).gt.1.0e-16)then
    2353            trap(il,i,j)=trap(il,i+1,j)
    2354           endif
    2355          endif ! (mplus(il)) else if (.not.mplus(il))
    2356 c
    2357         endif ! (i.lt.inb(il) .and. lwork(il))
    2358        enddo
    2359       end do
     2343!AC!      do j=1,ntra
     2344!AC!       do il = 1,ncum
     2345!AC!       if (i.lt.inb(il) .and. lwork(il)) then
     2346!AC!c
     2347!AC!         if(mplus(il))then
     2348!AC!          trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
     2349!AC!     :              +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
     2350!AC!          trap(il,i,j)=trap(il,i,j)/mp(il,i)
     2351!AC!         else ! if (mplus(il))
     2352!AC!          if(mp(il,i+1).gt.1.0e-16)then
     2353!AC!           trap(il,i,j)=trap(il,i+1,j)
     2354!AC!          endif
     2355!AC!         endif ! (mplus(il)) else if (.not.mplus(il))
     2356!AC!c
     2357!AC!        endif ! (i.lt.inb(il) .and. lwork(il))
     2358!AC!       enddo
     2359!AC!      end do
    23602360
    23612361400   continue
    … …  
    24842484      enddo
    24852485c       print*,'cv3_yield initialisation 2'
    2486       do j=1,ntra
    2487        do i=1,nd
    2488         do il=1,ncum
    2489           ftra(il,i,j)=0.0
    2490         enddo
    2491        enddo
    2492       enddo
     2486!AC!      do j=1,ntra
     2487!AC!       do i=1,nd
     2488!AC!        do il=1,ncum
     2489!AC!          ftra(il,i,j)=0.0
     2490!AC!        enddo
     2491!AC!       enddo
     2492!AC!      enddo
    24932493c       print*,'cv3_yield initialisation 3'
    24942494      do i=1,nl
    … …  
    26492649
    26502650
    2651       do j=1,ntra
    2652        do il=1,ncum
    2653         if (iflag(il) .le. 1) then
    2654         if (cvflag_grav) then
    2655          ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
    2656      :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
    2657      :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
    2658         else
    2659          ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
    2660      :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
    2661      :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
    2662         endif
    2663         endif  ! iflag
    2664        enddo
    2665       enddo
     2651!AC!     do j=1,ntra
     2652!AC!      do il=1,ncum
     2653!AC!       if (iflag(il) .le. 1) then
     2654!AC!       if (cvflag_grav) then
     2655!AC!        ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
     2656!AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
     2657!AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
     2658!AC!       else
     2659!AC!        ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
     2660!AC!    :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
     2661!AC!    :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
     2662!AC!       endif
     2663!AC!       endif  ! iflag
     2664!AC!      enddo
     2665!AC!     enddo
    26662666
    26672667       do j=2,nl
    … …  
    26872687      enddo
    26882688
    2689       do k=1,ntra
    2690        do j=2,nl
    2691         do il=1,ncum
    2692          if (j.le.inb(il) .and. iflag(il) .le. 1) then
    2693 
    2694           if (cvflag_grav) then
    2695            ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
    2696      :                *(traent(il,j,1,k)-tra(il,1,k))
    2697           else
    2698            ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
    2699      :                *(traent(il,j,1,k)-tra(il,1,k))
    2700           endif
    2701 
    2702          endif
    2703         enddo
    2704        enddo
    2705       enddo
     2689!AC!      do k=1,ntra
     2690!AC!       do j=2,nl
     2691!AC!        do il=1,ncum
     2692!AC!         if (j.le.inb(il) .and. iflag(il) .le. 1) then
     2693!AC!
     2694!AC!          if (cvflag_grav) then
     2695!AC!           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
     2696!AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
     2697!AC!          else
     2698!AC!           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
     2699!AC!     :                *(traent(il,j,1,k)-tra(il,1,k))
     2700!AC!          endif
     2701!AC!
     2702!AC!         endif
     2703!AC!        enddo
     2704!AC!       enddo
     2705!AC!      enddo
    27062706c      print*,'cv3_yield apres ft'
    27072707c
    … …  
    286528651350  continue
    28662866
    2867       do k=1,ntra
    2868        do il=1,ncum
    2869         if (i.le.inb(il) .and. iflag(il) .le. 1) then
    2870          dpinv=1.0/(ph(il,i)-ph(il,i+1))
    2871          cpinv=1.0/cpn(il,i)
    2872          if (cvflag_grav) then
    2873            ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
    2874      :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
    2875      :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
    2876          else
    2877            ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
    2878      :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
    2879      :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
    2880          endif
    2881         endif
    2882        enddo
    2883       enddo
     2867!AC!      do k=1,ntra
     2868!AC!       do il=1,ncum
     2869!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) then
     2870!AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
     2871!AC!         cpinv=1.0/cpn(il,i)
     2872!AC!         if (cvflag_grav) then
     2873!AC!           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
     2874!AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     2875!AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
     2876!AC!         else
     2877!AC!           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
     2878!AC!     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     2879!AC!     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
     2880!AC!         endif
     2881!AC!        endif
     2882!AC!       enddo
     2883!AC!      enddo
    28842884
    28852885      do 480 k=1,i-1
    … …  
    29382938480   continue
    29392939
    2940       do j=1,ntra
    2941        do k=1,i-1
    2942         do il=1,ncum
    2943          if (i.le.inb(il) .and. iflag(il) .le. 1) then
    2944           dpinv=1.0/(ph(il,i)-ph(il,i+1))
    2945           cpinv=1.0/cpn(il,i)
    2946           if (cvflag_grav) then
    2947            ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
    2948      :        *(traent(il,k,i,j)-tra(il,i,j))
    2949           else
    2950            ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
    2951      :        *(traent(il,k,i,j)-tra(il,i,j))
    2952           endif
    2953          endif
    2954         enddo
    2955        enddo
    2956       enddo
     2940!AC!      do j=1,ntra
     2941!AC!       do k=1,i-1
     2942!AC!        do il=1,ncum
     2943!AC!         if (i.le.inb(il) .and. iflag(il) .le. 1) then
     2944!AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
     2945!AC!          cpinv=1.0/cpn(il,i)
     2946!AC!          if (cvflag_grav) then
     2947!AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     2948!AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
     2949!AC!          else
     2950!AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     2951!AC!     :        *(traent(il,k,i,j)-tra(il,i,j))
     2952!AC!          endif
     2953!AC!         endif
     2954!AC!        enddo
     2955!AC!       enddo
     2956!AC!      enddo
    29572957
    29582958      do 490 k=i,nl+1
    … …  
    30043004490   continue
    30053005
    3006       do j=1,ntra
    3007        do k=i,nl+1
    3008         do il=1,ncum
    3009          if (i.le.inb(il) .and. k.le.inb(il)
    3010      $                .and. iflag(il) .le. 1) then
    3011           dpinv=1.0/(ph(il,i)-ph(il,i+1))
    3012           cpinv=1.0/cpn(il,i)
    3013           if (cvflag_grav) then
    3014            ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
    3015      :         *(traent(il,k,i,j)-tra(il,i,j))
    3016           else
    3017            ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
    3018      :             *(traent(il,k,i,j)-tra(il,i,j))
    3019           endif
    3020          endif ! i and k
    3021         enddo
    3022        enddo
    3023       enddo
     3006!AC!      do j=1,ntra
     3007!AC!       do k=i,nl+1
     3008!AC!        do il=1,ncum
     3009!AC!         if (i.le.inb(il) .and. k.le.inb(il)
     3010!AC!     $                .and. iflag(il) .le. 1) then
     3011!AC!          dpinv=1.0/(ph(il,i)-ph(il,i+1))
     3012!AC!          cpinv=1.0/cpn(il,i)
     3013!AC!          if (cvflag_grav) then
     3014!AC!           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     3015!AC!     :         *(traent(il,k,i,j)-tra(il,i,j))
     3016!AC!          else
     3017!AC!           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     3018!AC!     :             *(traent(il,k,i,j)-tra(il,i,j))
     3019!AC!          endif
     3020!AC!         endif ! i and k
     3021!AC!        enddo
     3022!AC!       enddo
     3023!AC!      enddo
    30243024
    30253025c sb: interface with the cloud parameterization:          ! cld
    … …  
    30523052      enddo
    30533053
    3054       do j=1,ntra
    3055        do il=1,ncum
    3056         if (i.le.inb(il) .and. iflag(il) .le. 1) then
    3057          dpinv=1.0/(ph(il,i)-ph(il,i+1))
    3058          cpinv=1.0/cpn(il,i)
    3059 
    3060          if (cvflag_grav) then
    3061           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
    3062      :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
    3063      :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
    3064          else
    3065           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
    3066      :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
    3067      :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
    3068          endif
    3069         endif ! i
    3070        enddo
    3071       enddo
     3054!AC!      do j=1,ntra
     3055!AC!       do il=1,ncum
     3056!AC!        if (i.le.inb(il) .and. iflag(il) .le. 1) then
     3057!AC!         dpinv=1.0/(ph(il,i)-ph(il,i+1))
     3058!AC!         cpinv=1.0/cpn(il,i)
     3059!AC!
     3060!AC!         if (cvflag_grav) then
     3061!AC!          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
     3062!AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     3063!AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
     3064!AC!         else
     3065!AC!          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
     3066!AC!     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     3067!AC!     :     -mp(il,i)*(trap(il,i,j)-trap(il,i-1,j)))
     3068!AC!         endif
     3069!AC!        endif ! i
     3070!AC!       enddo
     3071!AC!      enddo
    30723072
    30733073
    … …  
    31463146503   continue
    31473147
    3148       do j=1,ntra
    3149        do il=1,ncum
    3150         IF (iflag(il) .le. 1) THEN
    3151         IF (cvflag_grav) then
    3152         ex=0.01*grav*ment(il,inb(il),inb(il))
    3153      :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
    3154      :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
    3155         ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
    3156         ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
    3157      :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
    3158      :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
    3159         else
    3160         ex=0.1*ment(il,inb(il),inb(il))
    3161      :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
    3162      :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
    3163         ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
    3164         ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
    3165      :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
    3166      :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
    3167         ENDIF   !cvflag grav
    3168         ENDIF    !iflag
    3169        enddo
    3170       enddo
     3148!AC!      do j=1,ntra
     3149!AC!       do il=1,ncum
     3150!AC!        IF (iflag(il) .le. 1) THEN
     3151!AC!    IF (cvflag_grav) then
     3152!AC!        ex=0.01*grav*ment(il,inb(il),inb(il))
     3153!AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
     3154!AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
     3155!AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
     3156!AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
     3157!AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
     3158!AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
     3159!AC!    else
     3160!AC!        ex=0.1*ment(il,inb(il),inb(il))
     3161!AC!     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
     3162!AC!     :      /(ph(i l,inb(il))-ph(il,inb(il)+1))
     3163!AC!        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
     3164!AC!        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
     3165!AC!     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
     3166!AC!     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
     3167!AC!        ENDIF   !cvflag grav
     3168!AC!        ENDIF    !iflag
     3169!AC!       enddo
     3170!AC!      enddo
    31713171
    31723172c
    … …  
    32873287      ENDDO
    32883288      ENDDO
    3289       DO j = 1,ntra
    3290       DO i = 1,nl
    3291        DO il = 1,ncum
    3292         IF (iflag(il) .le. 1) THEN
    3293          ftra(il,i,j) = ftra(il,i,j)/alpha_qpos(il)
    3294         ENDIF
    3295        ENDDO
    3296       ENDDO
    3297       ENDDO
     3289
     3290!AC!      DO j = 1,ntra
     3291!AC!      DO i = 1,nl
     3292!AC!       DO il = 1,ncum
     3293!AC!        IF (iflag(il) .le. 1) THEN
     3294!AC!         ftra(il,i,j) = ftra(il,i,j)/alpha_qpos(il)
     3295!AC!        ENDIF
     3296!AC!       ENDDO
     3297!AC!      ENDDO
     3298!AC!      ENDDO
    32983299
    32993300c
    … …  
    35393540        end
    35403541
     3542!AC!
     3543      SUBROUTINE cv3_tracer(nloc,len,ncum,nd,na,
     3544     &                        ment,sij,da,phi)
     3545        implicit none
     3546c inputs:
     3547        integer ncum, nd, na, nloc,len
     3548        real ment(nloc,na,na),sij(nloc,na,na)
     3549c ouputs:
     3550        real da(nloc,na),phi(nloc,na,na)
     3551c local variables:
     3552        integer i,j,k
     3553c       
     3554        da(:,:)=0.
     3555c
     3556        do j=1,na
     3557          do k=1,na
     3558            do i=1,ncum
     3559            da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j)
     3560            phi(i,j,k)=sij(i,k,j)*ment(i,k,j)
     3561            end do
     3562          end do
     3563        end do
     3564        return
     3565        end
     3566!AC!
    35413567
    35423568      SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
    … …  
    36093635
    36103636
    3611         do 2100 j=1,ntra
    3612 c oct3         do 2110 k=1,nl
    3613          do 2110 k=1,nd ! oct3
    3614           do 2120 i=1,ncum
    3615             ftra1(idcum(i),k,j)=ftra(i,k,j)
    3616  2120     continue
    3617  2110    continue
    3618  2100   continue
     3637!AC!        do 2100 j=1,ntra
     3638!AC!c oct3         do 2110 k=1,nl
     3639!AC!         do 2110 k=1,nd ! oct3
     3640!AC!          do 2120 i=1,ncum
     3641!AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
     3642!AC! 2120     continue
     3643!AC! 2110    continue
     3644!AC! 2100   continue
    36193645        return
    36203646        end

  • LMDZ5/trunk/libf/phylmd/cv3a_compress.F

    r1403 r1650  
    116116 110  continue
    117117
    118       do 121 j=1,ntra
    119 ccccc      do 111 k=1,nl+1
    120       do 111 k=1,nd
    121        nn=0
    122       do 101 i=1,len
    123       if(iflag1(i).eq.0)then
    124        nn=nn+1
    125        tra(nn,k,j)=tra1(i,k,j)
    126       endif
    127  101  continue
    128  111  continue
    129  121  continue
     118!AC!      do 121 j=1,ntra
     119!AC!ccccc      do 111 k=1,nl+1
     120!AC!      do 111 k=1,nd
     121!AC!       nn=0
     122!AC!      do 101 i=1,len
     123!AC!      if(iflag1(i).eq.0)then
     124!AC!       nn=nn+1
     125!AC!       tra(nn,k,j)=tra1(i,k,j)
     126!AC!      endif
     127!AC! 101  continue
     128!AC! 111  continue
     129!AC! 121  continue
    130130
    131131      if (nn.ne.ncum) then

  • LMDZ5/trunk/libf/phylmd/cv3a_uncompress.F

    r1518 r1650  
    99     :         ,Plim1,Plim2,asupmax,supmax0
    1010     :         ,asupmaxmin
     11!AC!
     12     :         ,da,phi
     13!AC!
    1114     o         ,iflag1,kbas1,ktop1
    1215     :         ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
    … …  
    1720     :         ,ftd1,fqd1
    1821     :         ,Plim11,Plim21,asupmax1,supmax01
    19      :         ,asupmaxmin1     )
     22     :         ,asupmaxmin1     
     23!AC!
     24     :         ,da1,phi1  )
     25!AC!
    2026***************************************************************
    2127*                                                             *
    … …  
    5056      real asupmax(nloc,nd),supmax0(nloc)
    5157      real asupmaxmin(nloc)
    52 
     58!AC!
     59      real da(nloc,nd),phi(nloc,nd,nd)
     60!AC!
    5361c outputs:
    5462      integer iflag1(len),kbas1(len),ktop1(len)
    … …  
    6876      real asupmax1(len,nd),supmax01(len)
    6977      real asupmaxmin1(len)
     78!AC!
     79      real da1(nloc,nd),phi1(nloc,nd,nd)
     80!AC!
    7081c
    7182c local variables:
    … …  
    111122            fqd1(idcum(i),k)=fqd(i,k)
    112123            asupmax1(idcum(i),k)=asupmax(i,k)
    113  2010     continue
     124!AC!
     125            da1(idcum(i),k)=da(i,k)
     126!AC!
     127 2010    continue
    114128 2020   continue
    115129
    … …  
    119133
    120134
    121         do 2100 j=1,ntra
    122 c oct3         do 2110 k=1,nl
    123          do 2110 k=1,nd ! oct3
    124           do 2120 i=1,ncum
    125             ftra1(idcum(i),k,j)=ftra(i,k,j)
    126  2120     continue
    127  2110    continue
    128  2100   continue
     135!AC!        do 2100 j=1,ntra
     136!AC!c oct3         do 2110 k=1,nl
     137!AC!         do 2110 k=1,nd ! oct3
     138!AC!          do 2120 i=1,ncum
     139!AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
     140!AC! 2120     continue
     141!AC! 2110    continue
     142!AC! 2100   continue
     143
     144!AC!
     145       do j=1,nd
     146         do k=1,nd
     147          do i=1,ncum
     148            phi1(idcum(i),k,j)=phi(i,k,j)
     149          end do
     150         end do
     151        end do
     152!AC!
     153
    129154c
    130155c        do 2220 k2=1,nd

  • LMDZ5/trunk/libf/phylmd/cv3p_mixing.F

    r1573 r1650  
    118118            elij(i,k,j)=0.0
    119119            hent(i,k,j)=0.0
    120             ment(i,k,j)=0.0
    121             sij(i,k,j)=0.0
     120!AC!            ment(i,k,j)=0.0
     121!AC!            sij(i,k,j)=0.0
    122122 385      continue
    123123 390    continue
    124124 400  continue
     125
     126!AC!
     127      ment(1:ncum,1:nd,1:nd)=0.0
     128      sij(1:ncum,1:nd,1:nd)=0.0
     129!AC!
    125130
    126131      do k=1,ntra

  • LMDZ5/trunk/libf/phylmd/regr_lat_time_climoz_m.F90

    r1635 r1650  
    224224    ! Get the  number of months:
    225225    call nf95_inq_dimid(ncid_in, "time", dimid)
    226     call nf95_inquire_dimension(ncid_in, dimid, nclen=n_month)
     226    call nf95_inquire_dimension(ncid_in, dimid, len=n_month)
    227227
    228228    allocate(o3_in(n_lat, n_plev, n_month, read_climoz))
Note: See TracChangeset for help on using the changeset viewer.