Ignore:
Timestamp:
Jul 23, 2024, 10:21:18 PM (17 months ago)
Author:
abarral
Message:

Turn coefils.h into lmdz_coefils.f90
Put filtreg.F90 inside lmdz_filtreg.F90
Turn mod_filtreg_p.F90 into lmdz_filtreg_p.F90
Delete obsolete parafilt.h*
(lint) remove spaces between routine name and args

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3dmem
Files:
31 edited
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bernoui_loc.f90

    r5105 r5106  
    1 SUBROUTINE bernoui_loc (ngrid,nlay,pphi,pecin,pbern)
     1SUBROUTINE bernoui_loc(ngrid,nlay,pphi,pecin,pbern)
    22  USE parallel_lmdz
    3   USE mod_filtreg_p
     3  USE lmdz_filtreg_p
    44  IMPLICIT NONE
    55

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/bilan_dyn_loc.f90

    r5105 r5106  
    22! $Id: bilan_dyn_p.F 1299 2010-01-20 14:27:21Z fairhead $
    33
    4 SUBROUTINE bilan_dyn_loc (ntrac,dt_app,dt_cum, &
     4SUBROUTINE bilan_dyn_loc(ntrac,dt_app,dt_cum, &
    55        ps,masse,pk,flux_u,flux_v,teta,phi,ucov,vcov,trac)
    66

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/convmas1_loc.F90

    r5099 r5106  
    1 SUBROUTINE convmas1_loc (pbaru, pbarv, convm)
     1SUBROUTINE convmas1_loc(pbaru, pbarv, convm)
    22
    33!-------------------------------------------------------------------------------
    … …  
    77!          Equivalent to convmas_loc if convmas2_loc is called after.
    88  USE parallel_lmdz
    9   USE mod_filtreg_p
     9  USE lmdz_filtreg_p
    1010  IMPLICIT NONE
    1111  include "dimensions.h"

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/convmas2_loc.F90

    r5099 r5106  
    1 SUBROUTINE convmas2_loc (convm)
     1SUBROUTINE convmas2_loc(convm)
    22
    33!-------------------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/convmas_loc.F90

    r5099 r5106  
    1 SUBROUTINE convmas_loc (pbaru, pbarv, convm)
     1SUBROUTINE convmas_loc(pbaru, pbarv, convm)
    22
    33!-------------------------------------------------------------------------------
    … …  
    66! Purpose: Compute mass flux convergence at p levels.
    77  USE parallel_lmdz
    8   USE mod_filtreg_p
     8  USE lmdz_filtreg_p
    99  IMPLICIT NONE
    1010  include "dimensions.h"

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/covcont_loc.f90

    r5105 r5106  
    1 SUBROUTINE covcont_loc (klevel,ucov, vcov, ucont, vcont )
     1SUBROUTINE covcont_loc(klevel,ucov, vcov, ucont, vcont )
    22  USE parallel_lmdz
    33  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90

    r5105 r5106  
    99  !  *********************************************************************
    1010  USE parallel_lmdz
    11   USE mod_filtreg_p
     11  USE lmdz_filtreg_p
    1212  IMPLICIT NONE
    1313  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divgrad2_loc.f90

    r5105 r5106  
    1 SUBROUTINE divgrad2_loc ( klevel, h, deltapres, lh, divgra_out )
     1SUBROUTINE divgrad2_loc( klevel, h, deltapres, lh, divgra_out )
    22  !
    33  ! P. Le Van

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90

    r5105 r5106  
    1 SUBROUTINE dteta1_loc ( teta, pbaru, pbarv, dteta)
     1SUBROUTINE dteta1_loc( teta, pbaru, pbarv, dteta)
    22  USE parallel_lmdz
    33  USE write_field_p
    4   USE mod_filtreg_p
     4  USE lmdz_filtreg_p
    55  IMPLICIT NONE
    66

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv1_loc.f90

    r5105 r5106  
    1 SUBROUTINE dudv1_loc ( vorpot, pbaru, pbarv, du, dv )
     1SUBROUTINE dudv1_loc( vorpot, pbaru, pbarv, du, dv )
    22  USE parallel_lmdz
    33  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dudv2_loc.f90

    r5105 r5106  
    1 SUBROUTINE dudv2_loc ( teta, pkf, bern, du, dv  )
     1SUBROUTINE dudv2_loc( teta, pkf, bern, du, dv  )
    22  USE parallel_lmdz
    33  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/enercin_loc.F90

    r5099 r5106  
    1 SUBROUTINE enercin_loc ( vcov, ucov, vcont, ucont, ecin )
     1SUBROUTINE enercin_loc( vcov, ucov, vcont, ucont, ecin )
    22
    33!-------------------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_hyb_loc_m.F90

    r5103 r5106  
    3232
    3333    USE parallel_lmdz
    34     USE mod_filtreg_p
     34    USE lmdz_filtreg_p
    3535    USE write_field_loc
    3636    USE comconst_mod, ONLY: cpp, kappa, r, jmp1

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/exner_milieu_loc_m.F90

    r5103 r5106  
    55contains
    66
    7   SUBROUTINE  exner_milieu_loc ( ngrid, ps, p, pks, pk, pkf )
     7  SUBROUTINE exner_milieu_loc( ngrid, ps, p, pks, pk, pkf )
    88
    99    !     Auteurs :  F. Forget , Y. Wanherdrick
    … …  
    3030
    3131    USE parallel_lmdz
    32     USE mod_filtreg_p
     32    USE lmdz_filtreg_p
    3333    USE comconst_mod, ONLY: cpp, kappa, r, jmp1
    3434    USE comvert_mod, ONLY: preff

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/filtreg_p.F90

    r5105 r5106  
    1 
    2 
    3 SUBROUTINE filtreg_p ( champ, ibeg, iend, nlat, nbniv, &
     1! Amaury: on a ce fichier + lmdz_filtreg_p ! C'est totalement incompréhensible ;_;
     2! A minima il faut un nom clair pour chaque
     3
     4SUBROUTINE filtreg_p( champ, ibeg, iend, nlat, nbniv, &
    45        ifiltre, iaire, griscal ,iter)
    56  USE parallel_lmdz, ONLY: OMP_CHUNK
    67  USE mod_filtre_fft
    78  USE timer_filtre
    8 
    9   USE filtreg_mod
     9  USE lmdz_coefils, ONLY: jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, unsddu, unsddv, modfrstv, modfrstu
     10  USE lmdz_filtreg, ONLY: matrinvn, matrinvs, matriceun, matriceus, matricevn, matricevs
    1011
    1112  IMPLICIT NONE
    … …  
    5354  INCLUDE "dimensions.h"
    5455  INCLUDE "paramet.h"
    55   INCLUDE "coefils.h"
    56   !
     56
    5757  INTEGER :: ibeg,iend,nlat,nbniv,ifiltre,iter
    5858  INTEGER :: i,j,l,k

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90

    r5103 r5106  
    1111  USE mod_hallo
    1212  USE Bands
    13   USE filtreg_mod
     13  USE lmdz_filtreg
    1414  USE control_mod
    1515
    … …  
    2424                       dt,hour_ini,itaufin
    2525  USE mod_xios_dyn3dmem, ONLY: xios_dyn3dmem_init
     26  USE lmdz_filtreg, ONLY: inifilr
    2627
    2728  IMPLICIT NONE
    … …  
    6364  include "iniprint.h"
    6465  include "tracstoke.h"
    65 
    6666
    6767  REAL zdtvr

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/geopot_loc.f90

    r5105 r5106  
    1 SUBROUTINE geopot_loc ( ngrid, teta, pk, pks, phis, phi )
     1SUBROUTINE geopot_loc( ngrid, teta, pk, pks, phis, phi )
    22  USE parallel_lmdz
    33  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gradiv2_loc.f90

    r5105 r5106  
    1717  USE Write_field_p
    1818  USE mod_hallo
    19   USE mod_filtreg_p
     19  USE lmdz_filtreg_p
    2020  USE gradiv2_mod
    2121  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/iniacademic_loc.F90

    r5103 r5106  
    44SUBROUTINE iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
    55
    6   USE filtreg_mod, ONLY: inifilr
     6  USE lmdz_filtreg, ONLY: inifilr
    77  USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
    88  USE control_mod, ONLY: day_step,planet_type

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/integrd_loc.f90

    r5105 r5106  
    77  USE parallel_lmdz
    88  USE control_mod
    9   USE mod_filtreg_p
     9  USE lmdz_filtreg_p
    1010  USE write_field_loc
    1111  USE write_field

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_gam_loc.f90

    r5105 r5106  
    1 SUBROUTINE laplacien_gam_loc ( klevel, cuvsga, cvusga, unsaigam, &
     1SUBROUTINE laplacien_gam_loc( klevel, cuvsga, cvusga, unsaigam, &
    22        unsapolnga, unsapolsga, teta, divgra )
    33

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_loc.f90

    r5105 r5106  
    1 SUBROUTINE laplacien_loc ( klevel, teta, divgra )
     1SUBROUTINE laplacien_loc( klevel, teta, divgra )
    22  !
    33  ! P. Le Van
    … …  
    1010  !
    1111  USE parallel_lmdz
    12   USE mod_filtreg_p
     12  USE lmdz_filtreg_p
    1313  IMPLICIT NONE
    1414  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rot_loc.f90

    r5105 r5106  
    1 SUBROUTINE laplacien_rot_loc ( klevel, rotin, rotout,ghx,ghy )
     1SUBROUTINE laplacien_rot_loc( klevel, rotin, rotout,ghx,ghy )
    22  !
    33  !    P. Le Van
    … …  
    1111  !
    1212  USE parallel_lmdz
    13   USE mod_filtreg_p
     13  USE lmdz_filtreg_p
    1414  IMPLICIT NONE
    1515  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/laplacien_rotgam_loc.f90

    r5105 r5106  
    1 SUBROUTINE laplacien_rotgam_loc ( klevel, rotin, rotout )
     1SUBROUTINE laplacien_rotgam_loc( klevel, rotin, rotout )
    22  !
    33  ! P. Le Van

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90

    r5105 r5106  
    1717  USE getparam
    1818  USE control_mod
    19   USE mod_filtreg_p
     19  USE lmdz_filtreg_p
    2020  USE write_field_loc
    2121  USE allocate_field_mod

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/lmdz_filtreg_p.F90

    r5105 r5106  
    1 MODULE mod_filtreg_p
     1MODULE lmdz_filtreg_p
     2  USE lmdz_filtreg, ONLY: matrinvn, matrinvs, matriceun, matriceus, matricevn, matricevs
     3
     4  IMPLICIT NONE; PRIVATE
     5  PUBLIC filtreg_p
    26
    37CONTAINS
    48
    5   SUBROUTINE filtreg_p ( champ,jjb,jje, ibeg, iend, nlat, nbniv, &
    6           ifiltre, iaire, griscal ,iter)
     9  SUBROUTINE filtreg_p(champ, jjb, jje, ibeg, iend, nlat, nbniv, &
     10          ifiltre, iaire, griscal, iter)
    711    USE parallel_lmdz, ONLY: OMP_CHUNK
    812    USE mod_filtre_fft_loc, ONLY: use_filtre_fft, filtre_u_fft, &
    9           filtre_v_fft, filtre_inv_fft
     13            filtre_v_fft, filtre_inv_fft
    1014    USE timer_filtre, ONLY: init_timer, start_timer, stop_timer
    11 
    12     USE filtreg_mod, ONLY: matrinvn, matrinvs, matriceun, matriceus, &
    13           matricevn, matricevs
    14 
    15     IMPLICIT NONE
     15    USE lmdz_coefils, ONLY: jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, unsddu, unsddv, modfrstv, modfrstu
    1616
    1717    !=======================================================================
    … …  
    5757    INCLUDE "dimensions.h"
    5858    INCLUDE "paramet.h"
    59     INCLUDE "coefils.h"
    60     !
    61     INTEGER,INTENT(IN) :: jjb,jje,ibeg,iend,nlat,nbniv,ifiltre,iter
    62     INTEGER,INTENT(IN) :: iaire
    63     LOGICAL,INTENT(IN) :: griscal
    64     REAL,INTENT(INOUT) ::  champ( iip1,jjb:jje,nbniv)
    65 
    66     INTEGER :: i,j,l,k
    67     INTEGER :: iim2,immjm
    68     INTEGER :: jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
     59    !
     60    INTEGER, INTENT(IN) :: jjb, jje, ibeg, iend, nlat, nbniv, ifiltre, iter
     61    INTEGER, INTENT(IN) :: iaire
     62    LOGICAL, INTENT(IN) :: griscal
     63    REAL, INTENT(INOUT) :: champ(iip1, jjb:jje, nbniv)
     64
     65    INTEGER :: i, j, l, k
     66    INTEGER :: iim2, immjm
     67    INTEGER :: jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil
    6968    INTEGER :: hemisph
    70     REAL :: champ_fft(iip1,jjb:jje,nbniv)
    71      ! REAL :: champ_in(iip1,jjb:jje,nbniv)
    72 
    73     LOGICAL,SAVE     :: first=.TRUE.
    74 !$OMP THREADPRIVATE(first)
    75 
    76     REAL, DIMENSION(iip1,jjb:jje,nbniv) :: champ_loc
     69    REAL :: champ_fft(iip1, jjb:jje, nbniv)
     70    ! REAL :: champ_in(iip1,jjb:jje,nbniv)
     71
     72    LOGICAL, SAVE :: first = .TRUE.
     73    !$OMP THREADPRIVATE(first)
     74
     75    REAL, DIMENSION(iip1, jjb:jje, nbniv) :: champ_loc
    7776    INTEGER :: ll_nb, nbniv_loc
    78     REAL, SAVE :: sdd12(iim,4)
    79 !$OMP THREADPRIVATE(sdd12)
    80 
    81     INTEGER, PARAMETER :: type_sddu=1
    82     INTEGER, PARAMETER :: type_sddv=2
    83     INTEGER, PARAMETER :: type_unsddu=3
    84     INTEGER, PARAMETER :: type_unsddv=4
     77    REAL, SAVE :: sdd12(iim, 4)
     78    !$OMP THREADPRIVATE(sdd12)
     79
     80    INTEGER, PARAMETER :: type_sddu = 1
     81    INTEGER, PARAMETER :: type_sddv = 2
     82    INTEGER, PARAMETER :: type_unsddu = 3
     83    INTEGER, PARAMETER :: type_unsddv = 4
    8584
    8685    INTEGER :: sdd1_type, sdd2_type
    87     CHARACTER (LEN=132) :: abort_message
     86    CHARACTER (LEN = 132) :: abort_message
    8887
    8988    IF (first) THEN
    90        sdd12(1:iim,type_sddu) = sddu(1:iim)
    91        sdd12(1:iim,type_sddv) = sddv(1:iim)
    92        sdd12(1:iim,type_unsddu) = unsddu(1:iim)
    93        sdd12(1:iim,type_unsddv) = unsddv(1:iim)
    94 
    95        CALL Init_timer
    96        first=.FALSE.
     89      sdd12(1:iim, type_sddu) = sddu(1:iim)
     90      sdd12(1:iim, type_sddv) = sddv(1:iim)
     91      sdd12(1:iim, type_unsddu) = unsddu(1:iim)
     92      sdd12(1:iim, type_unsddv) = unsddv(1:iim)
     93
     94      CALL Init_timer
     95      first = .FALSE.
    9796    ENDIF
    9897
    99 !$OMP MASTER
     98    !$OMP MASTER
    10099    CALL start_timer
    101 !$OMP END MASTER
     100    !$OMP END MASTER
    102101
    103102    !-------------------------------------------------------c
    104103
    105104    IF(ifiltre==1.or.ifiltre==-1) &
    106           CALL abort_gcm("mod_filtreg_p",'Pas de transformee&
    107           &simple dans cette version',1)
    108 
    109     IF( iter== 2 )  THEN
    110        PRINT *,' Pas d iteration du filtre dans cette version !'&
    111              &        , ' Utiliser old_filtreg et repasser !'
    112        CALL abort_gcm("mod_filtreg_p","stopped",1)
     105            CALL abort_gcm("lmdz_filtreg_p", 'Pas de transformee&
     106                    &simple dans cette version', 1)
     107
     108    IF(iter== 2)  THEN
     109      PRINT *, ' Pas d iteration du filtre dans cette version !'&
     110              &, ' Utiliser old_filtreg et repasser !'
     111      CALL abort_gcm("lmdz_filtreg_p", "stopped", 1)
    113112    ENDIF
    114113
    115     IF( ifiltre== -2 .AND..NOT.griscal )     THEN
    116        PRINT *,' Cette routine ne calcule le filtre inverse que ' &
    117              , ' sur la grille des scalaires !'
    118        CALL abort_gcm("mod_filtreg_p","stopped",1)
     114    IF(ifiltre== -2 .AND..NOT.griscal)     THEN
     115      PRINT *, ' Cette routine ne calcule le filtre inverse que ' &
     116              , ' sur la grille des scalaires !'
     117      CALL abort_gcm("lmdz_filtreg_p", "stopped", 1)
    119118    ENDIF
    120119
    121     IF( ifiltre/=2 .AND.ifiltre/= - 2 )  THEN
    122        PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2' &
    123              , ' corriger et repasser !'
    124        CALL abort_gcm("mod_filtreg_p","stopped",1)
     120    IF(ifiltre/=2 .AND.ifiltre/= - 2)  THEN
     121      PRINT *, ' Probleme dans filtreg car ifiltre NE 2 et NE -2' &
     122              , ' corriger et repasser !'
     123      CALL abort_gcm("lmdz_filtreg_p", "stopped", 1)
    125124    ENDIF
    126125    !
    127126
    128     iim2   = iim * iim
    129     immjm  = iim * jjm
    130     !
    131     !
    132     IF( griscal )   THEN
    133        IF( nlat /= jjp1 )  THEN
    134           CALL abort_gcm("mod_filtreg_p"," nlat. NE. jjp1",1)
    135        ELSE
    136     !
    137           IF( iaire==1 )  THEN
    138              sdd1_type = type_sddv
    139              sdd2_type = type_unsddv
     127    iim2 = iim * iim
     128    immjm = iim * jjm
     129    !
     130    !
     131    IF(griscal)   THEN
     132      IF(nlat /= jjp1)  THEN
     133        CALL abort_gcm("lmdz_filtreg_p", " nlat. NE. jjp1", 1)
     134      ELSE
     135        !
     136        IF(iaire==1)  THEN
     137          sdd1_type = type_sddv
     138          sdd2_type = type_unsddv
     139        ELSE
     140          sdd1_type = type_unsddv
     141          sdd2_type = type_sddv
     142        ENDIF
     143        !
     144        jdfil1 = 2
     145        jffil1 = jfiltnu
     146        jdfil2 = jfiltsu
     147        jffil2 = jjm
     148      ENDIF
     149    ELSE
     150      IF(nlat/=jjm)  THEN
     151        CALL abort_gcm("lmdz_filtreg_p", " nlat. NE. jjm", 1)
     152      ELSE
     153        !
     154        IF(iaire==1)  THEN
     155          sdd1_type = type_sddu
     156          sdd2_type = type_unsddu
     157        ELSE
     158          sdd1_type = type_unsddu
     159          sdd2_type = type_sddu
     160        ENDIF
     161        !
     162        jdfil1 = 1
     163        jffil1 = jfiltnv
     164        jdfil2 = jfiltsv
     165        jffil2 = jjm
     166      ENDIF
     167    ENDIF
     168    !
     169    DO hemisph = 1, 2
     170      !
     171      IF (hemisph==1)  THEN
     172        !ym
     173        jdfil = max(jdfil1, ibeg)
     174        jffil = min(jffil1, iend)
     175      ELSE
     176        !ym
     177        jdfil = max(jdfil2, ibeg)
     178        jffil = min(jffil2, iend)
     179      ENDIF
     180
     181
     182      !ccccccccccccccccccccccccccccccccccccccccccc
     183      ! Utilisation du filtre classique
     184      !ccccccccccccccccccccccccccccccccccccccccccc
     185
     186      IF (.NOT. use_filtre_fft) THEN
     187
     188        ! !---------------------------------!
     189        ! ! Agregation des niveau verticaux !
     190        ! ! uniquement necessaire pour une  !
     191        ! ! execution OpenMP                !
     192        ! !---------------------------------!
     193        ll_nb = 0
     194        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     195        DO l = 1, nbniv
     196          ll_nb = ll_nb + 1
     197          DO j = jdfil, jffil
     198            DO i = 1, iim
     199              champ_loc(i, j, ll_nb) = &
     200                      champ(i, j, l) * sdd12(i, sdd1_type)
     201            ENDDO
     202          ENDDO
     203        ENDDO
     204        !$OMP END DO NOWAIT
     205
     206        nbniv_loc = ll_nb
     207
     208        IF(hemisph==1)      THEN
     209
     210          IF(ifiltre==-2)   THEN
     211            DO j = jdfil, jffil
     212#ifdef BLAS
     213                   CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
     214                         matrinvn(1,1,j), iim, &
     215                         champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
     216                         champ_fft(1,j,1), iip1*(jje-jjb+1))
     217#else
     218              champ_fft(1:iim, j, 1:nbniv_loc) = &
     219                      matmul(matrinvn(1:iim, 1:iim, j), &
     220                              champ_loc(1:iim, j, 1:nbniv_loc))
     221#endif
     222            ENDDO
     223
     224          ELSE IF (griscal)     THEN
     225            DO j = jdfil, jffil
     226#ifdef BLAS
     227                   CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
     228                         matriceun(1,1,j), iim, &
     229                         champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
     230                         champ_fft(1,j,1), iip1*(jje-jjb+1))
     231#else
     232              champ_fft(1:iim, j, 1:nbniv_loc) = &
     233                      matmul(matriceun(1:iim, 1:iim, j), &
     234                              champ_loc(1:iim, j, 1:nbniv_loc))
     235#endif
     236            ENDDO
     237
    140238          ELSE
    141              sdd1_type = type_unsddv
    142              sdd2_type = type_sddv
     239            DO j = jdfil, jffil
     240#ifdef BLAS
     241                   CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
     242                         matricevn(1,1,j), iim, &
     243                         champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
     244                         champ_fft(1,j,1), iip1*(jje-jjb+1))
     245#else
     246              champ_fft(1:iim, j, 1:nbniv_loc) = &
     247                      matmul(matricevn(1:iim, 1:iim, j), &
     248                              champ_loc(1:iim, j, 1:nbniv_loc))
     249#endif
     250            ENDDO
     251
    143252          ENDIF
    144     !
    145           jdfil1 = 2
    146           jffil1 = jfiltnu
    147           jdfil2 = jfiltsu
    148           jffil2 = jjm
    149        ENDIF
    150     ELSE
    151        IF( nlat/=jjm )  THEN
    152           CALL abort_gcm("mod_filtreg_p"," nlat. NE. jjm",1)
    153        ELSE
    154     !
    155           IF( iaire==1 )  THEN
    156              sdd1_type = type_sddu
    157              sdd2_type = type_unsddu
     253
     254        ELSE
     255
     256          IF(ifiltre==-2)   THEN
     257            DO j = jdfil, jffil
     258#ifdef BLAS
     259                   CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
     260                         matrinvs(1,1,j-jfiltsu+1), iim, &
     261                         champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
     262                         champ_fft(1,j,1), iip1*(jje-jjb+1))
     263#else
     264              champ_fft(1:iim, j, 1:nbniv_loc) = &
     265                      matmul(matrinvs(1:iim, 1:iim, j - jfiltsu + 1), &
     266                              champ_loc(1:iim, j, 1:nbniv_loc))
     267#endif
     268            ENDDO
     269
     270          ELSE IF (griscal)     THEN
     271
     272            DO j = jdfil, jffil
     273#ifdef BLAS
     274                   CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
     275                         matriceus(1,1,j-jfiltsu+1), iim, &
     276                         champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
     277                         champ_fft(1,j,1), iip1*(jje-jjb+1))
     278#else
     279              champ_fft(1:iim, j, 1:nbniv_loc) = &
     280                      matmul(matriceus(1:iim, 1:iim, j - jfiltsu + 1), &
     281                              champ_loc(1:iim, j, 1:nbniv_loc))
     282#endif
     283            ENDDO
     284
    158285          ELSE
    159              sdd1_type = type_unsddu
    160              sdd2_type = type_sddu
     286
     287            DO j = jdfil, jffil
     288#ifdef BLAS
     289                   CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
     290                         matricevs(1,1,j-jfiltsv+1), iim, &
     291                         champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
     292                         champ_fft(1,j,1), iip1*(jje-jjb+1))
     293#else
     294              champ_fft(1:iim, j, 1:nbniv_loc) = &
     295                      matmul(matricevs(1:iim, 1:iim, j - jfiltsv + 1), &
     296                              champ_loc(1:iim, j, 1:nbniv_loc))
     297#endif
     298            ENDDO
     299
    161300          ENDIF
    162     !
    163           jdfil1 = 1
    164           jffil1 = jfiltnv
    165           jdfil2 = jfiltsv
    166           jffil2 = jjm
    167        ENDIF
    168     ENDIF
    169     !
    170     DO hemisph = 1, 2
    171     !
    172        IF ( hemisph==1 )  THEN
    173     !ym
    174           jdfil = max(jdfil1,ibeg)
    175           jffil = min(jffil1,iend)
    176        ELSE
    177     !ym
    178           jdfil = max(jdfil2,ibeg)
    179           jffil = min(jffil2,iend)
    180        ENDIF
    181 
    182 
    183     !ccccccccccccccccccccccccccccccccccccccccccc
    184     ! Utilisation du filtre classique
    185     !ccccccccccccccccccccccccccccccccccccccccccc
    186 
    187        IF (.NOT. use_filtre_fft) THEN
    188 
    189     ! !---------------------------------!
    190     ! ! Agregation des niveau verticaux !
    191     ! ! uniquement necessaire pour une  !
    192     ! ! execution OpenMP                !
    193     ! !---------------------------------!
     301
     302        ENDIF
     303        ! c
     304        IF(ifiltre==2)  THEN
     305
     306          ! !-------------------------------------!
     307          ! ! Dés-agregation des niveau verticaux !
     308          ! ! uniquement necessaire pour une      !
     309          ! ! execution OpenMP                    !
     310          ! !-------------------------------------!
    194311          ll_nb = 0
    195 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     312          !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    196313          DO l = 1, nbniv
    197              ll_nb = ll_nb+1
    198              DO j = jdfil,jffil
    199                 DO i = 1, iim
    200                    champ_loc(i,j,ll_nb) = &
    201                          champ(i,j,l) * sdd12(i,sdd1_type)
    202                 ENDDO
    203              ENDDO
    204           ENDDO
    205 !$OMP END DO NOWAIT
    206 
    207           nbniv_loc = ll_nb
    208 
    209           IF( hemisph==1 )      THEN
    210 
    211              IF( ifiltre==-2 )   THEN
    212                 DO j = jdfil,jffil
    213 #ifdef BLAS
    214                    CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
    215                          matrinvn(1,1,j), iim, &
    216                          champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
    217                          champ_fft(1,j,1), iip1*(jje-jjb+1))
    218 #else
    219                    champ_fft(1:iim,j,1:nbniv_loc)= &
    220                          matmul(matrinvn(1:iim,1:iim,j), &
    221                          champ_loc(1:iim,j,1:nbniv_loc))
    222 #endif
    223                 ENDDO
    224 
    225              ELSE IF ( griscal )     THEN
    226                 DO j = jdfil,jffil
    227 #ifdef BLAS
    228                    CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
    229                          matriceun(1,1,j), iim, &
    230                          champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
    231                          champ_fft(1,j,1), iip1*(jje-jjb+1))
    232 #else
    233                    champ_fft(1:iim,j,1:nbniv_loc)= &
    234                          matmul(matriceun(1:iim,1:iim,j), &
    235                          champ_loc(1:iim,j,1:nbniv_loc))
    236 #endif
    237                 ENDDO
    238 
    239              ELSE
    240                 DO j = jdfil,jffil
    241 #ifdef BLAS
    242                    CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
    243                          matricevn(1,1,j), iim, &
    244                          champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
    245                          champ_fft(1,j,1), iip1*(jje-jjb+1))
    246 #else
    247                    champ_fft(1:iim,j,1:nbniv_loc)= &
    248                          matmul(matricevn(1:iim,1:iim,j), &
    249                          champ_loc(1:iim,j,1:nbniv_loc))
    250 #endif
    251                 ENDDO
    252 
    253              ENDIF
    254 
     314            ll_nb = ll_nb + 1
     315            DO j = jdfil, jffil
     316              DO i = 1, iim
     317                champ(i, j, l) = (champ_loc(i, j, ll_nb) &
     318                        + champ_fft(i, j, ll_nb)) &
     319                        * sdd12(i, sdd2_type)
     320              ENDDO
     321            ENDDO
     322          ENDDO
     323          !$OMP END DO NOWAIT
     324
     325        ELSE
     326
     327          ll_nb = 0
     328          !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     329          DO l = 1, nbniv
     330            ll_nb = ll_nb + 1
     331            DO j = jdfil, jffil
     332              DO i = 1, iim
     333                champ(i, j, l) = (champ_loc(i, j, ll_nb) &
     334                        - champ_fft(i, j, ll_nb)) &
     335                        * sdd12(i, sdd2_type)
     336              ENDDO
     337            ENDDO
     338          ENDDO
     339          !$OMP END DO NOWAIT
     340
     341        ENDIF
     342
     343        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     344        DO l = 1, nbniv
     345          DO j = jdfil, jffil
     346            ! ! add redundant longitude
     347            champ(iip1, j, l) = champ(1, j, l)
     348          ENDDO
     349        ENDDO
     350        !$OMP END DO NOWAIT
     351
     352        !cccccccccccccccccccccccccccccccccccccccccccc
     353        ! Utilisation du filtre FFT
     354        !cccccccccccccccccccccccccccccccccccccccccccc
     355
     356      ELSE
     357
     358        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     359        DO l = 1, nbniv
     360          DO j = jdfil, jffil
     361            DO  i = 1, iim
     362              champ(i, j, l) = champ(i, j, l) * sdd12(i, sdd1_type)
     363              champ_fft(i, j, l) = champ(i, j, l)
     364            ENDDO
     365          ENDDO
     366        ENDDO
     367        !$OMP END DO NOWAIT
     368
     369        IF (jdfil<=jffil) THEN
     370          IF(ifiltre == -2)   THEN
     371            CALL Filtre_inv_fft(champ_fft, jjb, jje, jdfil, jffil, nbniv)
     372          ELSE IF (griscal)     THEN
     373            CALL Filtre_u_fft(champ_fft, jjb, jje, jdfil, jffil, nbniv)
    255374          ELSE
    256 
    257              IF( ifiltre==-2 )   THEN
    258                 DO j = jdfil,jffil
    259 #ifdef BLAS
    260                    CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
    261                          matrinvs(1,1,j-jfiltsu+1), iim, &
    262                          champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
    263                          champ_fft(1,j,1), iip1*(jje-jjb+1))
    264 #else
    265                    champ_fft(1:iim,j,1:nbniv_loc)= &
    266                          matmul(matrinvs(1:iim,1:iim,j-jfiltsu+1), &
    267                          champ_loc(1:iim,j,1:nbniv_loc))
    268 #endif
    269                 ENDDO
    270 
    271              ELSE IF ( griscal )     THEN
    272 
    273                 DO j = jdfil,jffil
    274 #ifdef BLAS
    275                    CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
    276                          matriceus(1,1,j-jfiltsu+1), iim, &
    277                          champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
    278                          champ_fft(1,j,1), iip1*(jje-jjb+1))
    279 #else
    280                    champ_fft(1:iim,j,1:nbniv_loc)= &
    281                          matmul(matriceus(1:iim,1:iim,j-jfiltsu+1), &
    282                          champ_loc(1:iim,j,1:nbniv_loc))
    283 #endif
    284                 ENDDO
    285 
    286              ELSE
    287 
    288                 DO j = jdfil,jffil
    289 #ifdef BLAS
    290                    CALL SGEMM("N", "N", iim, nbniv_loc, iim, 1.0, &
    291                          matricevs(1,1,j-jfiltsv+1), iim, &
    292                          champ_loc(1,j,1), iip1*(jje-jjb+1), 0.0, &
    293                          champ_fft(1,j,1), iip1*(jje-jjb+1))
    294 #else
    295                    champ_fft(1:iim,j,1:nbniv_loc)= &
    296                          matmul(matricevs(1:iim,1:iim,j-jfiltsv+1), &
    297                          champ_loc(1:iim,j,1:nbniv_loc))
    298 #endif
    299                 ENDDO
    300 
    301              ENDIF
    302 
     375            CALL Filtre_v_fft(champ_fft, jjb, jje, jdfil, jffil, nbniv)
    303376          ENDIF
    304     ! c
    305           IF( ifiltre==2 )  THEN
    306 
    307     ! !-------------------------------------!
    308     ! ! Dés-agregation des niveau verticaux !
    309     ! ! uniquement necessaire pour une      !
    310     ! ! execution OpenMP                    !
    311     ! !-------------------------------------!
    312              ll_nb = 0
    313 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    314              DO l = 1, nbniv
    315                 ll_nb = ll_nb + 1
    316                 DO j = jdfil,jffil
    317                    DO i = 1, iim
    318                       champ( i,j,l ) = (champ_loc(i,j,ll_nb) &
    319                             + champ_fft(i,j,ll_nb)) &
    320                             * sdd12(i,sdd2_type)
    321                    ENDDO
    322                 ENDDO
    323              ENDDO
    324 !$OMP END DO NOWAIT
    325 
    326           ELSE
    327 
    328              ll_nb = 0
    329 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    330              DO l = 1, nbniv
    331                 ll_nb = ll_nb + 1
    332                 DO j = jdfil,jffil
    333                    DO i = 1, iim
    334                       champ( i,j,l ) = (champ_loc(i,j,ll_nb) &
    335                             - champ_fft(i,j,ll_nb)) &
    336                             * sdd12(i,sdd2_type)
    337                    ENDDO
    338                 ENDDO
    339              ENDDO
    340 !$OMP END DO NOWAIT
    341 
    342           ENDIF
    343 
    344 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     377        ENDIF
     378
     379        IF(ifiltre== 2)  THEN
     380          !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    345381          DO l = 1, nbniv
    346              DO j = jdfil,jffil
    347                 ! ! add redundant longitude
    348                 champ( iip1,j,l ) = champ( 1,j,l )
    349              ENDDO
    350           ENDDO
    351 !$OMP END DO NOWAIT
    352 
    353     !cccccccccccccccccccccccccccccccccccccccccccc
    354     ! Utilisation du filtre FFT
    355     !cccccccccccccccccccccccccccccccccccccccccccc
    356 
    357        ELSE
    358 
    359 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    360           DO l=1,nbniv
    361              DO j=jdfil,jffil
    362                 DO  i = 1, iim
    363                    champ( i,j,l)= champ(i,j,l)*sdd12(i,sdd1_type)
    364                    champ_fft( i,j,l) = champ(i,j,l)
    365                 ENDDO
    366              ENDDO
    367           ENDDO
    368 !$OMP END DO NOWAIT
    369 
    370           IF (jdfil<=jffil) THEN
    371              IF( ifiltre == -2 )   THEN
    372               CALL Filtre_inv_fft(champ_fft,jjb,jje,jdfil,jffil,nbniv)
    373              ELSE IF ( griscal )     THEN
    374                 CALL Filtre_u_fft(champ_fft,jjb,jje,jdfil,jffil,nbniv)
    375              ELSE
    376                 CALL Filtre_v_fft(champ_fft,jjb,jje,jdfil,jffil,nbniv)
    377              ENDIF
    378           ENDIF
    379 
    380 
    381           IF( ifiltre== 2 )  THEN
    382 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    383              DO l=1,nbniv
    384                 DO j=jdfil,jffil
    385                    DO  i = 1, iim
    386                       champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l)) &
    387                             *sdd12(i,sdd2_type)
    388                    ENDDO
    389                 ENDDO
    390              ENDDO
    391 !$OMP END DO NOWAIT     
    392           ELSE
    393 
    394 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    395              DO l=1,nbniv
    396                 DO j=jdfil,jffil
    397                    DO  i = 1, iim
    398                       champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l)) &
    399                             *sdd12(i,sdd2_type)
    400                    ENDDO
    401                 ENDDO
    402              ENDDO
    403 !$OMP END DO NOWAIT
    404           ENDIF
    405     !
    406 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    407           DO l=1,nbniv
    408              DO j=jdfil,jffil
    409            ! champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
    410            !      ! add redundant longitude
    411                 champ( iip1,j,l ) = champ( 1,j,l )
    412              ENDDO
    413           ENDDO
    414 !$OMP END DO NOWAIT             
    415        ENDIF
    416     ! Fin de la zone de filtrage
    417 
     382            DO j = jdfil, jffil
     383              DO  i = 1, iim
     384                champ(i, j, l) = (champ(i, j, l) + champ_fft(i, j, l)) &
     385                        * sdd12(i, sdd2_type)
     386              ENDDO
     387            ENDDO
     388          ENDDO
     389          !$OMP END DO NOWAIT
     390        ELSE
     391
     392          !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     393          DO l = 1, nbniv
     394            DO j = jdfil, jffil
     395              DO  i = 1, iim
     396                champ(i, j, l) = (champ(i, j, l) - champ_fft(i, j, l)) &
     397                        * sdd12(i, sdd2_type)
     398              ENDDO
     399            ENDDO
     400          ENDDO
     401          !$OMP END DO NOWAIT
     402        ENDIF
     403        !
     404        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     405        DO l = 1, nbniv
     406          DO j = jdfil, jffil
     407            ! champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
     408            !      ! add redundant longitude
     409            champ(iip1, j, l) = champ(1, j, l)
     410          ENDDO
     411        ENDDO
     412        !$OMP END DO NOWAIT
     413      ENDIF
     414      ! Fin de la zone de filtrage
    418415
    419416    ENDDO
    420417
    421      ! DO j=1,nlat
    422 
    423      !     PRINT *,"check FFT ----> Delta(",j,")=",
     418    ! DO j=1,nlat
     419
     420    !     PRINT *,"check FFT ----> Delta(",j,")=",
    424421    ! &            sum(champ(:,j,:)-champ_fft(:,j,:))/sum(champ(:,j,:)),
    425422    ! &            sum(champ(:,j,:)-champ_in(:,j,:))/sum(champ(:,j,:))
    … …  
    430427
    431428    !
    432 !$OMP MASTER
     429    !$OMP MASTER
    433430    CALL stop_timer
    434 !$OMP END MASTER
     431    !$OMP END MASTER
    435432
    436433  END SUBROUTINE filtreg_p
    437 END MODULE mod_filtreg_p
    438 
     434END MODULE lmdz_filtreg_p
     435

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgrad_loc.f90

    r5105 r5106  
    1 SUBROUTINE nxgrad_loc (klevel, rot, x, y )
     1SUBROUTINE nxgrad_loc(klevel, rot, x, y )
    22  !
    33  ! P. Le Van

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90

    r5105 r5106  
    1616  USE times
    1717  USE mod_hallo
    18   USE mod_filtreg_p
     18  USE lmdz_filtreg_p
    1919  USE nxgraro2_mod
    2020  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_nfil_loc.f90

    r5105 r5106  
    1 SUBROUTINE rotat_nfil_loc (klevel, x, y, rot )
     1SUBROUTINE rotat_nfil_loc(klevel, x, y, rot )
    22  !
    33  !    Auteur :   P.Le Van

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotat_p.f90

    r5105 r5106  
    1 SUBROUTINE rotat_p (klevel, x, y, rot )
     1SUBROUTINE rotat_p(klevel, x, y, rot )
    22  !
    33  ! Auteur : P.Le Van

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/rotatf_loc.f90

    r5105 r5106  
    1 SUBROUTINE rotatf_loc (klevel, x, y, rot )
     1SUBROUTINE rotatf_loc(klevel, x, y, rot )
    22  !
    33  ! Auteur : P.Le Van
    … …  
    1111  !
    1212  USE parallel_lmdz
    13   USE mod_filtreg_p
     13  USE lmdz_filtreg_p
    1414  IMPLICIT NONE
    1515  !

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/tourpot_loc.F90

    r5099 r5106  
    1 SUBROUTINE tourpot_loc ( vcov, ucov, massebxy, vorpot )
     1SUBROUTINE tourpot_loc( vcov, ucov, massebxy, vorpot )
    22
    33!-------------------------------------------------------------------------------
    … …  
    66! Purpose: Compute potential vorticity.
    77  USE parallel_lmdz
    8   USE mod_filtreg_p
     8  USE lmdz_filtreg_p
    99  IMPLICIT NONE
    1010  include "dimensions.h"
Note: See TracChangeset for help on using the changeset viewer.