Ignore:
Timestamp:
Mar 31, 2015, 3:49:07 PM (10 years ago)
Author:
emillour
Message:

All models: Reorganizing the physics/dynamics interface.

  • makelmdz and makelmdz_fcm scripts adapted to handle the new directory settings
  • misc: (replaces what was the "bibio" directory)
  • Should only contain extremely generic (and non physics or dynamics-specific) routines
  • Therefore moved initdynav.F90, initfluxsto.F, inithist.F, writedynav.F90, write_field.F90, writehist.F to "dyn3d_common"
  • dynlonlat_phylonlat: (new interface directory)
  • This directory contains routines relevent to physics/dynamics grid interactions, e.g. routines gr_dyn_fi or gr_fi_dyn and calfis
  • Moreover the dynlonlat_phylonlat contains directories "phy*" corresponding to each physics package "phy*" to be used. These subdirectories should only contain specific interfaces (e.g. iniphysiq) or main programs (e.g. newstart)
  • phy*/dyn1d: this subdirectory contains the 1D model using physics from phy*

EM

Location:
trunk/LMDZ.MARS/libf/filtrez
Files:
2 edited
1 moved

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.MARS/libf/filtrez/coefils.h

    r38 r1403  
    1       COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
    2      * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
    3      * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
    4      * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
    5 c
     1      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
     2     & ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),      &
     3     & modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)    &
     4     & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
     5!c
    66      INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
    77      REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv

  • trunk/LMDZ.MARS/libf/filtrez/filtreg_mod.F90

    r1401 r1403  
     1MODULE filtreg_mod
     2
     3CONTAINS
     4
    15      SUBROUTINE inifilr
    2 c
    3 c    ... H. Upadhyaya, O.Sharma   ...
    4 c
     6!
     7!    ... H. Upadhyaya, O.Sharma   ...
     8!
    59      IMPLICIT NONE
    6 c
    7 c     version 3 .....
    8 
    9 c     Correction  le 28/10/97    P. Le Van .
    10 c  -------------------------------------------------------------------
     10!
     11!     version 3 .....
     12
     13!     Correction  le 28/10/97    P. Le Van .
     14!  -------------------------------------------------------------------
    1115#include "dimensions.h"
    1216#include "paramet.h"
    1317#include "parafilt.h"
    14 c  -------------------------------------------------------------------
     18!  -------------------------------------------------------------------
    1519#include "comgeom.h"
    1620#include "coefils.h"
    … …  
    2024      REAL  dlonu(iim),dlatu(jjm)
    2125      REAL  rlamda( iim ),  eignvl( iim )
    22 c
     26!
    2327
    2428      REAL    lamdamax,pi,cof
    … …  
    2630      REAL dymin,dxmin,colat0
    2731      REAL eignft(iim,iim), coff
    28       REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
    29       COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
    30      ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    31      ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
     32      REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs 
     33      COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus) &
     34                   , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs) &
     35                   ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    3236#ifdef CRAY
    3337      INTEGER   ISMIN
    … …  
    3741#endif
    3842      EXTERNAL  inifgn
    39 c
    40 c ------------------------------------------------------------
    41 c   This routine computes the eigenfunctions of the laplacien
    42 c   on the stretched grid, and the filtering coefficients
    43 c     
    44 c  We designate:
    45 c   eignfn   eigenfunctions of the discrete laplacien
    46 c   eigenvl  eigenvalues
    47 c   jfiltn   indexof the last scalar line filtered in NH
    48 c   jfilts   index of the first line filtered in SH
    49 c   modfrst  index of the mode from where modes are filtered
    50 c   modemax  maximum number of modes ( im )
    51 c   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
    52 c   sdd      SQRT( dx )
    53 c     
    54 c     the modes are filtered from modfrst to modemax
    55 c     
    56 c-----------------------------------------------------------
    57 c
     43!
     44! ------------------------------------------------------------
     45!   This routine computes the eigenfunctions of the laplacien
     46!   on the stretched grid, and the filtering coefficients
     47!     
     48!  We designate:
     49!   eignfn   eigenfunctions of the discrete laplacien
     50!   eigenvl  eigenvalues
     51!   jfiltn   indexof the last scalar line filtered in NH
     52!   jfilts   index of the first line filtered in SH
     53!   modfrst  index of the mode from where modes are filtered
     54!   modemax  maximum number of modes ( im )
     55!   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
     56!   sdd      SQRT( dx )
     57!     
     58!     the modes are filtered from modfrst to modemax
     59     
     60!-----------------------------------------------------------
     61!
    5862
    5963       pi       = 2. * ASIN( 1. )
    … …  
    6266        dlonu(i) = xprimu( i )
    6367       ENDDO
    64 c
     68!
    6569       CALL inifgn(eignvl)
    66 c
     70!
    6771        print *,' EIGNVL '
    6872        PRINT 250,eignvl
    6973250     FORMAT( 1x,5e13.6)
    70 c
    71 c compute eigenvalues and eigenfunctions
    72 c
    73 c
    74 c.................................................................
    75 c
    76 c  compute the filtering coefficients for scalar lines and
    77 c  meridional wind v-lines
    78 c
    79 c  we filter all those latitude lines where coefil < 1
    80 c  NO FILTERING AT POLES
    81 c
    82 c  colat0 is to be used  when alpha (stretching coefficient)
    83 c  is set equal to zero for the regular grid case
    84 c
    85 c    .......   Calcul  de  colat0   .........
    86 c     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
    87 c
    88 c
     74!
     75! compute eigenvalues and eigenfunctions
     76!
     77!
     78!.................................................................
     79!
     80!  compute the filtering coefficients for scalar lines and
     81!  meridional wind v-lines
     82!
     83!  we filter all those latitude lines where coefil < 1
     84!  NO FILTERING AT POLES
     85!
     86!  colat0 is to be used  when alpha (stretching coefficient)
     87!  is set equal to zero for the regular grid case
     88!
     89!    .......   Calcul  de  colat0   .........
     90!     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
     91!
     92!
    8993      DO 45 j = 1,jjm
    9094         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
    9195 45   CONTINUE
    92 c
     96!
    9397#ifdef CRAY
    9498      iymin   = ISMIN( jjm, dlatu, 1 )
    … …  
    106110       ENDDO
    107111#endif
    108 c
    109 c
     112!
     113!
    110114      colat0  =  MIN( 0.5, dymin/dxmin )
    111 c
     115!
    112116      IF( .NOT.fxyhypb.AND.ysinus )  THEN
    113117           colat0 = 0.6
    114 c         ...... a revoir  pour  ysinus !   .......
     118!         ...... a revoir  pour  ysinus !   .......
    115119           alphax = 0.
    116120      ENDIF
    117 c
     121!
    118122      PRINT 50, colat0,alphax
    119123  50  FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7)
    120 c
     124!
    121125      IF(alphax.EQ.1. )  THEN
    122126        PRINT *,' Inifilr  alphax doit etre  <  a 1.  Corriger '
    123127         STOP
    124128      ENDIF
    125 c
     129!
    126130      lamdamax = iim / ( pi * colat0 * ( 1. - alphax ) )
    127131
    128 cc                        ... Correction  le 28/10/97  ( P.Le Van ) ..
    129 c
     132!c                        ... Correction  le 28/10/97  ( P.Le Van ) ..
     133!
    130134      DO 71 i = 2,iim
    131135       rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
    132136 71   CONTINUE
    133 c
     137!
    134138
    135139      DO 72 j = 1,jjm
    … …  
    142146 72   CONTINUE
    143147
    144 c
    145 c    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
    146 c    .........................................................
    147 c
     148!
     149!    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
     150!    .........................................................
     151!
    148152       modemax = iim
    149153
    150 cccc    imx = modemax - 4 * (modemax/iim)
     154!ccc    imx = modemax - 4 * (modemax/iim)
    151155
    152156       imx  = iim
    153 c
     157!
    154158       PRINT *,' TRUNCATION AT ',imx
    155 c
     159!
    156160      DO 75 j = 2, jjm/2+1
    157161       cof = COS( rlatu(j) )/ colat0
    … …  
    162166       cof = COS( rlatu(jjp1-j+1) )/ colat0
    163167            IF ( cof .LT. 1. ) THEN
    164           IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. )
    165      $      jfiltsu= jjp1-j+1
     168          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. ) &
     169            jfiltsu= jjp1-j+1
    166170        ENDIF
    167171 75   CONTINUE
    168 c
     172!
    169173      DO 76 j = 1, jjm/2
    170174       cof = COS( rlatv(j) )/ colat0
    … …  
    175179       cof = COS( rlatv(jjm-j+1) )/ colat0
    176180            IF ( cof .LT. 1. ) THEN
    177           IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. )
    178      $       jfiltsv= jjm-j+1
     181          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. ) &
     182             jfiltsv= jjm-j+1
    179183        ENDIF
    180184 76   CONTINUE
    181 c                                 
     185!                                 
    182186
    183187      IF( jfiltnu.LE.0 .OR. jfiltnu.GT. jjm/2 +1 )  THEN
    … …  
    201205      ENDIF
    202206
    203        PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' ,
    204      *           jfiltnv,jfiltsv,jfiltnu,jfiltsu
    205 
    206 c                                 
    207 c   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
    208 c................................................................
    209 c
    210 c
     207       PRINT *,' jfiltnv jfiltsv jfiltnu jfiltsu ' , &
     208                 jfiltnv,jfiltsv,jfiltnu,jfiltsu
     209
     210!                                 
     211!   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
     212!................................................................
     213!
     214!
    211215      DO 77 j = 1,jjm
    212216          modfrstu( j ) = iim
    213217          modfrstv( j ) = iim
    214218 77   CONTINUE
    215 c
     219!
    216220      DO 84 j = 2,jfiltnu
    217221       DO 81 k = 2,modemax
    … …  
    221225      GOTO 84
    222226 82   modfrstu( j ) = k
    223 c
     227!
    224228          kf = modfrstu( j )
    225229           DO 83 k = kf , modemax
    … …  
    229233 83    CONTINUE
    230234 84   CONTINUE
    231 c                                 
    232 c
     235!                                 
     236!
    233237      DO 89 j = 1,jfiltnv
    234 c
     238!
    235239       DO 86 k = 2,modemax
    236240            cof = rlamda(k) * COS( rlatv(j) )
    … …  
    239243      GOTO 89
    240244 87   modfrstv( j ) = k
    241 c
     245!
    242246           kf = modfrstv( j )
    243247           DO 88 k = kf , modemax
    … …  
    246250            coefilv2(k,j) = cof*cof - 1.
    247251 88    CONTINUE
    248 c
     252!
    249253 89    CONTINUE
    250 c
     254!
    251255      DO 94 j = jfiltsu,jjm
    252256       DO 91 k = 2,modemax
    … …  
    256260      GOTO 94
    257261 92   modfrstu( j ) = k
    258 c
     262!
    259263        kf = modfrstu( j )
    260264         DO 93 k = kf , modemax
    … …  
    264268 93      CONTINUE
    265269 94    CONTINUE
    266 c                                 
     270!                                 
    267271      DO 99 j = jfiltsv,jjm
    268272       DO 96 k = 2,modemax
    … …  
    272276      GOTO 99
    273277 97   modfrstv( j ) = k
    274 c
     278!
    275279       kf = modfrstv( j )
    276280           DO 98 k = kf , modemax
    … …  
    280284 98    CONTINUE
    281285 99   CONTINUE
    282 c
     286!
    283287
    284288       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN
    … …  
    287291         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu
    288292
    289           PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
    290      *        jfiltnv,jfiltsv,jfiltnu,jfiltsu
     293          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' , &
     294              jfiltnv,jfiltsv,jfiltnu,jfiltsu
    291295       ENDIF
    292296
    … …  
    298302     
    299303      IF( nfilun.LT. jfiltnu )  THEN
    300        PRINT *,' le parametre nfilun utilise pour la matrice ',
    301      *   ' matriceun  est trop petit ! '
     304       PRINT *,' le parametre nfilun utilise pour la matrice ', &
     305         ' matriceun  est trop petit ! '
    302306       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
    303         PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
    304      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    305      *  ,jfiltnv,jjm-jfiltsv+1
     307        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
     308       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     309        ,jfiltnv,jjm-jfiltsv+1
    306310               STOP
    307311      ENDIF
    308312      IF( nfilun.GT. jfiltnu+ 2 )  THEN
    309            PRINT *,' le parametre nfilun utilise pour la matrice ',
    310      *' matriceun est trop grand ! Gachis de memoire ! '
     313           PRINT *,' le parametre nfilun utilise pour la matrice ', &
     314      ' matriceun est trop grand ! Gachis de memoire ! '
    311315       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnu
    312         PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs '
    313      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    314      *  ,jfiltnv,jjm-jfiltsv+1
    315 c              STOP
     316        PRINT *,' Pour information, nfilun,nfilus,nfilvn,nfilvs ' &
     317       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     318        ,jfiltnv,jjm-jfiltsv+1
     319!              STOP
    316320      ENDIF
    317321      IF( nfilus.LT. jjm - jfiltsu +1 )  THEN
    318             PRINT *,' le parametre nfilus utilise pour la matrice ',
    319      *   ' matriceus  est trop petit !  '
    320        PRINT *,' Le changer dans parafilt.h et le mettre a  ',
    321      * jjm - jfiltsu + 1
    322         PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
    323      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    324      *  ,jfiltnv,jjm-jfiltsv+1
     322            PRINT *,' le parametre nfilus utilise pour la matrice ', &
     323         ' matriceus  est trop petit !  '
     324       PRINT *,' Le changer dans parafilt.h et le mettre a  ', &
     325       jjm - jfiltsu + 1
     326        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
     327       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     328        ,jfiltnv,jjm-jfiltsv+1
    325329               STOP
    326330      ENDIF
    327331      IF( nfilus.GT. jjm - jfiltsu + 3 )  THEN
    328            PRINT *,' le parametre nfilus utilise pour la matrice ',
    329      * ' matriceus  est trop grand ! '
    330        PRINT *,' Le changer dans parafilt.h et le mettre a  ' ,
    331      * jjm - jfiltsu + 1
    332         PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
    333      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    334      *  ,jfiltnv,jjm-jfiltsv+1
    335 c              STOP
     332           PRINT *,' le parametre nfilus utilise pour la matrice ', &
     333       ' matriceus  est trop grand ! '
     334       PRINT *,' Le changer dans parafilt.h et le mettre a  ' , &
     335       jjm - jfiltsu + 1
     336        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
     337       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     338        ,jfiltnv,jjm-jfiltsv+1
     339!              STOP
    336340      ENDIF
    337341      IF( nfilvn.LT. jfiltnv )  THEN
    338             PRINT *,' le parametre nfilvn utilise pour la matrice ',
    339      *   ' matricevn  est trop petit ! ' 
     342            PRINT *,' le parametre nfilvn utilise pour la matrice ', &
     343         ' matricevn  est trop petit ! ' 
    340344       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
    341         PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
    342      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    343      *  ,jfiltnv,jjm-jfiltsv+1
     345        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
     346       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     347        ,jfiltnv,jjm-jfiltsv+1
    344348               STOP
    345349      ENDIF
    346350      IF( nfilvn.GT. jfiltnv+ 2 )  THEN
    347            PRINT *,' le parametre nfilvn utilise pour la matrice ',
    348      *' matricevn est trop grand !  Gachis de memoire ! '
     351           PRINT *,' le parametre nfilvn utilise pour la matrice ', &
     352      ' matricevn est trop grand !  Gachis de memoire ! '
    349353       PRINT *,'Le changer dans parafilt.h et le mettre a  ',jfiltnv
    350         PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
    351      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    352      *  ,jfiltnv,jjm-jfiltsv+1
    353 c              STOP
     354        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
     355       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     356        ,jfiltnv,jjm-jfiltsv+1
     357!              STOP
    354358      ENDIF
    355359      IF( nfilvs.LT. jjm - jfiltsv +1 )  THEN
    356             PRINT *,' le parametre nfilvs utilise pour la matrice ',
    357      *   ' matricevs  est trop petit !  Le changer dans parafilt.h '
    358        PRINT *,' Le changer dans parafilt.h et le mettre a  '
    359      * , jjm - jfiltsv + 1
    360         PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
    361      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    362      *  ,jfiltnv,jjm-jfiltsv+1
     360            PRINT *,' le parametre nfilvs utilise pour la matrice ', &
     361         ' matricevs  est trop petit !  Le changer dans parafilt.h '
     362       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
     363       , jjm - jfiltsv + 1
     364        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
     365       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     366        ,jfiltnv,jjm-jfiltsv+1
    363367               STOP
    364368      ENDIF
    365369      IF( nfilvs.GT. jjm - jfiltsv + 3 )  THEN
    366            PRINT *,' le parametre nfilvs utilise pour la matrice ',
    367      * ' matricevs  est trop grand ! Gachis de memoire ! '
    368        PRINT *,' Le changer dans parafilt.h et le mettre a  '
    369      *   ,  jjm - jfiltsv + 1
    370         PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs '
    371      * ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1
    372      *  ,jfiltnv,jjm-jfiltsv+1
    373 c              STOP
    374       ENDIF
    375 
    376 c 
    377 c   ...................................................................
    378 c
    379 c   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
    380 c                       sur la grille scalaire                 ........
    381 c   ...................................................................
    382 c
     370           PRINT *,' le parametre nfilvs utilise pour la matrice ', &
     371       ' matricevs  est trop grand ! Gachis de memoire ! '
     372       PRINT *,' Le changer dans parafilt.h et le mettre a  ' &
     373         ,  jjm - jfiltsv + 1
     374        PRINT *,' Pour information , nfilun,nfilus,nfilvn,nfilvs ' &
     375       ,'doivent etre egaux successivement a  ',jfiltnu,jjm-jfiltsu+1 &
     376        ,jfiltnv,jjm-jfiltsv+1
     377!              STOP
     378      ENDIF
     379
     380! 
     381!   ...................................................................
     382!
     383!   ... Calcul de la matrice filtre 'matriceu'  pour les champs situes
     384!                       sur la grille scalaire                 ........
     385!   ...................................................................
     386!
    383387        DO j = 2, jfiltnu
    384388
    … …  
    394398#else
    395399#ifdef BLAS
    396          CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
    397      $   eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
     400         CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
     401         eignfnv, iim, eignft, iim, 0.0, matriceun(1,1,j), iim)
    398402#else
    399403         DO k = 1, iim
    … …  
    401405            matriceun(i,k,j) = 0.0
    402406            DO ii = 1, iim
    403                matriceun(i,k,j) = matriceun(i,k,j)
    404      .                          + eignfnv(i,ii)*eignft(ii,k)
     407               matriceun(i,k,j) = matriceun(i,k,j) &
     408                                + eignfnv(i,ii)*eignft(ii,k)
    405409            ENDDO
    406410         ENDDO
    … …  
    424428#else
    425429#ifdef BLAS
    426       CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
    427      $           eignfnv, iim, eignft, iim, 0.0,
    428      $           matriceus(1,1,j-jfiltsu+1), iim)
     430      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
     431                 eignfnv, iim, eignft, iim, 0.0, &
     432                 matriceus(1,1,j-jfiltsu+1), iim)
    429433#else
    430434         DO k = 1, iim
    … …  
    432436            matriceus(i,k,j-jfiltsu+1) = 0.0
    433437            DO ii = 1, iim
    434                matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1)
    435      .                                    + eignfnv(i,ii)*eignft(ii,k)
     438               matriceus(i,k,j-jfiltsu+1) = matriceus(i,k,j-jfiltsu+1) &
     439                                          + eignfnv(i,ii)*eignft(ii,k)
    436440            ENDDO
    437441         ENDDO
    … …  
    442446        ENDDO
    443447
    444 c   ...................................................................
    445 c
    446 c   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
    447 c                       sur la grille   de V ou de Z           ........
    448 c   ...................................................................
    449 c
     448!   ...................................................................
     449!
     450!   ... Calcul de la matrice filtre 'matricev'  pour les champs situes
     451!                       sur la grille   de V ou de Z           ........
     452!   ...................................................................
     453!
    450454        DO j = 1, jfiltnv
    451455
    … …  
    461465#else
    462466#ifdef BLAS
    463       CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
    464      $     eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
     467      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
     468           eignfnu, iim, eignft, iim, 0.0, matricevn(1,1,j), iim)
    465469#else
    466470         DO k = 1, iim
    … …  
    468472            matricevn(i,k,j) = 0.0
    469473            DO ii = 1, iim
    470                matricevn(i,k,j) = matricevn(i,k,j)
    471      .                          + eignfnu(i,ii)*eignft(ii,k)
     474               matricevn(i,k,j) = matricevn(i,k,j) &
     475                                + eignfnu(i,ii)*eignft(ii,k)
    472476            ENDDO
    473477         ENDDO
    … …  
    491495#else
    492496#ifdef BLAS
    493       CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
    494      $           eignfnu, iim, eignft, iim, 0.0,
    495      $           matricevs(1,1,j-jfiltsv+1), iim)
     497      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
     498                 eignfnu, iim, eignft, iim, 0.0, &
     499                 matricevs(1,1,j-jfiltsv+1), iim)
    496500#else
    497501         DO k = 1, iim
    … …  
    499503            matricevs(i,k,j-jfiltsv+1) = 0.0
    500504            DO ii = 1, iim
    501                matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1)
    502      .                          + eignfnu(i,ii)*eignft(ii,k)
     505               matricevs(i,k,j-jfiltsv+1) = matricevs(i,k,j-jfiltsv+1) &
     506                                + eignfnu(i,ii)*eignft(ii,k)
    503507            ENDDO
    504508         ENDDO
    … …  
    509513        ENDDO
    510514
    511 c   ...................................................................
    512 c
    513 c   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
    514 c              sur la grille scalaire , pour le filtre inverse ........
    515 c   ...................................................................
    516 c
     515!   ...................................................................
     516!
     517!   ... Calcul de la matrice filtre 'matrinv'  pour les champs situes
     518!              sur la grille scalaire , pour le filtre inverse ........
     519!   ...................................................................
     520!
    517521        DO j = 2, jfiltnu
    518522
    … …  
    528532#else
    529533#ifdef BLAS
    530       CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
    531      $     eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
     534      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
     535           eignfnv, iim, eignft, iim, 0.0, matrinvn(1,1,j), iim)
    532536#else
    533537         DO k = 1, iim
    … …  
    535539            matrinvn(i,k,j) = 0.0
    536540            DO ii = 1, iim
    537                matrinvn(i,k,j) = matrinvn(i,k,j)
    538      .                          + eignfnv(i,ii)*eignft(ii,k)
     541               matrinvn(i,k,j) = matrinvn(i,k,j) &
     542                                + eignfnv(i,ii)*eignft(ii,k)
    539543            ENDDO
    540544         ENDDO
    … …  
    558562#else
    559563#ifdef BLAS
    560       CALL SGEMM ('N', 'N', iim, iim, iim, 1.0,
    561      $ eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
     564      CALL SGEMM ('N', 'N', iim, iim, iim, 1.0, &
     565       eignfnv, iim, eignft, iim, 0.0, matrinvs(1,1,j-jfiltsu+1), iim)
    562566#else
    563567         DO k = 1, iim
    … …  
    565569            matrinvs(i,k,j-jfiltsu+1) = 0.0
    566570            DO ii = 1, iim
    567                matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1)
    568      .                          + eignfnv(i,ii)*eignft(ii,k)
     571               matrinvs(i,k,j-jfiltsu+1) = matrinvs(i,k,j-jfiltsu+1) &
     572                                + eignfnv(i,ii)*eignft(ii,k)
    569573            ENDDO
    570574         ENDDO
    … …  
    575579        ENDDO
    576580
    577 c   ...................................................................
    578 
    579 c
     581!   ...................................................................
     582
     583!
    580584334    FORMAT(1x,24i3)
    581585755    FORMAT(1x,6f10.3,i3)
    582586
    583587       RETURN
    584        END
     588       END SUBROUTINE inifilr
     589
     590END MODULE  filtreg_mod

  • trunk/LMDZ.MARS/libf/filtrez/parafilt.h

    r38 r1403  
    11        INTEGER nfilun, nfilus, nfilvn, nfilvs
    2 c
    3 c 48 32 19 non-zoom:
    4 c       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
    5 c        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
    6 c         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
    7 c        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
    8 cmaf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
    9 c
    10 c
    11 c 96 49 11 non-zoom:
    12 ccc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
    13 c
    14 c
    15 c 144 73 11 non-zoom:
    16 ccc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
    17 c
    18 c 192 143 19 non-zoom:
    19 c             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
    20 c      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
    21 c      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
     2!
     3! 48 32 19 non-zoom:
     4!       PARAMETER (nfilun=30,nfilus=30,nfilvn=30,nfilvs=30)
     5!        PARAMETER (nfilun=6, nfilus=5, nfilvn=5, nfilvs=5)
     6!         PARAMETER (nfilun=15, nfilus=8, nfilvn=14, nfilvs=8)
     7!        PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
     8!maf -debug  PARAMETER (nfilun=2, nfilus=1, nfilvn=2, nfilvs=2)
     9!
     10!
     11! 96 49 11 non-zoom:
     12!cc      PARAMETER (nfilun=9, nfilus=8, nfilvn=8, nfilvs=8)
     13!
     14!
     15! 144 73 11 non-zoom:
     16!cc      PARAMETER (nfilun=13, nfilus=12, nfilvn=12, nfilvs=12)
     17!
     18! 192 143 19 non-zoom:
     19!             PARAMETER (nfilun=13, nfilus=12, nfilvn=13, nfilvs=13)
     20!      PARAMETER (nfilun=15, nfilus=14, nfilvn=14, nfilvs=14) !!NO fxyhyper
     21!      PARAMETER (nfilun=18, nfilus=17, nfilvn=17, nfilvs=17) !!NO fxyhyper
    2222!!        PARAMETER (nfilun=9,nfilus=8,nfilvn=8,nfilvs=8)
    2323        PARAMETER (nfilun=9,nfilus=9,nfilvn=9,nfilvs=9)
    24 c 96 72 19 non-zoom:
    25 ccc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
    26 c
    27 c        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
    28 c        PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
    29 c
    30 c
    31 c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
    32 c
    33 c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
    34 c
    35 c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et
    36 c
    37 c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
    38 c
    39 c      Parameter  ci-dessus  et de relancer  le  run . 
     24! 96 72 19 non-zoom:
     25!cc      PARAMETER (nfilun=12, nfilus=11, nfilvn=12, nfilvs=12)
     26!
     27!        PARAMETER ( nfilun=20, nfilus=20, nfilvn=20, nfilvs=20 )
     28!       PARAMETER ( nfilun=8, nfilus=7, nfilvn=7, nfilvs=7 )
     29!
     30!
     31!      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
     32!
     33!      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
     34!
     35!      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et
     36!
     37!      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
     38!
     39!      Parameter  ci-dessus  et de relancer  le  run . 
    4040
Note: See TracChangeset for help on using the changeset viewer.