Changeset 1086 for LMDZ4


Ignore:
Timestamp:
Feb 3, 2009, 10:50:31 AM (16 years ago)
Author:
yann meurdesoif
Message:

Modifications Othman Bouzi : optimisation du filtre (remplacement opération matrice/vecteurs par matrice/matrice/matrice - BLAS), l'allocation des tableaux du filtre se fait maintenant dynamiquement (plus d'intervention manuelle dans parafiltre.h)

Location:
LMDZ4/branches/LMDZ4-dev/libf
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3d/etat0_netcdf.F

    r1058 r1086  
    1212      USE pbl_surface_mod
    1313      USE phys_state_var_mod
     14      USE filtre
    1415      !
    1516      IMPLICIT NONE

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3d/gcm.F

    r962 r1086  
    99      USE IOIPSL
    1010#endif
     11
     12      USE filtre
    1113
    1214!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3d/iniacademic.F

    r524 r1086  
    55c
    66      SUBROUTINE iniacademic(nq,vcov,ucov,teta,q,masse,ps,phis,time_0)
     7
     8      USE filtre
    79
    810c%W%    %G%

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/comgeom.h

    r774 r1086  
    22! $Header$
    33!
    4 *CDK comgeom
    5       COMMON/comgeom/
    6      1 cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),
    7      2 aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),
    8      3 airev(ip1jm),unsaire(ip1jmp1),apoln,apols,
    9      4 unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),
    10      5 aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),
    11      6 aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),
    12      7 alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),
    13      8 alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),
    14      9 fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),
    15      1 rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),
    16      1 cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),
    17      2 cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),
    18      3 cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),
    19      4 unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,
    20      5 unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),
    21      6 aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
     4!CDK comgeom
     5      COMMON/comgeom/                                                   &
     6     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
     7     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
     8     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
     9     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
     10     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
     11     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
     12     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
     13     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
     14     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
     15     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
     16     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
     17     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
     18     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
     19     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
     20     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
     21     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
    2222
    23 c
    24         REAL
    25      1 cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,
    26      2 apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,
    27      3 alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
    28      4 fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
    29      5 cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2
    30      6 ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,
    31      7 aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu
    32      8 , xprimv
    33 c
     23!
     24        REAL                                                            &
     25     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
     26     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
     27     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
     28     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
     29     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
     30     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
     31     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
     32     & , xprimv
     33!

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

    r1058 r1086  
    1212      USE pbl_surface_mod
    1313      USE phys_state_var_mod
     14      USE filtre
    1415      !
    1516      IMPLICIT NONE

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

    r985 r1086  
    22
    33      SUBROUTINE filtreg_p ( champ, ibeg, iend, nlat, nbniv,
    4      .                       ifiltre, iaire, griscal ,iter)
    5       USE Parallel, only : OMP_CHUNK 
     4     &     ifiltre, iaire, griscal ,iter)
     5      USE Parallel, only : OMP_CHUNK
    66      USE mod_filtre_fft
    77      USE timer_filtre
     8     
     9      USE filtre
     10     
    811      IMPLICIT NONE
    9 
     12     
    1013c=======================================================================
    1114c
    … …  
    5053#include "dimensions.h"
    5154#include "paramet.h"
    52 #include "parafilt.h"
    5355#include "coefils.h"
    5456c
    … …  
    5759      INTEGER iim2,immjm
    5860      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
    59 
     61     
    6062      REAL  champ( iip1,nlat,nbniv)
    61       REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
    62       COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
    63      ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    64      ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    65 cym      REAL  eignq(iim), sdd1(iim),sdd2(iim)
    66 
    67       REAL  eignq(iim)
    68       REAL :: sdd1(iim),sdd2(iim)
    6963     
    7064      LOGICAL    griscal
    … …  
    7468      REAL :: champ_in(iip1,nlat,nbniv)
    7569     
    76       REAL,SAVE,TARGET :: sddu_loc(iim)
    77       REAL,SAVE,TARGET :: sddv_loc(iim)
    78       REAL,SAVE,TARGET :: unsddu_loc(iim)
    79       REAL,SAVE,TARGET :: unsddv_loc(iim)
    80 c$OMP THREADPRIVATE(sddu_loc,sddv_loc,unsddu_loc,unsddv_loc)
    8170      LOGICAL,SAVE     :: first=.TRUE.
    8271c$OMP THREADPRIVATE(first)
    8372
     73      REAL, DIMENSION(iip1,nlat,nbniv) :: champ_loc
     74      INTEGER :: ll_nb, nbniv_loc
     75      REAL, SAVE :: sdd12(iim,4)
     76c$OMP THREADPRIVATE(sdd12)
     77
     78      INTEGER, PARAMETER :: type_sddu=1
     79      INTEGER, PARAMETER :: type_sddv=2
     80      INTEGER, PARAMETER :: type_unsddu=3
     81      INTEGER, PARAMETER :: type_unsddv=4
     82
     83      INTEGER :: sdd1_type, sdd2_type
     84
    8485      IF (first) THEN
    85         sddu_loc(1:iim)=sddu(1:iim)
    86         sddv_loc(1:iim)=sddv(1:iim)
    87         unsddu_loc(1:iim)=unsddu(1:iim)
    88         unsddv_loc(1:iim)=unsddv(1:iim)
    89         CALL Init_timer
    90         first=.FALSE.
    91 c       PRINT *,"----> sddu_loc=",sddu_loc
    92 c       PRINT *,"----> sddv_loc=",sddv_loc
    93 c       PRINT *,"----> unsddu_loc=",unsddu_loc
    94 c       PRINT *,"----> unsddv_loc=",unsddv_loc
     86         sdd12(1:iim,type_sddu) = sddu(1:iim)
     87         sdd12(1:iim,type_sddv) = sddv(1:iim)
     88         sdd12(1:iim,type_unsddu) = unsddu(1:iim)
     89         sdd12(1:iim,type_unsddv) = unsddv(1:iim)
     90
     91         CALL Init_timer
     92         first=.FALSE.
    9593      ENDIF
    9694
    … …  
    9997c$OMP END MASTER
    10098
     99c-------------------------------------------------------c
     100
    101101      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
    102      *    STOP'Pas de transformee simple dans cette version'
    103 
     102     &     STOP'Pas de transformee simple dans cette version'
     103     
    104104      IF( iter.EQ. 2 )  THEN
    105        PRINT *,' Pas d iteration du filtre dans cette version !'
    106      * , ' Utiliser old_filtreg et repasser !'
    107            STOP
     105         PRINT *,' Pas d iteration du filtre dans cette version !'
     106     &        , ' Utiliser old_filtreg et repasser !'
     107         STOP
    108108      ENDIF
    109109
    110110      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
    111        PRINT *,' Cette routine ne calcule le filtre inverse que ',
    112      * ' sur la grille des scalaires !'
    113            STOP
     111         PRINT *,' Cette routine ne calcule le filtre inverse que '
     112     &        , ' sur la grille des scalaires !'
     113         STOP
    114114      ENDIF
    115115
    116116      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
    117        PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
    118      *,' corriger et repasser !'
    119            STOP
     117         PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
     118     &        , ' corriger et repasser !'
     119         STOP
    120120      ENDIF
    121121c
    … …  
    127127      IF( griscal )   THEN
    128128         IF( nlat. NE. jjp1 )  THEN
    129              PRINT  1111
    130              STOP
     129            PRINT  1111
     130            STOP
    131131         ELSE
    132 c
    133              IF( iaire.EQ.1 )  THEN
    134 cym                CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
    135 cym                CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
    136 cym               sdd1=>sddv_loc
    137 cym               sdd2=>unsddv_loc
    138                sdd1(1:iim)=sddv_loc(1:iim)
    139                sdd2(1:iim)=unsddv_loc(1:iim)
    140              ELSE
    141 cym                CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
    142 cym                CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
    143                sdd1(1:iim)=unsddv_loc(1:iim)
    144                sdd2(1:iim)=sddv_loc(1:iim)
    145              END IF
    146 c
    147              jdfil1 = 2
    148              jffil1 = jfiltnu
    149              jdfil2 = jfiltsu
    150              jffil2 = jjm
    151           END IF
     132c     
     133            IF( iaire.EQ.1 )  THEN
     134               sdd1_type = type_sddv
     135               sdd2_type = type_unsddv
     136            ELSE
     137               sdd1_type = type_unsddv
     138               sdd2_type = type_sddv
     139            ENDIF
     140c
     141            jdfil1 = 2
     142            jffil1 = jfiltnu
     143            jdfil2 = jfiltsu
     144            jffil2 = jjm
     145         ENDIF
    152146      ELSE
    153           IF( nlat.NE.jjm )  THEN
    154              PRINT  2222
    155              STOP
    156           ELSE
    157 c
    158              IF( iaire.EQ.1 )  THEN
    159 cym                CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
    160 cym                CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
    161 cym                sdd1=>sddu_loc
    162 cym                sdd2=>unsddu_loc
    163                 sdd1(1:iim)=sddu_loc(1:iim)
    164                 sdd2(1:iim)=unsddu_loc(1:iim)
    165 
    166              ELSE
    167 cym                CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
    168 cym                CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
    169 cym               sdd1=>unsddu_loc
    170 cym               sdd2=>sddu_loc
    171                sdd1(1:iim)=unsddu_loc(1:iim)
    172                sdd2(1:iim)=sddu_loc(1:iim)
    173              END IF
    174 c
    175              jdfil1 = 1
    176              jffil1 = jfiltnv
    177              jdfil2 = jfiltsv
    178              jffil2 = jjm
    179           END IF
    180       END IF
    181 
    182 c      PRINT *,"APPEL a filtreg --> sdd1=",sdd1
    183 c      PRINT *,"APPEL a filtreg --> sdd2=",sdd2
    184 c      PRINT *,"----> sddu_loc=",sddu_loc
    185 c       PRINT *,"----> sddv_loc=",sddv_loc
    186 c       PRINT *,"----> unsddu_loc=",unsddu_loc
    187 c       PRINT *,"----> unsddv_loc=",unsddv_loc
    188  
    189 c
    190 c
    191       DO 100  hemisph = 1, 2
    192 c
    193       IF ( hemisph.EQ.1 )  THEN
    194 c ym
    195           jdfil = max(jdfil1,ibeg)
    196           jffil = min(jffil1,iend)
    197       ELSE
    198 c ym
    199           jdfil = max(jdfil2,ibeg)
    200           jffil = min(jffil2,iend)
    201       END IF
     147         IF( nlat.NE.jjm )  THEN
     148            PRINT  2222
     149            STOP
     150         ELSE
     151c
     152            IF( iaire.EQ.1 )  THEN
     153               sdd1_type = type_sddu
     154               sdd2_type = type_unsddu
     155            ELSE
     156               sdd1_type = type_unsddu
     157               sdd2_type = type_sddu
     158            ENDIF
     159c     
     160            jdfil1 = 1
     161            jffil1 = jfiltnv
     162            jdfil2 = jfiltsv
     163            jffil2 = jjm
     164         ENDIF
     165      ENDIF
     166c     
     167      DO hemisph = 1, 2
     168c     
     169         IF ( hemisph.EQ.1 )  THEN
     170cym
     171            jdfil = max(jdfil1,ibeg)
     172            jffil = min(jffil1,iend)
     173         ELSE
     174cym
     175            jdfil = max(jdfil2,ibeg)
     176            jffil = min(jffil2,iend)
     177         ENDIF
    202178
    203179
    … …  
    206182cccccccccccccccccccccccccccccccccccccccccccc
    207183
    208       IF (.NOT. use_filtre_fft) THEN
    209      
    210 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    211       DO 50  l = 1, nbniv
    212         DO 30  j = jdfil,jffil
    213  
    214  
    215           DO  5  i = 1, iim
    216             champ(i,j,l) = champ(i,j,l) * sdd1(i)
    217    5      CONTINUE
    218 c
    219 
    220           IF( hemisph. EQ. 1 )      THEN
    221 
    222             IF( ifiltre. EQ. -2 )   THEN
    223 
    224 
    225               CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
    226      .                     champ(1,j,l), 1, 0.0, eignq, 1)
    227 
    228 
    229             ELSE IF ( griscal )     THEN
    230 
    231               CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
    232      .                    champ(1,j,l), 1, 0.0, eignq, 1)
    233 
    234             ELSE
    235 
    236               CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
    237      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    238             ENDIF
    239 
    240           ELSE
    241 
    242             IF( ifiltre. EQ. -2 )   THEN
    243      
    244               CALL SGEMV("N",iim,iim,1.0, matrinvs(1,1,j-jfiltsu+1),iim,
    245      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    246      
    247             ELSE IF ( griscal )     THEN
    248      
    249               CALL SGEMV("N",iim,iim,1.0,matriceus(1,1,j-jfiltsu+1),iim,
    250      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    251             ELSE
    252          
    253               CALL SGEMV("N",iim,iim,1.0,matricevs(1,1,j-jfiltsv+1),iim,
    254      .                    champ(1,j,l), 1, 0.0, eignq, 1)
    255             ENDIF
    256 
    257           ENDIF
    258 
    259 
    260 c
    261           IF( ifiltre.EQ. 2 )  THEN
    262          
    263             DO 15 i = 1, iim
    264               champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
    265   15        CONTINUE
    266          
    267           ELSE
    268        
    269             DO 16 i=1,iim
    270                champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
    271 16          CONTINUE
    272          
    273           ENDIF
    274 c
    275           champ( iip1,j,l ) = champ( 1,j,l )
    276 c
    277   30    CONTINUE
    278 c
    279   50  CONTINUE
     184         IF (.NOT. use_filtre_fft) THEN
     185     
     186c     !---------------------------------!
     187c     ! Agregation des niveau verticaux !
     188c     ! uniquement necessaire pour une  !
     189c     ! execution OpenMP                !
     190c     !---------------------------------!
     191            ll_nb = 0
     192c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     193            DO l = 1, nbniv
     194               ll_nb = ll_nb+1
     195               DO j = jdfil,jffil
     196                  DO i = 1, iim
     197                     champ_loc(i,j,ll_nb) =
     198     &                    champ(i,j,l) * sdd12(i,sdd1_type)
     199                  ENDDO
     200               ENDDO
     201            ENDDO
    280202c$OMP END DO NOWAIT
    281203
     204            nbniv_loc = ll_nb
     205
     206            IF( hemisph.EQ.1 )      THEN
     207               
     208               IF( ifiltre.EQ.-2 )   THEN
     209                  DO j = jdfil,jffil
     210                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     211     &                    matrinvn(1,1,j), iim,
     212     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     213     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     214                  ENDDO
     215                 
     216               ELSE IF ( griscal )     THEN
     217                  DO j = jdfil,jffil
     218                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     219     &                    matriceun(1,1,j), iim,
     220     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     221     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     222                  ENDDO
     223                 
     224               ELSE
     225                  DO j = jdfil,jffil
     226                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     227     &                    matricevn(1,1,j), iim,
     228     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     229     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     230                  ENDDO
     231                 
     232               ENDIF
     233               
     234            ELSE
     235               
     236               IF( ifiltre.EQ.-2 )   THEN
     237                  DO j = jdfil,jffil
     238                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     239     &                    matrinvs(1,1,j-jfiltsu+1), iim,
     240     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     241     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     242                  ENDDO
     243                 
     244               ELSE IF ( griscal )     THEN
     245                 
     246                  DO j = jdfil,jffil
     247                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     248     &                    matriceus(1,1,j-jfiltsu+1), iim,
     249     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     250     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     251                  ENDDO
     252                 
     253               ELSE
     254                 
     255                  DO j = jdfil,jffil
     256                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     257     &                    matricevs(1,1,j-jfiltsv+1), iim,
     258     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     259     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     260                  ENDDO
     261                 
     262               ENDIF
     263               
     264            ENDIF
     265!     c     
     266            IF( ifiltre.EQ.2 )  THEN
     267               
     268c     !-------------------------------------!
     269c     ! Dés-agregation des niveau verticaux !
     270c     ! uniquement necessaire pour une      !
     271c     ! execution OpenMP                    !
     272c     !-------------------------------------!
     273               ll_nb = 0
     274c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     275               DO l = 1, nbniv
     276                  ll_nb = ll_nb + 1
     277                  DO j = jdfil,jffil
     278                     DO i = 1, iim
     279                        champ( i,j,l ) = (champ_loc(i,j,ll_nb)
     280     &                       + champ_fft(i,j-jdfil+1,ll_nb))
     281     &                       * sdd12(i,sdd2_type)
     282                     ENDDO
     283                  ENDDO
     284               ENDDO
     285c$OMP END DO NOWAIT
     286               
     287            ELSE
     288               
     289               ll_nb = 0
     290c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     291               DO l = 1, nbniv_loc
     292                  ll_nb = ll_nb + 1
     293                  DO j = jdfil,jffil
     294                     DO i = 1, iim
     295                        champ( i,j,l ) = (champ_loc(i,j,ll_nb)
     296     &                       - champ_fft(i,j-jdfil+1,ll_nb))
     297     &                       * sdd12(i,sdd2_type)
     298                     ENDDO
     299                  ENDDO
     300               ENDDO
     301c$OMP END DO NOWAIT
     302               
     303            ENDIF
     304           
     305c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     306            DO l = 1, nbniv
     307               DO j = jdfil,jffil
     308                  champ( iip1,j,l ) = champ( 1,j,l )
     309               ENDDO
     310            ENDDO
     311c$OMP END DO NOWAIT
     312           
    282313ccccccccccccccccccccccccccccccccccccccccccccc
    283314c Utilisation du filtre FFT
    284315ccccccccccccccccccccccccccccccccccccccccccccc
    285316       
    286        ELSE
     317         ELSE
    287318       
    288319c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    289           DO l=1,nbniv
    290             DO j=jdfil,jffil
    291               DO  i = 1, iim
    292                 champ( i,j,l)= champ(i,j,l)*sdd1(i)
    293                 champ_fft( i,j,l) = champ(i,j,l)
    294               ENDDO
     320            DO l=1,nbniv
     321               DO j=jdfil,jffil
     322                  DO  i = 1, iim
     323                     champ( i,j,l)= champ(i,j,l)*sdd12(i,sdd1_type)
     324                     champ_fft( i,j,l) = champ(i,j,l)
     325                  ENDDO
     326               ENDDO
    295327            ENDDO
    296           ENDDO
    297328c$OMP END DO NOWAIT
    298329
    299       IF (jdfil<=jffil) THEN
    300         IF( ifiltre. EQ. -2 )   THEN
    301           CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    302         ELSE IF ( griscal )     THEN
    303           CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    304         ELSE
    305           CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    306         ENDIF
    307       ENDIF
    308 
    309 
    310         IF( ifiltre.EQ. 2 )  THEN
     330            IF (jdfil<=jffil) THEN
     331               IF( ifiltre. EQ. -2 )   THEN
     332                  CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     333               ELSE IF ( griscal )     THEN
     334                  CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     335               ELSE
     336                  CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     337               ENDIF
     338            ENDIF
     339
     340
     341            IF( ifiltre.EQ. 2 )  THEN
    311342c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    312           DO l=1,nbniv
    313             DO j=jdfil,jffil
    314               DO  i = 1, iim
    315                 champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
    316      .                             *sdd2(i)
    317               ENDDO
    318             ENDDO
    319           ENDDO
     343               DO l=1,nbniv
     344                  DO j=jdfil,jffil
     345                     DO  i = 1, iim
     346                        champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
     347     &                       *sdd12(i,sdd2_type)
     348                     ENDDO
     349                  ENDDO
     350               ENDDO
    320351c$OMP END DO NOWAIT       
    321         ELSE
     352            ELSE
    322353       
    323354c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
    324           DO l=1,nbniv
    325             DO j=jdfil,jffil
    326               DO  i = 1, iim
    327                 champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
    328      .                            *sdd2(i)
    329               ENDDO
     355               DO l=1,nbniv
     356                  DO j=jdfil,jffil
     357                     DO  i = 1, iim
     358                        champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
     359     &                       *sdd12(i,sdd2_type)
     360                     ENDDO
     361                  ENDDO
     362               ENDDO
     363c$OMP END DO NOWAIT         
     364            ENDIF
     365c
     366c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     367            DO l=1,nbniv
     368               DO j=jdfil,jffil
     369!            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
     370                  champ( iip1,j,l ) = champ( 1,j,l )
     371               ENDDO
    330372            ENDDO
    331           ENDDO
    332 c$OMP END DO NOWAIT         
    333         ENDIF
    334 c
    335 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    336         DO l=1,nbniv
    337           DO j=jdfil,jffil
    338 !            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
    339             champ( iip1,j,l ) = champ( 1,j,l )
    340           ENDDO
    341         ENDDO
    342373c$OMP END DO NOWAIT             
    343       ENDIF
     374         ENDIF
    344375c Fin de la zone de filtrage
    345376
    346377       
    347  100  CONTINUE
     378      ENDDO
    348379
    349380!      DO j=1,nlat
    … …  
    359390     
    360391c
    361 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
    362      *filtrer, sur la grille des scalaires'/)
    363 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
    364      *ltrer, sur la grille de V ou de Z'/)
     392 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
     393     &     filtrer, sur la grille des scalaires'/)
     394 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
     395     &     ltrer, sur la grille de V ou de Z'/)
    365396c$OMP MASTER     
    366397      CALL stop_timer

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

    r1085 r1086  
    1313      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
    1414      USE mod_grid_phy_lmdz
    15       USE mod_phys_lmdz_omp_data, ONLY: klon_omp
    1615      USE dimphy
    1716      USE mod_interface_dyn_phys
    … …  
    1918      USE mod_hallo
    2019      USE Bands
     20
     21      USE filtre
     22
    2123      IMPLICIT NONE
    2224

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

    r774 r1086  
    55c
    66      SUBROUTINE iniacademic(nq,vcov,ucov,teta,q,masse,ps,phis,time_0)
     7
     8      USE filtre
    79
    810c%W%    %G%

  • LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/serre.h

    r774 r1086  
    22! $Header$
    33!
    4 c
    5 c
    6 c..include serre.h
    7 c
    8        REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
    9      ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
    10        COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,
    11      ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
     4!c
     5!c
     6!c..include serre.h
     7!c
     8       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
     9     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
     10       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     &
     11     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy

  • LMDZ4/branches/LMDZ4-dev/libf/filtrez/coefils.h

    r524 r1086  
    22! $Header$
    33!
    4       COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
    5      * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
    6      * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
    7      * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
    8 c
     4      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
     5     & ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),      &
     6     & modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)    &
     7     & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
     8!c
    99      INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
    1010      REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv

  • LMDZ4/branches/LMDZ4-dev/libf/filtrez/filtreg.F

    r524 r1086  
    33!
    44      SUBROUTINE filtreg ( champ, nlat, nbniv, ifiltre,iaire,
    5      .   griscal ,iter)
    6 
     5     &     griscal ,iter)
     6     
     7      USE filtre
     8     
    79      IMPLICIT NONE
    810c=======================================================================
    … …  
    4648#include "dimensions.h"
    4749#include "paramet.h"
    48 #include "parafilt.h"
    4950#include "coefils.h"
    50 c
    51       INTEGER nlat,nbniv,ifiltre,iter
    52       INTEGER i,j,l,k
    53       INTEGER iim2,immjm
    54       INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
    55 
    56       REAL  champ( iip1,nlat,nbniv)
    57       REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
    58       COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
    59      ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    60      ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    61       REAL  eignq(iim), sdd1(iim),sdd2(iim)
     51
     52      INTEGER    nlat,nbniv,ifiltre,iter
     53      INTEGER    i,j,l,k
     54      INTEGER    iim2,immjm
     55      INTEGER    jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
     56
     57      REAL       champ( iip1,nlat,nbniv)
     58
     59      REAL       eignq(iim,nlat,nbniv), sdd1(iim),sdd2(iim)
    6260      LOGICAL    griscal
    6361      INTEGER    hemisph, iaire
    64 c
     62
     63      LOGICAL,SAVE     :: first=.TRUE.
     64
     65      REAL, SAVE :: sdd12(iim,4)
     66
     67      INTEGER, PARAMETER :: type_sddu=1
     68      INTEGER, PARAMETER :: type_sddv=2
     69      INTEGER, PARAMETER :: type_unsddu=3
     70      INTEGER, PARAMETER :: type_unsddv=4
     71
     72      INTEGER :: sdd1_type, sdd2_type
     73
     74      IF (first) THEN
     75         sdd12(1:iim,type_sddu) = sddu(1:iim)
     76         sdd12(1:iim,type_sddv) = sddv(1:iim)
     77         sdd12(1:iim,type_unsddu) = unsddu(1:iim)
     78         sdd12(1:iim,type_unsddv) = unsddv(1:iim)
     79
     80         first=.FALSE.
     81      ENDIF
    6582
    6683      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
    67      *    STOP'Pas de transformee simple dans cette version'
    68 
     84     &     STOP'Pas de transformee simple dans cette version'
     85     
    6986      IF( iter.EQ. 2 )  THEN
    70        PRINT *,' Pas d iteration du filtre dans cette version !'
    71      * , ' Utiliser old_filtreg et repasser !'
    72            STOP
    73       ENDIF
    74 
     87         PRINT *,' Pas d iteration du filtre dans cette version !'
     88     &        , ' Utiliser old_filtreg et repasser !'
     89         STOP
     90      ENDIF
     91     
    7592      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
    76        PRINT *,' Cette routine ne calcule le filtre inverse que ',
    77      * ' sur la grille des scalaires !'
    78            STOP
    79       ENDIF
    80 
     93         PRINT *,' Cette routine ne calcule le filtre inverse que '
     94     &        , ' sur la grille des scalaires !'
     95         STOP
     96      ENDIF
     97     
    8198      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
    82        PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
    83      *,' corriger et repasser !'
    84            STOP
    85       ENDIF
    86 c
    87 
     99         PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
     100     &        , ' corriger et repasser !'
     101         STOP
     102      ENDIF
     103     
    88104      iim2   = iim * iim
    89105      immjm  = iim * jjm
    90 c
    91 c
     106
    92107      IF( griscal )   THEN
    93108         IF( nlat. NE. jjp1 )  THEN
    94              PRINT  1111
    95              STOP
    96          ELSE
    97 c
    98              IF( iaire.EQ.1 )  THEN
    99                 CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
    100                 CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
    101              ELSE
    102                 CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
    103                 CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
    104              END IF
    105 c
    106              jdfil1 = 2
    107              jffil1 = jfiltnu
    108              jdfil2 = jfiltsu
    109              jffil2 = jjm
    110           END IF
     109            PRINT  1111
     110            STOP
     111         ELSE
     112           
     113            IF( iaire.EQ.1 )  THEN
     114               sdd1_type = type_sddu
     115               sdd2_type = type_unsddu
     116            ELSE
     117               sdd1_type = type_unsddu
     118               sdd2_type = type_sddu
     119            ENDIF
     120
     121c            IF( iaire.EQ.1 )  THEN
     122c               CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
     123c               CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
     124c            ELSE
     125c               CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
     126c               CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
     127c            END IF
     128           
     129            jdfil1 = 2
     130            jffil1 = jfiltnu
     131            jdfil2 = jfiltsu
     132            jffil2 = jjm
     133         END IF
    111134      ELSE
    112           IF( nlat.NE.jjm )  THEN
    113              PRINT  2222
    114              STOP
    115           ELSE
    116 c
    117              IF( iaire.EQ.1 )  THEN
    118                 CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
    119                 CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
    120              ELSE
    121                 CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
    122                 CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
    123              END IF
    124 c
    125              jdfil1 = 1
    126              jffil1 = jfiltnv
    127              jdfil2 = jfiltsv
    128              jffil2 = jjm
    129           END IF
     135         IF( nlat.NE.jjm )  THEN
     136            PRINT  2222
     137            STOP
     138         ELSE
     139           
     140            IF( iaire.EQ.1 )  THEN
     141               sdd1_type = type_sddu
     142               sdd2_type = type_unsddu
     143            ELSE
     144               sdd1_type = type_unsddu
     145               sdd2_type = type_sddu
     146            ENDIF
     147
     148c            IF( iaire.EQ.1 )  THEN
     149c               CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
     150c               CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
     151c            ELSE
     152c               CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
     153c               CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
     154c            END IF
     155           
     156            jdfil1 = 1
     157            jffil1 = jfiltnv
     158            jdfil2 = jfiltsv
     159            jffil2 = jjm
     160         END IF
    130161      END IF
    131 c
    132 c
    133       DO 100  hemisph = 1, 2
    134 c
    135       IF ( hemisph.EQ.1 )  THEN
    136           jdfil = jdfil1
    137           jffil = jffil1
    138       ELSE
    139           jdfil = jdfil2
    140           jffil = jffil2
    141       END IF
    142 
    143  
    144       DO 50  l = 1, nbniv
    145       DO 30  j = jdfil,jffil
    146  
    147  
    148       DO  5  i = 1, iim
    149       champ(i,j,l) = champ(i,j,l) * sdd1(i)
    150    5  CONTINUE
    151 c
    152 
    153       IF( hemisph. EQ. 1 )      THEN
    154 
    155         IF( ifiltre. EQ. -2 )   THEN
    156 #ifdef CRAY
    157          CALL MXVA( matrinvn(1,1,j), 1, iim, champ(1,j,l), 1, eignq  ,
    158      *                             1, iim, iim                         )
    159 #else
    160 #ifdef BLAS
    161       CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
    162      .           champ(1,j,l), 1, 0.0, eignq, 1)
    163 #else
    164       DO k = 1, iim
    165          eignq(k) = 0.0
     162     
     163      DO hemisph = 1, 2
     164         
     165         IF ( hemisph.EQ.1 )  THEN
     166            jdfil = jdfil1
     167            jffil = jffil1
     168         ELSE
     169            jdfil = jdfil2
     170            jffil = jffil2
     171         END IF
     172         
     173         DO l = 1, nbniv
     174            DO j = jdfil,jffil
     175               DO i = 1, iim
     176                  champ(i,j,l) = champ(i,j,l) * sdd12(i,sdd1_type) ! sdd1(i)
     177               END DO
     178            END DO
     179         END DO
     180         
     181         IF( hemisph. EQ. 1 )      THEN
     182           
     183            IF( ifiltre. EQ. -2 )   THEN
     184               
     185               DO j = jdfil,jffil
     186                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     187     &                 matrinvn(1,1,j),
     188     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     189     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     190               END DO
     191               
     192            ELSE IF ( griscal )     THEN
     193               
     194               DO j = jdfil,jffil
     195                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     196     &                 matriceun(1,1,j),
     197     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     198     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     199               END DO
     200               
     201            ELSE
     202               
     203               DO j = jdfil,jffil
     204                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     205     &                 matricevn(1,1,j),
     206     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     207     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     208               END DO
     209               
     210            ENDIF
     211           
     212         ELSE
     213           
     214            IF( ifiltre. EQ. -2 )   THEN
     215               
     216               DO j = jdfil,jffil
     217                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     218     &                 matrinvs(1,1,j-jfiltsu+1),
     219     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     220     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     221               END DO
     222               
     223               
     224            ELSE IF ( griscal )     THEN
     225               
     226               DO j = jdfil,jffil
     227                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     228     &                 matriceus(1,1,j-jfiltsu+1),
     229     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     230     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     231               END DO
     232                             
     233            ELSE
     234               
     235               DO j = jdfil,jffil
     236                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     237     &                 matricevs(1,1,j-jfiltsv+1),
     238     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     239     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     240               END DO
     241                             
     242            ENDIF
     243           
     244         ENDIF
     245         
     246         IF( ifiltre.EQ. 2 )  THEN
     247           
     248            DO l = 1, nbniv
     249               DO j = jdfil,jffil
     250                  DO i = 1, iim
     251                     champ( i,j,l ) =
     252     &                    (champ(i,j,l) + eignq(i,j-jdfil+1,l))
     253     &                    * sdd12(i,sdd2_type) ! sdd2(i)
     254                  END DO
     255               END DO
     256            END DO
     257
     258         ELSE
     259
     260            DO l = 1, nbniv
     261               DO j = jdfil,jffil
     262                  DO i = 1, iim
     263                     champ( i,j,l ) =
     264     &                    (champ(i,j,l) - eignq(i,j-jdfil+1,l))
     265     &                    * sdd12(i,sdd2_type) ! sdd2(i)
     266                  END DO
     267               END DO
     268            END DO
     269
     270         ENDIF
     271
     272         DO l = 1, nbniv
     273            DO j = jdfil,jffil
     274               champ( iip1,j,l ) = champ( 1,j,l )
     275            END DO
     276         END DO
     277
     278     
    166279      ENDDO
    167       DO k = 1, iim
    168       DO i = 1, iim
    169          eignq(k) = eignq(k) + matrinvn(k,i,j)*champ(i,j,l)
    170       ENDDO
    171       ENDDO
    172 #endif
    173 #endif
    174         ELSE IF ( griscal )     THEN
    175 #ifdef CRAY
    176          CALL MXVA( matriceun(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    177      *                             1, iim, iim                         )
    178 #else
    179 #ifdef BLAS
    180       CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
    181      .           champ(1,j,l), 1, 0.0, eignq, 1)
    182 #else
    183       DO k = 1, iim
    184          eignq(k) = 0.0
    185       ENDDO
    186       DO i = 1, iim
    187       DO k = 1, iim
    188          eignq(k) = eignq(k) + matriceun(k,i,j)*champ(i,j,l)
    189       ENDDO
    190       ENDDO
    191 #endif
    192 #endif
    193         ELSE
    194 #ifdef CRAY
    195          CALL MXVA( matricevn(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    196      *                             1, iim, iim                         )
    197 #else
    198 #ifdef BLAS
    199       CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
    200      .           champ(1,j,l), 1, 0.0, eignq, 1)
    201 #else
    202       DO k = 1, iim
    203          eignq(k) = 0.0
    204       ENDDO
    205       DO i = 1, iim
    206       DO k = 1, iim
    207          eignq(k) = eignq(k) + matricevn(k,i,j)*champ(i,j,l)
    208       ENDDO
    209       ENDDO
    210 #endif
    211 #endif
    212         ENDIF
    213 
    214       ELSE
    215 
    216         IF( ifiltre. EQ. -2 )   THEN
    217 #ifdef CRAY
    218          CALL MXVA( matrinvs(1,1,j-jfiltsu+1),  1, iim, champ(1,j,l),1 , 
    219      *                          eignq,  1, iim, iim                    )
    220 #else
    221 #ifdef BLAS
    222       CALL SGEMV("N", iim,iim, 1.0, matrinvs(1,1,j-jfiltsu+1),iim,
    223      .           champ(1,j,l), 1, 0.0, eignq, 1)
    224 #else
    225       DO k = 1, iim
    226          eignq(k) = 0.0
    227       ENDDO
    228       DO i = 1, iim
    229       DO k = 1, iim
    230          eignq(k) = eignq(k) + matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
    231       ENDDO
    232       ENDDO
    233 #endif
    234 #endif
    235         ELSE IF ( griscal )     THEN
    236 #ifdef CRAY
    237          CALL MXVA( matriceus(1,1,j-jfiltsu+1), 1, iim, champ(1,j,l),1 ,
    238      *                          eignq,  1, iim, iim                    )
    239 #else
    240 #ifdef BLAS
    241       CALL SGEMV("N", iim,iim, 1.0, matriceus(1,1,j-jfiltsu+1),iim,
    242      .           champ(1,j,l), 1, 0.0, eignq, 1)
    243 #else
    244       DO k = 1, iim
    245          eignq(k) = 0.0
    246       ENDDO
    247       DO i = 1, iim
    248       DO k = 1, iim
    249          eignq(k) = eignq(k) + matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
    250       ENDDO
    251       ENDDO
    252 #endif
    253 #endif
    254         ELSE
    255 #ifdef CRAY
    256          CALL MXVA( matricevs(1,1,j-jfiltsv+1), 1, iim, champ(1,j,l),1 ,
    257      *                          eignq,  1, iim, iim                    )
    258 #else
    259 #ifdef BLAS
    260       CALL SGEMV("N", iim,iim, 1.0, matricevs(1,1,j-jfiltsv+1),iim,
    261      .           champ(1,j,l), 1, 0.0, eignq, 1)
    262 #else
    263       DO k = 1, iim
    264          eignq(k) = 0.0
    265       ENDDO
    266       DO i = 1, iim
    267       DO k = 1, iim
    268          eignq(k) = eignq(k) + matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
    269       ENDDO
    270       ENDDO
    271 #endif
    272 #endif
    273         ENDIF
    274 
    275       ENDIF
    276 c
    277       IF( ifiltre.EQ. 2 )  THEN
    278         DO 15 i = 1, iim
    279         champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
    280   15    CONTINUE
    281       ELSE
    282         DO 16 i=1,iim
    283         champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
    284 16      CONTINUE
    285       ENDIF
    286 c
    287       champ( iip1,j,l ) = champ( 1,j,l )
    288 c
    289   30  CONTINUE
    290 c
    291   50  CONTINUE
    292 c   
    293  100  CONTINUE
    294 c
     280
    2952811111  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
    296      *filtrer, sur la grille des scalaires'/)
     282     &     filtrer, sur la grille des scalaires'/)
    2972832222  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
    298      *ltrer, sur la grille de V ou de Z'/)
     284     &     ltrer, sur la grille de V ou de Z'/)
    299285      RETURN
    300286      END

  • LMDZ4/branches/LMDZ4-dev/libf/filtrez/inifgn.F

    r524 r1086  
    11!
    2 ! $Header$
     2! $Header: /home/cvsroot/LMDZ4/libf/filtrez/inifgn.F,v 1.1.1.1 2004-05-19 12:53:09 lmdzadmin Exp $
    33!
    44      SUBROUTINE inifgn(dv)

  • LMDZ4/branches/LMDZ4-dev/libf/filtrez/parafilt.h

    r1024 r1086  
    33!
    44        INTEGER nfilun, nfilus, nfilvn, nfilvs
    5 
    6       PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
    7 
    8 c
    9 c
    10 c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
    11 c
    12 c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
    13 c
    14 c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et
    15 c
    16 c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
    17 c
    18 c      Parameter  ci-dessus  et de relancer  le  run . 
    19 
Note: See TracChangeset for help on using the changeset viewer.