Ignore:
Timestamp:
Oct 29, 2009, 2:55:23 PM (15 years ago)
Author:
yann meurdesoif
Message:

Optimisations SX9

YM

Location:
LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar
Files:
1 added
1 deleted
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/calfis_p.F

    r1231 r1250  
    158158      REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
    159159c
    160 c      REAL,ALLOCATABLE,SAVE :: pvervel(:,:)
    161 c
    162160      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
    163161      REAL,ALLOCATABLE,SAVE :: zdtfi(:,:),zdqfi(:,:,:)
    … …  
    175173      REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:)
    176174      REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:)
    177 c      REAL,ALLOCATABLE,SAVE :: pvervel_omp(:,:)
    178175      REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:)
    179176      REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:)
    … …  
    252249      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
    253250      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
    254 c      ALLOCATE(pvervel(klon,llm))
    255251      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
    256252      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
    … …  
    278274
    279275c$OMP MASTER             
     276!CDIR ON_ADB(index_i)
     277!CDIR ON_ADB(index_j)
    280278      do ig0=1,klon
    281279        i=index_i(ig0)
    … …  
    300298c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    301299      DO l = 1, llmp1
     300!CDIR ON_ADB(index_i)
     301!CDIR ON_ADB(index_j)
    302302        do ig0=1,klon
    303303          i=index_i(ig0)
    … …  
    314314c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    315315      DO l=1,llm
    316 
     316!CDIR ON_ADB(index_i)
     317!CDIR ON_ADB(index_j)
    317318        do ig0=1,klon
    318319          i=index_i(ig0)
    … …  
    321322          zplay(ig0,l)   = preff * pksurcp ** unskap
    322323          ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
    323 c          pcvgt(ig0,l)   = pdteta(i,j,l) * pksurcp / pmasse(i,j,l)
    324324        enddo
    325325
    … …  
    335335c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    336336         DO l=1,llm
     337!CDIR ON_ADB(index_i)
     338!CDIR ON_ADB(index_j)
    337339           do ig0=1,klon
    338340             i=index_i(ig0)
    … …  
    344346      ENDDO
    345347
    346 c   convergence dynamique pour les traceurs "EAU"
    347 ! Earth-specific treatment of first 2 tracers (water)
    348       if (planet_type=="earth") then
    349        DO iq=1,2
    350 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    351          DO l=1,llm
    352            do ig0=1,klon
    353              i=index_i(ig0)
    354              j=index_j(ig0)
    355 c             pcvgq(ig0,l,iq) = pdq(i,j,l,iq) / pmasse(i,j,l)
    356            enddo
    357          ENDDO
    358 c$OMP END DO NOWAIT     
    359        ENDDO
    360       endif ! of if (planet_type=="earth")
    361 
    362348
    363349c   Geopotentiel calcule par rapport a la surface locale:
    … …  
    378364c$OMP END DO NOWAIT
    379365     
    380 c   ....  Calcul de la vitesse  verticale  ( en Pa*m*s  ou Kg/s )  ....
    381 c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux
    382 c      de masse est calclue dans advtrac_p.F 
    383 c
    384 cc$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    385 c      DO l=1,llm
    386 c        do ig0=1,klon
    387 c           i=index_i(ig0)
    388 c           j=index_j(ig0)
    389 c           pvervel(ig0,l) = pw(i,j,l)*g* unsaire(i,j)
    390 c        enddo
    391 c       if (is_north_pole) pvervel(1,l)=pw(1,1,l)*g /apoln
    392 c       if (is_south_pole) pvervel(klon,l)=pw(1,jjp1,l)*g/apols
    393 c      ENDDO
    394 cc$OMP END DO NOWAIT
    395366
    396367c
    … …  
    406377c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    407378      DO l=1,llm
     379!CDIR ON_ADB(index_i)
     380!CDIR ON_ADB(index_j)
     381!CDIR SPARSE
    408382        do ig0=kstart,kend
    409383          i=index_i(ig0)
    … …  
    412386            zufi(ig0,l)= 0.5 *(  pucov(iim,j,l)/cu(iim,j)
    413387     $                         + pucov(1,j,l)/cu(1,j) )
    414 c            pcvgu(ig0,l)= 0.5*(  pducov(iim,j,l)/cu(iim,j)
    415 c     $                         + pducov(1,j,l)/cu(1,j) )
    416388          else
    417389            zufi(ig0,l)= 0.5*(  pucov(i-1,j,l)/cu(i-1,j)
    418390     $                       + pucov(i,j,l)/cu(i,j) )
    419 c            pcvgu(ig0,l)= 0.5*(  pducov(i-1,j,l)/cu(i-1,j)
    420 c     $                        + pducov(i,j,l)/cu(i,j) )
    421391          endif
    422392        enddo
    423393      ENDDO
    424394c$OMP END DO NOWAIT
     395
    425396c   46.champ v:
    426397c   -----------
     398
    427399c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    428400      DO l=1,llm
     401!CDIR ON_ADB(index_i)
     402!CDIR ON_ADB(index_j)
    429403        DO ig0=kstart,kend
    430404          i=index_i(ig0)
    … …  
    433407     $                       + pvcov(i,j,l)/cv(i,j) )
    434408   
    435 c          pcvgv(ig0+i,l)= 0.5 * (  pdvcov(i,j-1,l)/cv(i,j-1)
    436 c     $                           + pdvcov(i,j,l)/cv(i,j) )
    437409         ENDDO
    438410      ENDDO
    … …  
    449421
    450422           z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,1,l)/cv(1,1)
    451 c           z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,1,l)/cv(1,1)
    452423           DO i=2,iim
    453424              z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,1,l)/cv(i,1)
    454 c              z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,1,l)/cv(i,1)
    455425           ENDDO
    456426 
    457427           DO i=1,iim
    458428              zcos(i)   = COS(rlonv(i))*z1(i)
    459 c              zcosbis(i)= COS(rlonv(i))*z1bis(i)
    460429              zsin(i)   = SIN(rlonv(i))*z1(i)
    461 c              zsinbis(i)= SIN(rlonv(i))*z1bis(i)
    462430           ENDDO
    463431 
    464432           zufi(1,l)  = SSUM(iim,zcos,1)/pi
    465 c           pcvgu(1,l) = SSUM(iim,zcosbis,1)/pi
    466433           zvfi(1,l)  = SSUM(iim,zsin,1)/pi
    467 c           pcvgv(1,l) = SSUM(iim,zsinbis,1)/pi
    468434 
    469435        ENDDO
    … …  
    482448 
    483449         z1(1)   =(rlonu(1)-rlonu(iim)+2.*pi)*pvcov(1,jjm,l)/cv(1,jjm)
    484 c         z1bis(1)=(rlonu(1)-rlonu(iim)+2.*pi)*pdvcov(1,jjm,l)/cv(1,jjm)
    485450           DO i=2,iim
    486            z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
    487 c           z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm)
     451             z1(i)   =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm)
    488452           ENDDO
    489453 
    490454           DO i=1,iim
    491455              zcos(i)    = COS(rlonv(i))*z1(i)
    492 c              zcosbis(i) = COS(rlonv(i))*z1bis(i)
    493456              zsin(i)    = SIN(rlonv(i))*z1(i)
    494 c              zsinbis(i) = SIN(rlonv(i))*z1bis(i)
    495457           ENDDO
    496458 
    497459           zufi(klon,l)  = SSUM(iim,zcos,1)/pi
    498 c           pcvgu(klon,l) = SSUM(iim,zcosbis,1)/pi
    499460           zvfi(klon,l)  = SSUM(iim,zsin,1)/pi
    500 c           pcvgv(klon,l) = SSUM(iim,zsinbis,1)/pi
    501 
    502461        ENDDO
    503462c$OMP END DO NOWAIT       
    … …  
    506465
    507466      IF (is_sequential) THEN
    508         if (planet_type=="earth") then
    509 #ifdef CPP_EARTH
    510467c
    511468cIM calcul PV a teta=350, 380, 405K
    … …  
    514471     $           ntetaSTD,rtetaSTD,PVteta)
    515472c
    516 #endif
    517         endif
    518473      ENDIF
    519474
    … …  
    525480c   ---------------------
    526481
    527 cc$OMP  PARALLEL DEFAULT(NONE)
    528 cc$OMP+ PRIVATE(i,l,offset,iq)
    529 cc$OMP+ SHARED(klon_omp_nb,nqtot,klon_omp_begin,
    530 cc$OMP+        debut,lafin,rdayvrai,heure,dtphys,zplev,zplay,
    531 cc$OMP+        zphi,zphis,presnivs,clesphy0,zufi,zvfi,ztfi,
    532 cc$OMP+        zqfi,pvervel,zdufi,zdvfi,zdtfi,zdqfi,zdpsrf)
    533 
    534 c PRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
    535 c c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
    536 c c$OMP+                 zqfi_omp,pvervel_omp,zdufi_omp,zdvfi_omp,
    537 c c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp)
    538482
    539483c$OMP BARRIER
    … …  
    550494        allocate(ztfi_omp(klon,llm))
    551495        allocate(zqfi_omp(klon,llm,nqtot))
    552 c        allocate(pvervel_omp(klon,llm))
    553496        allocate(zdufi_omp(klon,llm))
    554497        allocate(zdvfi_omp(klon,llm))
    … …  
    617560      enddo
    618561       
    619 c      do l=1,llm
    620 c        do i=1,klon
    621 c         pvervel_omp(i,l)=pvervel(offset+i,l)
    622 c       enddo
    623 c      enddo
    624        
    625562      do l=1,llm
    626563        do i=1,klon
    … …  
    660597     
    661598c$OMP BARRIER
    662 cym      call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
    663599     
    664600      if (planet_type=="earth") then
    … …  
    681617     .             ztfi_omp,
    682618     .             zqfi_omp,
    683 c     .             pvervel_omp,
    684619c#ifdef INCA
    685620     .             flxwfi_omp,
    … …  
    695630#endif
    696631      endif !of if (planet_type=="earth")
    697 
    698 cym      call WriteField_phy_p('zdtfi_omp',zdtfi_omp(:,:),llm)
    699 
    700632c$OMP BARRIER
    701633
    … …  
    753685        enddo
    754686      enddo
    755        
    756 c      do l=1,llm
    757 c        do i=1,klon
    758 c         pvervel(offset+i,l)=pvervel_omp(i,l)
    759 c       enddo
    760 c      enddo
    761687       
    762688      do l=1,llm
    … …  
    791717     
    792718
    793 cc$OMP END PARALLEL
    794719      klon=klon_mpi
    795720500   CONTINUE
    … …  
    797722
    798723c$OMP MASTER
    799 cym      call WriteField_phy('zdtfi',zdtfi(:,:),llm)
    800724      call stop_timer(timer_physic)
    801725c$OMP END MASTER
    … …  
    913837      DO l=1,llm
    914838
    915 !!cdir NODEP
     839!CDIR ON_ADB(index_i)
     840!CDIR ON_ADB(index_j)
     841!cdir NODEP
    916842        do ig0=kstart,kend
    917843          i=index_i(ig0)
    … …  
    975901
    976902C
    977 
     903!cdir NODEP
    978904      DO iq=1,nqtot
    979905         iiq=niadv(iq)
    980906c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    981907         DO l=1,llm
    982 
    983 !!cdir NODEP           
     908!CDIR ON_ADB(index_i)
     909!CDIR ON_ADB(index_j)
     910!cdir NODEP           
    984911             DO ig0=kstart,kend
    985912              i=index_i(ig0)
    … …  
    1009936c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1010937      DO l=1,llm
    1011 !!cdir NODEP
     938!CDIR ON_ADB(index_i)
     939!CDIR ON_ADB(index_j)
     940!cdir NODEP
    1012941         do ig0=kstart,kend
    1013942           i=index_i(ig0)
    … …  
    1052981c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    1053982      DO l=1,llm
    1054 !!cdir NODEP
     983!CDIR ON_ADB(index_i)
     984!CDIR ON_ADB(index_j)
     985!cdir NODEP
    1055986        do ig0=kstart,kend
    1056987           i=index_i(ig0)

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/cray.F

    r774 r1250  
    1313      real sx((n-1)*incx+1),sy((n-1)*incy+1)
    1414c
     15      if (incx.eq.1.and.incy.eq.1) then
     16      do 10 i=1,n
     17         sy(i)=sx(i)
     1810    continue
     19      else
    1520      iy=1
    1621      ix=1
    17       do 10 i=1,n
     22      do 11 i=1,n
    1823         sy(iy)=sx(ix)
    1924         ix=ix+incx
    2025         iy=iy+incy
    21 10    continue
     2611    continue
     27      endif
    2228c
    2329      return
    … …  
    3238c
    3339      ssum=0.
     40      if (incx.eq.1) then
     41      do 10 i=1,n
     42         ssum=ssum+sx(i)
     4310    continue
     44      else
    3445      ix=1
    35       do 10 i=1,n
     46      do 11 i=1,n
    3647         ssum=ssum+sx(ix)
    3748         ix=ix+incx
    38 10    continue
     4911    continue
     50      endif
    3951c
    4052      return

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/groupeun_p.F

    r1087 r1250  
    11      SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q)
    22      USE parallel
     3      USE Write_Field_p
    34      IMPLICIT NONE
    45
    … …  
    1718      REAL airecs,qs
    1819
    19       INTEGER i,j,l,ig,j1,j2,i0,jd
     20      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
    2021
    2122c--------------------------------------------------------------------c
    … …  
    3738      LOGICAL, SAVE :: first = .TRUE.
    3839!$OMP THREADPRIVATE(first)
     40      INTEGER,SAVE :: i_index(iim,ngroup)
     41      INTEGER      :: offset
     42      REAL         :: qsum(iim/ngroup)
    3943
    4044      IF (first) THEN
    … …  
    5458            j_start  = MAX(jjb, j1-jd)
    5559            j_finish = MIN(jje, j2-jd)
    56             DO j=j_start, j_finish
    57                DO i0=1,iim,2**(ngroup-ig+1)
    58                   qn=0.
    59                   DO i=i0,i0+2**(ngroup-ig+1)-1
    60                      qn=qn+q(i,j,l)
    61                   ENDDO
    62                   DO i=i0,i0+2**(ngroup-ig+1)-1
    63                      q(i,j,l)=qn*airen_tab(i,j,jd)
    64                   ENDDO
     60            DO ig2=1,ngroup-ig+1
     61              offset=2**(ig2-1)
     62              DO j=j_start, j_finish
     63!CDIR NODEP
     64!CDIR ON_ADB(q)
     65                 DO i0=1,iim,2**ig2
     66                   q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l)
     67                 ENDDO
     68              ENDDO
     69            ENDDO
     70           
     71            DO j=j_start, j_finish
     72!CDIR NODEP
     73!CDIR ON_ADB(q)
     74               DO i=1,iim
     75                 q(i,j,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),j,l)
     76               ENDDO
     77            ENDDO
     78
     79            DO j=j_start, j_finish
     80!CDIR ON_ADB(airen_tab)
     81!CDIR ON_ADB(q)
     82               DO i=1,iim
     83                 q(i,j,l)=q(i,j,l)*airen_tab(i,j,jd)
    6584               ENDDO
    6685               q(iip1,j,l)=q(1,j,l)
    6786            ENDDO
    68         
     87       
    6988!c     Concerne le pole sud
    7089            j_start  = MAX(1+jjp1-jje-jd, j1-jd)
    7190            j_finish = MIN(1+jjp1-jjb-jd, j2-jd)
    72             DO j=j_start, j_finish
    73                DO i0=1,iim,2**(ngroup-ig+1)
    74                   qs=0.
    75                   DO i=i0,i0+2**(ngroup-ig+1)-1
    76                      qs=qs+q(i,jjp1-j+1-jd,l)
    77                   ENDDO
    78                   DO i=i0,i0+2**(ngroup-ig+1)-1
    79                      q(i,jjp1-j+1-jd,l)=qs*aires_tab(i,jjp1-j+1,jd)
    80                   ENDDO
     91            DO ig2=1,ngroup-ig+1
     92              offset=2**(ig2-1)
     93              DO j=j_start, j_finish
     94!CDIR NODEP
     95!CDIR ON_ADB(q)
     96                 DO i0=1,iim,2**ig2
     97                   q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l)
     98     &                                 +q(i0+offset,jjp1-j+1-jd,l)
     99                 ENDDO
     100              ENDDO
     101            ENDDO
     102
     103
     104            DO j=j_start, j_finish
     105!CDIR NODEP
     106!CDIR ON_ADB(q)
     107               DO i=1,iim
     108                 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),
     109     &                                jjp1-j+1-jd,l)
     110               ENDDO
     111            ENDDO
     112
     113            DO j=j_start, j_finish
     114!CDIR ON_ADB(aires_tab)
     115!CDIR ON_ADB(q)
     116               DO i=1,iim
     117                 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)* 
     118     &                              aires_tab(i,jjp1-j+1,jd)
    81119               ENDDO
    82120               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
    83121            ENDDO
     122
    84123       
    85124            j1=j2+1

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/leapfrog_p.F

    r1247 r1250  
    327327c$OMP MASTER
    328328      ItCount=ItCount+1
    329       if (MOD(ItCount,1)==1) then
     329      if (MOD(ItCount,12)==0) then
    330330        debug=.true.
    331331      else
Note: See TracChangeset for help on using the changeset viewer.