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/filtrez/filtreg.F

    r231 r495  
    4949      INTEGER i,j,l,k
    5050      INTEGER iim2,immjm
    51       INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
     51      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil(2),jffil(2)
    5252
    5353      REAL  champ( iip1,nlat,nbniv)
    … …  
    5656     ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    5757     ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    58       REAL  eignq(iim), sdd1(iim),sdd2(iim)
     58cIM   REAL  eignq(iim), sdd1(iim),sdd2(iim)
     59      REAL  eignq(iim,nlat,nbniv), sdd1(iim),sdd2(iim)
    5960      LOGICAL    griscal
    6061      INTEGER    hemisph, iaire
    … …  
    127128      END IF
    128129c
     130      jdfil(1) = jdfil1
     131      jffil(1) = jffil1
     132      jdfil(2) = jdfil2
     133      jffil(2) = jffil2
    129134c
    130135      DO 100  hemisph = 1, 2
    131136c
    132       IF ( hemisph.EQ.1 )  THEN
    133           jdfil = jdfil1
    134           jffil = jffil1
    135       ELSE
    136           jdfil = jdfil2
    137           jffil = jffil2
    138       END IF
     137c     IF ( hemisph.EQ.1 )  THEN
     138c         jdfil = jdfil1
     139c         jffil = jffil1
     140c     ELSE
     141c         jdfil = jdfil2
     142c         jffil = jffil2
     143c     END IF
    139144
    140145 
    141146      DO 50  l = 1, nbniv
    142       DO 30  j = jdfil,jffil
     147      DO 30  j = jdfil(hemisph),jffil(hemisph)
    143148 
    144149 
    … …  
    147152   5  CONTINUE
    148153c
     154 30   CONTINUE
     155 50   CONTINUE
    149156
    150157      IF( hemisph. EQ. 1 )      THEN
    … …  
    152159        IF( ifiltre. EQ. -2 )   THEN
    153160#ifdef CRAY
     161      DO l = 1, nbniv
     162      DO j = jdfil(hemisph),jffil(hemisph)
    154163         CALL MXVA( matrinvn(1,1,j), 1, iim, champ(1,j,l), 1, eignq  ,
    155164     *                             1, iim, iim                         )
    156 #else
    157 #ifdef BLAS
     165      ENDDO
     166      ENDDO
     167#else
     168#ifdef BLAS
     169      DO l = 1, nbniv
     170      DO j = jdfil(hemisph),jffil(hemisph)
    158171      CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
    159172     .           champ(1,j,l), 1, 0.0, eignq, 1)
    160 #else
    161       DO k = 1, iim
    162          eignq(k) = 0.0
    163       ENDDO
    164       DO k = 1, iim
    165       DO i = 1, iim
    166          eignq(k) = eignq(k) + matrinvn(k,i,j)*champ(i,j,l)
    167       ENDDO
    168       ENDDO
     173      ENDDO
     174      ENDDO
     175#else
     176      DO l = 1, nbniv
     177      DO j = jdfil(hemisph),jffil(hemisph)
     178      DO k = 1, iim
     179c        eignq(k) = 0.0
     180         eignq(k,j,l) = 0.0
     181      ENDDO
     182      DO k = 1, iim
     183      DO i = 1, iim
     184c        eignq(k) = eignq(k) + matrinvn(k,i,j)*champ(i,j,l)
     185         eignq(k,j,l) = eignq(k,j,l) + matrinvn(k,i,j)*champ(i,j,l)
     186      ENDDO
     187      ENDDO
     188      ENDDO
     189      ENDDO
    169190#endif
    170191#endif
    171192        ELSE IF ( griscal )     THEN
    172193#ifdef CRAY
     194      DO l = 1, nbniv
     195      DO j = jdfil(hemisph),jffil(hemisph)
    173196         CALL MXVA( matriceun(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    174197     *                             1, iim, iim                         )
    175 #else
    176 #ifdef BLAS
     198      ENDDO
     199      ENDDO
     200#else
     201#ifdef BLAS
     202      DO l = 1, nbniv
     203      DO j = jdfil(hemisph),jffil(hemisph)
    177204      CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
    178205     .           champ(1,j,l), 1, 0.0, eignq, 1)
    179 #else
    180       DO k = 1, iim
    181          eignq(k) = 0.0
    182       ENDDO
    183       DO i = 1, iim
    184       DO k = 1, iim
    185          eignq(k) = eignq(k) + matriceun(k,i,j)*champ(i,j,l)
    186       ENDDO
    187       ENDDO
     206      ENDDO
     207      ENDDO
     208#else
     209      DO l = 1, nbniv
     210      DO j = jdfil(hemisph),jffil(hemisph)
     211      DO k = 1, iim
     212c        eignq(k) = 0.0
     213         eignq(k,j,l) = 0.0
     214      ENDDO
     215      DO i = 1, iim
     216      DO k = 1, iim
     217c        eignq(k) = eignq(k) + matriceun(k,i,j)*champ(i,j,l)
     218         eignq(k,j,l) = eignq(k,j,l) + matriceun(k,i,j)*champ(i,j,l)
     219      ENDDO
     220      ENDDO
     221      ENDDO
     222      ENDDO
    188223#endif
    189224#endif
    190225        ELSE
    191226#ifdef CRAY
     227      DO l = 1, nbniv
     228      DO j = jdfil(hemisph),jffil(hemisph)
    192229         CALL MXVA( matricevn(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    193230     *                             1, iim, iim                         )
    194 #else
    195 #ifdef BLAS
     231      ENDDO
     232      ENDDO
     233#else
     234#ifdef BLAS
     235      DO l = 1, nbniv
     236      DO j = jdfil(hemisph),jffil(hemisph)
    196237      CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
    197238     .           champ(1,j,l), 1, 0.0, eignq, 1)
    198 #else
    199       DO k = 1, iim
    200          eignq(k) = 0.0
    201       ENDDO
    202       DO i = 1, iim
    203       DO k = 1, iim
    204          eignq(k) = eignq(k) + matricevn(k,i,j)*champ(i,j,l)
    205       ENDDO
    206       ENDDO
     239      ENDDO
     240      ENDDO
     241#else
     242      DO l = 1, nbniv
     243      DO j = jdfil(hemisph),jffil(hemisph)
     244      DO k = 1, iim
     245c        eignq(k) = 0.0
     246         eignq(k,j,l) = 0.0
     247      ENDDO
     248      DO i = 1, iim
     249      DO k = 1, iim
     250c        eignq(k) = eignq(k) + matricevn(k,i,j)*champ(i,j,l)
     251         eignq(k,j,l) = eignq(k,j,l) + matricevn(k,i,j)*champ(i,j,l)
     252      ENDDO
     253      ENDDO
     254      ENDDO
     255      ENDDO
    207256#endif
    208257#endif
    … …  
    213262        IF( ifiltre. EQ. -2 )   THEN
    214263#ifdef CRAY
     264      DO l = 1, nbniv
     265      DO j = jdfil(hemisph),jffil(hemisph)
    215266         CALL MXVA( matrinvs(1,1,j-jfiltsu+1),  1, iim, champ(1,j,l),1 , 
    216267     *                          eignq,  1, iim, iim                    )
    217 #else
    218 #ifdef BLAS
     268      ENDDO
     269      ENDDO
     270#else
     271#ifdef BLAS
     272      DO l = 1, nbniv
     273      DO j = jdfil(hemisph),jffil(hemisph)
    219274      CALL SGEMV("N", iim,iim, 1.0, matrinvs(1,1,j-jfiltsu+1),iim,
    220275     .           champ(1,j,l), 1, 0.0, eignq, 1)
    221 #else
    222       DO k = 1, iim
    223          eignq(k) = 0.0
    224       ENDDO
    225       DO i = 1, iim
    226       DO k = 1, iim
    227          eignq(k) = eignq(k) + matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
    228       ENDDO
    229       ENDDO
     276      ENDDO
     277      ENDDO
     278#else
     279      DO l = 1, nbniv
     280      DO j = jdfil(hemisph),jffil(hemisph)
     281      DO k = 1, iim
     282c        eignq(k) = 0.0
     283         eignq(k,j,l) = 0.0
     284      ENDDO
     285      DO i = 1, iim
     286      DO k = 1, iim
     287c        eignq(k) = eignq(k) + matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
     288         eignq(k,j,l) = eignq(k,j,l) +
     289     .matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
     290      ENDDO
     291      ENDDO
     292      ENDDO
     293      ENDDO
    230294#endif
    231295#endif
    232296        ELSE IF ( griscal )     THEN
    233297#ifdef CRAY
     298      DO l = 1, nbniv
     299      DO j = jdfil(hemisph),jffil(hemisph)
    234300         CALL MXVA( matriceus(1,1,j-jfiltsu+1), 1, iim, champ(1,j,l),1 ,
    235301     *                          eignq,  1, iim, iim                    )
    236 #else
    237 #ifdef BLAS
     302      ENDDO
     303      ENDDO
     304#else
     305#ifdef BLAS
     306      DO l = 1, nbniv
     307      DO j = jdfil(hemisph),jffil(hemisph)
    238308      CALL SGEMV("N", iim,iim, 1.0, matriceus(1,1,j-jfiltsu+1),iim,
    239309     .           champ(1,j,l), 1, 0.0, eignq, 1)
    240 #else
    241       DO k = 1, iim
    242          eignq(k) = 0.0
    243       ENDDO
    244       DO i = 1, iim
    245       DO k = 1, iim
    246          eignq(k) = eignq(k) + matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
    247       ENDDO
    248       ENDDO
     310      ENDDO
     311      ENDDO
     312#else
     313      DO l = 1, nbniv
     314      DO j = jdfil(hemisph),jffil(hemisph)
     315      DO k = 1, iim
     316c        eignq(k) = 0.0
     317         eignq(k,j,l) = 0.0
     318      ENDDO
     319      DO i = 1, iim
     320      DO k = 1, iim
     321c        eignq(k) = eignq(k) + matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
     322         eignq(k,j,l) = eignq(k,j,l) +
     323     .matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
     324      ENDDO
     325      ENDDO
     326      ENDDO
     327      ENDDO
    249328#endif
    250329#endif
    251330        ELSE
    252331#ifdef CRAY
     332      DO l = 1, nbniv
     333      DO j = jdfil(hemisph),jffil(hemisph)
    253334         CALL MXVA( matricevs(1,1,j-jfiltsv+1), 1, iim, champ(1,j,l),1 ,
    254335     *                          eignq,  1, iim, iim                    )
    255 #else
    256 #ifdef BLAS
     336      ENDDO
     337      ENDDO
     338#else
     339#ifdef BLAS
     340      DO l = 1, nbniv
     341      DO j = jdfil(hemisph),jffil(hemisph)
    257342      CALL SGEMV("N", iim,iim, 1.0, matricevs(1,1,j-jfiltsv+1),iim,
    258343     .           champ(1,j,l), 1, 0.0, eignq, 1)
    259 #else
    260       DO k = 1, iim
    261          eignq(k) = 0.0
    262       ENDDO
    263       DO i = 1, iim
    264       DO k = 1, iim
    265          eignq(k) = eignq(k) + matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
    266       ENDDO
    267       ENDDO
     344      ENDDO
     345      ENDDO
     346#else
     347      DO l = 1, nbniv
     348      DO j = jdfil(hemisph),jffil(hemisph)
     349      DO k = 1, iim
     350c        eignq(k) = 0.0
     351         eignq(k,j,l) = 0.0
     352      ENDDO
     353      DO i = 1, iim
     354      DO k = 1, iim
     355c        eignq(k) = eignq(k) + matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
     356         eignq(k,j,l) = eignq(k,j,l) +
     357     .matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
     358      ENDDO
     359      ENDDO
     360      ENDDO
     361      ENDDO
    268362#endif
    269363#endif
    … …  
    273367c
    274368      IF( ifiltre.EQ. 2 )  THEN
     369      DO l = 1, nbniv
     370      DO j = jdfil(hemisph),jffil(hemisph)
    275371        DO 15 i = 1, iim
    276         champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
     372c       champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
     373        champ( i,j,l ) = ( champ(i,j,l) + eignq(i,j,l) ) * sdd2(i)
    277374  15    CONTINUE
     375      ENDDO
     376      ENDDO
    278377      ELSE
     378      DO l = 1, nbniv
     379      DO j = jdfil(hemisph),jffil(hemisph)
    279380        DO 16 i=1,iim
    280         champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
     381c       champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
     382        champ( i,j,l ) = ( champ(i,j,l) - eignq(i,j,l) ) * sdd2(i)
    28138316      CONTINUE
     384      ENDDO
     385      ENDDO
    282386      ENDIF
    283387c
     388      DO l = 1, nbniv
     389      DO j = jdfil(hemisph),jffil(hemisph)
    284390      champ( iip1,j,l ) = champ( 1,j,l )
    285 c
    286   30  CONTINUE
    287 c
    288   50  CONTINUE
     391      ENDDO
     392      ENDDO
     393c
     394c 30  CONTINUE
     395c
     396c 50  CONTINUE
    289397c   
    290398 100  CONTINUE
Note: See TracChangeset for help on using the changeset viewer.