Ignore:
Timestamp:
Mar 4, 2004, 4:11:16 PM (20 years ago)
Author:
lmdzadmin
Message:

Optimisation de differentes routines, IM, MAF, FH
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/cv3_routines.F

    r486 r495  
    804804 110  continue
    805805
    806       do 121 j=1,ntra
    807 ccccc      do 111 k=1,nl+1
    808       do 111 k=1,nd
    809        nn=0
    810       do 101 i=1,len
    811       if(iflag1(i).eq.0)then
    812        nn=nn+1
    813        tra(nn,k,j)=tra1(i,k,j)
    814       endif
    815  101  continue
    816  111  continue
    817  121  continue
     806c      do 121 j=1,ntra
     807c      do 111 k=1,nd
     808c       nn=0
     809c      do 101 i=1,len
     810c      if(iflag1(i).eq.0)then
     811c       nn=nn+1
     812c       tra(nn,k,j)=tra1(i,k,j)
     813c      endif
     814c 101  continue
     815c 111  continue
     816c 121  continue
    818817
    819818      if (nn.ne.ncum) then
    … …  
    14931492 400  continue
    14941493
    1495       do k=1,ntra
    1496        do j=1,nd  ! instead nlp
    1497         do i=1,nd ! instead nlp
    1498          do il=1,ncum
    1499             traent(il,i,j,k)=tra(il,j,k)
    1500          enddo
    1501         enddo
    1502        enddo
    1503       enddo
     1494c      do k=1,ntra
     1495c       do j=1,nd  ! instead nlp
     1496c        do i=1,nd ! instead nlp
     1497c         do il=1,ncum
     1498c            traent(il,i,j,k)=tra(il,j,k)
     1499c         enddo
     1500c        enddo
     1501c       enddo
     1502c      enddo
    15041503      zm(:,:)=0.
    15051504
    … …  
    15571556 710  continue
    15581557
    1559        do k=1,ntra
    1560         do j=minorig,nl
    1561          do il=1,ncum
    1562           if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
    1563      :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
    1564             traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
    1565      :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
    1566           endif
    1567          enddo
    1568         enddo
    1569        enddo
     1558c       do k=1,ntra
     1559c        do j=minorig,nl
     1560c         do il=1,ncum
     1561c          if( (i.ge.icb(il)).and.(i.le.inb(il)).and.
     1562c     :       (j.ge.(icb(il)-1)).and.(j.le.inb(il)))then
     1563c            traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k)
     1564c     :            +(1.-sij(il,i,j))*tra(il,nk(il),k)
     1565c          endif
     1566c         enddo
     1567c        enddo
     1568c       enddo
    15701569
    15711570c
    … …  
    15901589 750  continue
    15911590 
    1592       do j=1,ntra
    1593        do i=minorig+1,nl
    1594         do il=1,ncum
    1595          if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
    1596           traent(il,i,i,j)=tra(il,nk(il),j)
    1597          endif
    1598         enddo
    1599        enddo
    1600       enddo
     1591c      do j=1,ntra
     1592c       do i=minorig+1,nl
     1593c        do il=1,ncum
     1594c         if (i.ge.icb(il) .and. i.le.inb(il) .and. nent(il,i).eq.0) then
     1595c          traent(il,i,i,j)=tra(il,nk(il),j)
     1596c         endif
     1597c        enddo
     1598c       enddo
     1599c      enddo
    16011600
    16021601      do 100 j=minorig,nl
    … …  
    17641763      enddo ! il
    17651764
    1766       do j=1,ntra
    1767        do il=1,ncum
    1768         if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
    1769      :     .and. csum(il,i).lt.m(il,i) ) then
    1770          traent(il,i,i,j)=tra(il,nk(il),j)
    1771         endif
    1772        enddo
    1773       enddo
    1774 
     1765c      do j=1,ntra
     1766c       do il=1,ncum
     1767c        if ( i.ge.icb(il) .and. i.le.inb(il) .and. lwork(il)
     1768c     :     .and. csum(il,i).lt.m(il,i) ) then
     1769c         traent(il,i,i,j)=tra(il,nk(il),j)
     1770c        endif
     1771c       enddo
     1772c      enddo
    17751773789   continue
    17761774c     
    … …  
    18691867        enddo
    18701868
    1871         do k=1,ntra
    1872          do i=1,nd
    1873           do il=1,ncum
    1874            trap(il,i,k)=tra(il,i,k)
    1875           enddo
    1876          enddo
    1877         enddo
     1869c        do k=1,ntra
     1870c         do i=1,nd
     1871c          do il=1,ncum
     1872c           trap(il,i,k)=tra(il,i,k)
     1873c          enddo
     1874c         enddo
     1875c        enddo
    18781876
    18791877c
    … …  
    21032101      vp(il,i)=vp(il,i)/mp(il,i)
    21042102
    2105       do j=1,ntra
    2106       trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
     2103c      do j=1,ntra
     2104c      trap(il,i,j)=trap(il,i+1,j)*mp(il,i+1)
    21072105ctestmaf     :            +trap(il,i,j)*(mp(il,i)-mp(il,i+1))
    2108      :            +tra(il,i,j)*(mp(il,i)-mp(il,i+1))
    2109       trap(il,i,j)=trap(il,i,j)/mp(il,i)
    2110       end do
     2106c     :            +tra(il,i,j)*(mp(il,i)-mp(il,i+1))
     2107c      trap(il,i,j)=trap(il,i,j)/mp(il,i)
     2108c      end do
    21112109
    21122110      else
    … …  
    21252123       vp(il,i)=vp(il,i+1)
    21262124
    2127        do j=1,ntra
    2128        trap(il,i,j)=trap(il,i+1,j)
    2129        end do
     2125c       do j=1,ntra
     2126c       trap(il,i,j)=trap(il,i+1,j)
     2127c       end do
    21302128
    21312129       endif
    … …  
    22262224      enddo
    22272225
    2228       do j=1,ntra
    2229        do i=1,nd
    2230         do il=1,ncum
    2231           ftra(il,i,j)=0.0
    2232         enddo
    2233        enddo
    2234       enddo
     2226c      do j=1,ntra
     2227c       do i=1,nd
     2228c        do il=1,ncum
     2229c          ftra(il,i,j)=0.0
     2230c        enddo
     2231c       enddo
     2232c      enddo
    22352233
    22362234      do i=1,nl
    … …  
    23302328      enddo ! il
    23312329
    2332       do j=1,ntra
    2333        do il=1,ncum
    2334         if (cvflag_grav) then
    2335          ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
    2336      :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
    2337      :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
    2338         else
    2339          ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
    2340      :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
    2341      :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
    2342         endif
    2343        enddo
    2344       enddo
     2330c      do j=1,ntra
     2331c       do il=1,ncum
     2332c        if (cvflag_grav) then
     2333c         ftra(il,1,j)=ftra(il,1,j)+0.01*grav*work(il)
     2334c     :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
     2335c     :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
     2336c        else
     2337c         ftra(il,1,j)=ftra(il,1,j)+0.1*work(il)
     2338c     :                     *(mp(il,2)*(trap(il,2,j)-tra(il,1,j))
     2339c     :             +am(il)*(tra(il,2,j)-tra(il,1,j)))
     2340c        endif
     2341c       enddo
     2342c      enddo
    23452343
    23462344      do j=2,nl
    … …  
    23662364      enddo
    23672365
    2368       do k=1,ntra
    2369        do j=2,nl
    2370         do il=1,ncum
    2371          if (j.le.inb(il)) then
    2372 
    2373           if (cvflag_grav) then
    2374            ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
    2375      :                *(traent(il,j,1,k)-tra(il,1,k))
    2376           else
    2377            ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
    2378      :                *(traent(il,j,1,k)-tra(il,1,k))
    2379           endif
    2380 
    2381          endif
    2382         enddo
    2383        enddo
    2384       enddo
     2366c      do k=1,ntra
     2367c       do j=2,nl
     2368c        do il=1,ncum
     2369c         if (j.le.inb(il)) then
     2370
     2371c          if (cvflag_grav) then
     2372c           ftra(il,1,k)=ftra(il,1,k)+0.01*grav*work(il)*ment(il,j,1)
     2373c     :                *(traent(il,j,1,k)-tra(il,1,k))
     2374c          else
     2375c           ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1)
     2376c     :                *(traent(il,j,1,k)-tra(il,1,k))
     2377c          endif
     2378
     2379c         endif
     2380c        enddo
     2381c       enddo
     2382c      enddo
    23852383
    23862384c
    … …  
    248824861350  continue
    24892487
    2490       do k=1,ntra
    2491        do il=1,ncum
    2492         if (i.le.inb(il)) then
    2493          dpinv=1.0/(ph(il,i)-ph(il,i+1))
    2494          cpinv=1.0/cpn(il,i)
    2495          if (cvflag_grav) then
    2496            ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
    2497      :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
    2498      :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
    2499          else
    2500            ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
    2501      :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
    2502      :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
    2503          endif
    2504         endif
    2505        enddo
    2506       enddo
     2488c      do k=1,ntra
     2489c       do il=1,ncum
     2490c        if (i.le.inb(il)) then
     2491c         dpinv=1.0/(ph(il,i)-ph(il,i+1))
     2492c         cpinv=1.0/cpn(il,i)
     2493c         if (cvflag_grav) then
     2494c           ftra(il,i,k)=ftra(il,i,k)+0.01*grav*dpinv
     2495c     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     2496c     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
     2497c         else
     2498c           ftra(il,i,k)=ftra(il,i,k)+0.1*dpinv
     2499c     :         *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k))
     2500c     :           -ad(il)*(tra(il,i,k)-tra(il,i-1,k)))
     2501c         endif
     2502c        endif
     2503c       enddo
     2504c      enddo
    25072505
    25082506      do 480 k=1,i-1
    … …  
    25382536480   continue
    25392537
    2540       do j=1,ntra
    2541        do k=1,i-1
    2542         do il=1,ncum
    2543          if (i.le.inb(il)) then
    2544           dpinv=1.0/(ph(il,i)-ph(il,i+1))
    2545           cpinv=1.0/cpn(il,i)
    2546           if (cvflag_grav) then
    2547            ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
    2548      :        *(traent(il,k,i,j)-tra(il,i,j))
    2549           else
    2550            ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
    2551      :        *(traent(il,k,i,j)-tra(il,i,j))
    2552           endif
    2553          endif
    2554         enddo
    2555        enddo
    2556       enddo
     2538c      do j=1,ntra
     2539c       do k=1,i-1
     2540c        do il=1,ncum
     2541c         if (i.le.inb(il)) then
     2542c          dpinv=1.0/(ph(il,i)-ph(il,i+1))
     2543c          cpinv=1.0/cpn(il,i)
     2544c          if (cvflag_grav) then
     2545c           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     2546c     :        *(traent(il,k,i,j)-tra(il,i,j))
     2547c          else
     2548c           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     2549c     :        *(traent(il,k,i,j)-tra(il,i,j))
     2550c          endif
     2551c         endif
     2552c        enddo
     2553c       enddo
     2554c      enddo
    25572555
    25582556      do 490 k=i,nl+1
    … …  
    25812579490   continue
    25822580
    2583       do j=1,ntra
    2584        do k=i,nl+1
    2585         do il=1,ncum
    2586          if (i.le.inb(il) .and. k.le.inb(il)) then
    2587           dpinv=1.0/(ph(il,i)-ph(il,i+1))
    2588           cpinv=1.0/cpn(il,i)
    2589           if (cvflag_grav) then
    2590            ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
    2591      :         *(traent(il,k,i,j)-tra(il,i,j))
    2592           else
    2593            ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
    2594      :             *(traent(il,k,i,j)-tra(il,i,j))
    2595           endif
    2596          endif ! i and k
    2597         enddo
    2598        enddo
    2599       enddo
     2581c      do j=1,ntra
     2582c       do k=i,nl+1
     2583c        do il=1,ncum
     2584c         if (i.le.inb(il) .and. k.le.inb(il)) then
     2585c          dpinv=1.0/(ph(il,i)-ph(il,i+1))
     2586c          cpinv=1.0/cpn(il,i)
     2587c          if (cvflag_grav) then
     2588c           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv*ment(il,k,i)
     2589c     :         *(traent(il,k,i,j)-tra(il,i,j))
     2590c          else
     2591c           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i)
     2592c     :             *(traent(il,k,i,j)-tra(il,i,j))
     2593c          endif
     2594c         endif ! i and k
     2595c        enddo
     2596c       enddo
     2597c      enddo
    26002598
    26012599      do 1400 il=1,ncum
    … …  
    26542652      enddo
    26552653
    2656       do j=1,ntra
    2657        do il=1,ncum
    2658         if (i.le.inb(il)) then
    2659          dpinv=1.0/(ph(il,i)-ph(il,i+1))
    2660          cpinv=1.0/cpn(il,i)
    2661 
    2662          if (cvflag_grav) then
    2663           ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
    2664      :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
    2665      :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
    2666          else
    2667           ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
    2668      :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
    2669      :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
    2670          endif
    2671         endif ! i
    2672        enddo
    2673       enddo
    2674 
     2654c      do j=1,ntra
     2655c       do il=1,ncum
     2656c        if (i.le.inb(il)) then
     2657c         dpinv=1.0/(ph(il,i)-ph(il,i+1))
     2658c         cpinv=1.0/cpn(il,i)
     2659
     2660c         if (cvflag_grav) then
     2661c          ftra(il,i,j)=ftra(il,i,j)+0.01*grav*dpinv
     2662c     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     2663c     :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
     2664c         else
     2665c          ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv
     2666c     :     *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j))
     2667c     :     -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j)))
     2668c         endif
     2669c        endif ! i
     2670c       enddo
     2671c      enddo
    26752672
    26762673500   continue
    … …  
    27152712503   continue
    27162713
    2717       do j=1,ntra
    2718        do il=1,ncum
    2719         ex=0.1*ment(il,inb(il),inb(il))
    2720      :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
    2721      :      /(ph(il,inb(il))-ph(il,inb(il)+1))
    2722         ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
    2723         ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
    2724      :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
    2725      :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
    2726        enddo
    2727       enddo
     2714c      do j=1,ntra
     2715c       do il=1,ncum
     2716c        ex=0.1*ment(il,inb(il),inb(il))
     2717c     :      *(traent(il,inb(il),inb(il),j)-tra(il,inb(il),j))
     2718c     :      /(ph(il,inb(il))-ph(il,inb(il)+1))
     2719c        ftra(il,inb(il),j)=ftra(il,inb(il),j)-ex
     2720c        ftra(il,inb(il)-1,j)=ftra(il,inb(il)-1,j)
     2721c     :       +ex*(ph(il,inb(il))-ph(il,inb(il)+1))
     2722c     :          /(ph(il,inb(il)-1)-ph(il,inb(il)))
     2723c       enddo
     2724c      enddo
    27282725
    27292726c
    … …  
    29812978        end
    29822979
     2980      SUBROUTINE cv3_tracer(nloc,len,ncum,nd,na,
     2981     &                        ment,sij,da,phi)
     2982        implicit none
     2983c inputs:
     2984        integer ncum, nd, na, nloc,len
     2985        real ment(nloc,na,na),sij(nloc,na,na)
     2986c ouputs:
     2987        real da(nloc,na),phi(nloc,na,na)
     2988c local variables:
     2989        integer i,j,k
     2990c       
     2991        da(:,:)=0.
     2992c
     2993        do j=1,na
     2994          do k=1,na
     2995            do i=1,ncum
     2996            da(i,j)=da(i,j)+(1.-sij(i,k,j))*ment(i,k,j)
     2997            phi(i,j,k)=sij(i,k,j)*ment(i,k,j)
     2998c            print *,'da',j,k,da(i,j),sij(i,k,j),ment(i,k,j)
     2999            end do
     3000          end do
     3001        end do
     3002   
     3003        return
     3004        end
     3005
    29833006
    29843007      SUBROUTINE cv3_uncompress(nloc,len,ncum,nd,ntra,idcum
    … …  
    30513074
    30523075
    3053         do 2100 j=1,ntra
    3054          do 2110 k=1,nd ! oct3
    3055           do 2120 i=1,ncum
    3056             ftra1(idcum(i),k,j)=ftra(i,k,j)
    3057  2120     continue
    3058  2110    continue
    3059  2100   continue
     3076c        do 2100 j=1,ntra
     3077c         do 2110 k=1,nd ! oct3
     3078c          do 2120 i=1,ncum
     3079c            ftra1(idcum(i),k,j)=ftra(i,k,j)
     3080c 2120     continue
     3081c 2110    continue
     3082c 2100   continue
    30603083
    30613084        return
Note: See TracChangeset for help on using the changeset viewer.