Ignore:
Timestamp:
Aug 2, 2024, 9:58:25 PM (7 months ago)
Author:
abarral
Message:

Put dimensions.h and paramet.h into modules

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

Legend:

Unmodified
Added
Removed

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

    r5136 r5159  
    1010  USE lmdz_comgeom
    1111
     12  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     13  USE lmdz_paramet
    1214  IMPLICIT NONE
    13   !
     15
    1416  !=======================================================================
    15   !
     17
    1618  !    Addition of the physical tendencies
    17   !
     19
    1820  !    Interface :
    1921  !    -----------
    20   !
     22
    2123  !  Input :
    2224  !  -------
    … …  
    3234  !  pdhfi(ip1jmp1)         |      tendencies
    3335  !  pdtsfi(ip1jmp1)        |
    34   !
     36
    3537  !  Output :
    3638  !  --------
    … …  
    3941  !  ph
    4042  !  pts
    41   !
    42   !
     43
     44
    4345  !=======================================================================
    44   !
     46
    4547  !-----------------------------------------------------------------------
    46   !
     48
    4749  !    0.  Declarations :
    4850  !    ------------------
    4951  !
    50   INCLUDE "dimensions.h"
    51   INCLUDE "paramet.h"
    52   !
     52
     53
     54
    5355  !    Arguments :
    5456  !    -----------
    55   !
     57
    5658  REAL, INTENT(IN) :: pdt ! time step for the integration (s)
    57   !
     59
    5860  REAL, INTENT(INOUT) :: pvcov(ijb_v:ije_v, llm) ! covariant meridional wind
    5961  REAL, INTENT(INOUT) :: pucov(ijb_u:ije_u, llm) ! covariant zonal wind
    … …  
    6769  REAL, INTENT(IN) :: pdhfi(ijb_u:ije_u, llm)
    6870  REAL, INTENT(IN) :: pdpfi(ijb_u:ije_u)
    69   !
     71
    7072  LOGICAL, INTENT(IN) :: leapf, forward ! not used
    71   !
    72   !
     73
     74
    7375  !    Local variables :
    7476  !    -----------------
    75   !
     77
    7678  REAL :: xpn(iim), xps(iim), tpn, tps
    7779  INTEGER :: j, k, iq, ij
    … …  
    8082
    8183  INTEGER :: ijb, ije
    82   !
     84
    8385  !-----------------------------------------------------------------------
    8486
    … …  
    148150  !$OMP END DO NOWAIT
    149151
    150   !
     152
    151153  IF (pole_sud)  ije = ij_end
    152154  !$OMP MASTER

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

    r5136 r5159  
    1111  USE lmdz_comgeom
    1212
     13  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     14  USE lmdz_paramet
    1315  IMPLICIT NONE
    1416  !=======================================================================
    15   !
     17
    1618  !   Auteurs:  P. Le Van , Fr. Hourdin  .
    1719  !   -------
    18   !
     20
    1921  !   Objet:
    2022  !   ------
    21   !
     23
    2224  !   *************************************************************
    2325  !   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
    … …  
    2527  !    ces termes sont ajoutes a du,dv,dteta et dq .
    2628  !  Modif F.Forget 03/94 : on retire q de advect
    27   !
     29
    2830  !=======================================================================
    2931  !-----------------------------------------------------------------------
    … …  
    3133  !   -------------
    3234
    33   INCLUDE "dimensions.h"
    34   INCLUDE "paramet.h"
     35
     36
    3537
    3638  !   Arguments:
    … …  
    230232
    231233    ! IF( conser)  THEN
    232     !
     234
    233235    !    DO 17 ij = 1,ip1jmp1
    234236    !    ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)

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

    r1907 r5159  
    1717  USE allocate_field_mod
    1818  USE parallel_lmdz
    19   USE dimensions_mod
     19  USE lmdz_dimensions
     20  USE lmdz_paramet
    2021  IMPLICIT NONE
    2122  TYPE(distrib),POINTER :: d

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

    r5136 r5159  
    2424  USE lmdz_comgeom2
    2525
     26USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     27  USE lmdz_paramet
    2628  IMPLICIT NONE
    2729
    28   INCLUDE "dimensions.h"
    29   INCLUDE "paramet.h"
     30
     31
    3032
    3133  !---------------------------------------------------------------------------

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

    r4050 r5159  
    1010  USE parallel_lmdz
    1111  USE vlspltgen_mod
     12USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     13  USE lmdz_paramet
    1214  IMPLICIT NONE
    13   INCLUDE "dimensions.h"
    14   INCLUDE "paramet.h"
     15
     16
    1517  TYPE(distrib),POINTER :: d
    1618   

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

    r5082 r5159  
    158158  SUBROUTINE allocate1d_u2d(field,d)
    159159  USE parallel_lmdz
    160   USE dimensions_mod
     160  USE lmdz_dimensions
     161  USE lmdz_paramet
    161162  IMPLICIT NONE
    162163  REAL,POINTER :: field(:,:)
    … …  
    175176  SUBROUTINE allocate2d_u2d(field,dim1,d)
    176177  USE parallel_lmdz
    177   USE dimensions_mod
     178  USE lmdz_dimensions
     179  USE lmdz_paramet
    178180  IMPLICIT NONE
    179181  REAL,POINTER :: field(:,:,:)
    … …  
    192194  SUBROUTINE allocate3d_u2d(field,dim1,dim2,d)
    193195  USE parallel_lmdz
    194   USE dimensions_mod
     196  USE lmdz_dimensions
     197  USE lmdz_paramet
    195198  IMPLICIT NONE
    196199  REAL,POINTER :: field(:,:,:,:)
    … …  
    211214  SUBROUTINE allocate1d_v2d(field,d)
    212215  USE parallel_lmdz
    213   USE dimensions_mod
     216  USE lmdz_dimensions
     217  USE lmdz_paramet
    214218  IMPLICIT NONE
    215219  REAL,POINTER :: field(:,:)
    … …  
    228232  SUBROUTINE allocate2d_v2d(field,dim1,d)
    229233  USE parallel_lmdz
    230   USE dimensions_mod
     234  USE lmdz_dimensions
     235  USE lmdz_paramet
    231236  IMPLICIT NONE
    232237  REAL,POINTER :: field(:,:,:)
    … …  
    245250  SUBROUTINE allocate3d_v2d(field,dim1,dim2,d)
    246251  USE parallel_lmdz
    247   USE dimensions_mod
     252  USE lmdz_dimensions
     253  USE lmdz_paramet
    248254  IMPLICIT NONE
    249255  REAL,POINTER :: field(:,:,:,:)
    … …  
    511517  USE parallel_lmdz
    512518  USE mod_hallo
    513   USE dimensions_mod
     519  USE lmdz_dimensions
     520  USE lmdz_paramet
    514521  IMPLICIT NONE
    515522  REAL,POINTER :: field(:,:)
    … …  
    548555  USE parallel_lmdz
    549556  USE mod_hallo
    550   USE dimensions_mod
     557  USE lmdz_dimensions
     558  USE lmdz_paramet
    551559  IMPLICIT NONE
    552560  REAL,POINTER :: field(:,:,:)
    … …  
    585593  USE parallel_lmdz
    586594  USE mod_hallo
    587   USE dimensions_mod
     595  USE lmdz_dimensions
     596  USE lmdz_paramet
    588597  IMPLICIT NONE
    589598  REAL,POINTER :: field(:,:,:,:)
    … …  
    625634  USE parallel_lmdz
    626635  USE mod_hallo
    627   USE dimensions_mod
     636  USE lmdz_dimensions
     637  USE lmdz_paramet
    628638  IMPLICIT NONE
    629639  REAL,POINTER :: field(:,:)
    … …  
    662672  USE parallel_lmdz
    663673  USE mod_hallo
    664   USE dimensions_mod
     674  USE lmdz_dimensions
     675  USE lmdz_paramet
    665676  IMPLICIT NONE
    666677  REAL,POINTER :: field(:,:,:)
    … …  
    699710  USE parallel_lmdz
    700711  USE mod_hallo
    701   USE dimensions_mod
     712  USE lmdz_dimensions
     713  USE lmdz_paramet
    702714  IMPLICIT NONE
    703715  REAL,POINTER :: field(:,:,:,:)

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

    r5158 r5159  
    4242  SUBROUTINE Read_distrib
    4343    USE parallel_lmdz
     44USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    4445    IMPLICIT NONE
    4546
    46     INCLUDE "dimensions.h"
     47
    4748      INTEGER :: i,j
    4849      CHARACTER (LEN=4) :: siim,sjjm,sllm,sproc
    … …  
    104105   SUBROUTINE  Set_Bands
    105106     USE parallel_lmdz
     107USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    106108     IMPLICIT NONE
    107      INCLUDE 'dimensions.h'   
     109
    108110     INTEGER :: i, ij
    109111     INTEGER :: jj_para_begin(0:mpi_size-1)
    … …  
    437439    SUBROUTINE WriteBands
    438440    USE parallel_lmdz
     441USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    439442    IMPLICIT NONE
    440     INCLUDE "dimensions.h"
     443
    441444
    442445      INTEGER :: i,j

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

    r5134 r5159  
    22  USE parallel_lmdz
    33  USE lmdz_filtreg_p
     4  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     5  USE lmdz_paramet
    46  IMPLICIT NONE
    57
    68  !=======================================================================
    7   !
     9
    810  !   Auteur:   P. Le Van
    911  !   -------
    10   !
     12
    1113  !   Objet:
    1214  !   ------
    … …  
    1416  ! phi  et  ecin  sont des arguments d'entree pour le s-pg .......
    1517  !      bern       est un  argument de sortie pour le s-pg  ......
    16   !
     18
    1719  !    fonction de Bernouilli = bern = filtre de( geopotentiel +
    1820  !                          energ.cinet.)
    19   !
     21
    2022  !=======================================================================
    21   !
     23
    2224  !-----------------------------------------------------------------------
    2325  !   Decalrations:
    2426  !   -------------
    2527  !
    26   INCLUDE "dimensions.h"
    27   INCLUDE "paramet.h"
    28   !
     28
     29
     30
    2931  !   Arguments:
    3032  !   ----------
    31   !
     33
    3234  INTEGER :: nlay,ngrid
    3335  REAL :: pphi(ijb_u:ije_u,nlay),pecin(ijb_u:ije_u,nlay)
    3436  REAL :: pbern(ijb_u:ije_u,nlay)
    35   !
     37
    3638  !   Local:
    3739  !   ------
    38   !
     40
    3941  INTEGER :: ij,l,ijb,ije,jjb,jje
    40   !
     42
    4143  !-----------------------------------------------------------------------
    4244  !   calcul de Bernouilli:
    4345  !   ---------------------
    44   !
     46
    4547  ijb=ij_begin
    4648  ije=ij_end+iip1
    … …  
    6062   ENDDO
    6163!$OMP END DO NOWAIT
    62   !
     64
    6365  !-----------------------------------------------------------------------
    6466  !   filtre:
    … …  
    6971    CALL filtreg_p( pbern,jjb_u,jje_u,jjb,jje, jjp1, llm, &
    7072          2,1, .TRUE., 1 )
    71   !
     73
    7274  !-----------------------------------------------------------------------
    7375

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

    r5158 r5159  
    2121  USE lmdz_comgeom2
    2222
     23USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     24  USE lmdz_paramet
    2325  IMPLICIT NONE
    2426
    25   INCLUDE "dimensions.h"
    26   INCLUDE "paramet.h"
     27
     28
    2729
    2830  !====================================================================
    29   !
     31
    3032  !   Sous-programme consacre à des diagnostics dynamiques de base
    31   !
    32   !
     33
     34
    3335  !   De facon generale, les moyennes des scalaires Q sont ponderees par
    3436  !   la masse.
    35   !
     37
    3638  !   Les flux de masse sont eux simplement moyennes.
    37   !
     39
    3840  !====================================================================
    3941
    … …  
    145147
    146148  !   Variables locales
    147   !
     149
    148150  INTEGER :: tau0
    149151  REAL :: zjulian
    … …  
    152154  INTEGER :: ii,jj
    153155  INTEGER :: zan, dayref
    154   !
     156
    155157  REAL,SAVE,ALLOCATABLE :: rlong(:),rlatg(:)
    156158  INTEGER :: jjb,jje,jjn,ijb,ije
    … …  
    287289        bilan_dyn_domain_id)
    288290
    289   !
     291
    290292  !  Appel a histvert pour la grille verticale
    291   !
     293
    292294  CALL histvert(fileid, 'presnivs', 'Niveaux sigma','mb', &
    293295        llm, presnivs, zvertiid)
    294   !
     296
    295297  !  Appels a histdef pour la definition des variables a sauvegarder
    296298  DO iQ=1,nQ
    … …  
    403405  !   Cumul
    404406  !=====================================================================
    405   !
     407
    406408  IF(icum==0) THEN
    407409     jjb=jj_begin
    … …  
    689691  !   calcul de la moyenne zonale du transport :
    690692  !   ------------------------------------------
    691   !
     693
    692694  !                                 --
    693695  ! TOT : la circulation totale       [ vq ]
    694   !
     696
    695697  !                                  -     -
    696698  ! MMC : mean meridional circulation [ v ] [ q ]
    697   !
     699
    698700  !                                 ----      --       - -
    699701  ! TRS : transitoires                [ v'q'] = [ vq ] - [ v q ]
    700   !
     702
    701703  !                                 - * - *       - -       -     -
    702704  ! STT : stationaires                [ v   q   ] = [ v q ] - [ v ] [ q ]
    703   !
     705
    704706  !                                          - -
    705707  !    on utilise aussi l'intermediaire TMP :  [ v q ]
    706   !
     708
    707709  !    la variable zfactv transforme un transport meridien cumule
    708710  !    en kg/s * unte-du-champ-transporte en m/s * unite-du-champ-transporte
    709   !
     711
    710712  !   --------------------------------------------------------------
    711713

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

    r5134 r5159  
    11! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
    22
    3 !
    4 !
     3
     4
    55SUBROUTINE caladvtrac_loc(q, pbaru, pbarv, &
    66        p, masse, dq, teta, &
    … …  
    1717  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
    1818
     19  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     20  USE lmdz_paramet
    1921  IMPLICIT NONE
    20   !
     22
    2123  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
    22   !
     24
    2325  ! F.Codron (10/99) : ajout humidite specifique pour eau vapeur
    2426  !=======================================================================
    25   !
     27
    2628  !   Shema de  Van Leer
    27   !
     29
    2830  !=======================================================================
    2931
    30   INCLUDE "dimensions.h"
    31   INCLUDE "paramet.h"
     32
     33
    3234
    3335  !   Arguments:

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

    r5101 r5159  
    3434  USE advtrac_mod, ONLY: advtrac_allocate
    3535  USE groupe_mod
     36USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     37  USE lmdz_paramet
    3638  IMPLICIT NONE
    37   INCLUDE "dimensions.h"
    38   INCLUDE "paramet.h"
     39
     40
    3941  TYPE(distrib),POINTER :: d
    4042

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

    r5136 r5159  
    1212  USE lmdz_comgeom
    1313
     14  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15  USE lmdz_paramet
    1416  IMPLICIT NONE
    1517
    … …  
    3032  !   ----------------
    3133
    32   INCLUDE "dimensions.h"
    33   INCLUDE "paramet.h"
     34
     35
    3436
    3537  !   Arguments:

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

    r5101 r5159  
    2222  USE allocate_field_mod
    2323  USE parallel_lmdz
    24   USE dimensions_mod
     24  USE lmdz_dimensions
     25  USE lmdz_paramet
    2526  USE advect_new_mod,ONLY: advect_new_allocate
    2627  IMPLICIT NONE

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

    r5136 r5159  
    2323    USE allocate_field_mod
    2424    USE parallel_lmdz
    25     USE dimensions_mod
     25    USE lmdz_dimensions
     26    USE lmdz_paramet
    2627    USE dissip_mod, ONLY: dissip_allocate
    2728    IMPLICIT NONE
    … …  
    7778
    7879  SUBROUTINE call_dissip(ucov_dyn, vcov_dyn, teta_dyn, p_dyn, pk_dyn, ps_dyn)
    79     USE dimensions_mod
     80    USE lmdz_dimensions
     81    USE lmdz_paramet
    8082    USE parallel_lmdz
    8183    USE times

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

    r5134 r5159  
    66
    77
     8USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    89   IMPLICIT NONE
    9    INCLUDE "dimensions.h"
     10
    1011   REAL,             INTENT(INOUT) :: q(ijb_u:ije_u,llm,nqtot)
    1112   INTEGER,          INTENT(IN)    :: ijb, ije   !--- Can be local and different from ijb_u,ije_u, for example in qminimum

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

    r5134 r5159  
    2525          tetagrot, tetatemp, coefdis, vert_prof_dissip
    2626
     27  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     28  USE lmdz_paramet
    2729  IMPLICIT NONE
    2830  !-----------------------------------------------------------------------
    … …  
    3234
    3335  !     tapedef   :
    34   !     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
     36  !     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
    3537  !     -metres  du zoom  avec  celles lues sur le fichier start .
    3638
    … …  
    4042  !   Declarations :
    4143  !   --------------
    42   INCLUDE "dimensions.h"
    43   INCLUDE "paramet.h"
     44
     45
    4446
    4547  !   local:

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

    r5136 r5159  
    11SUBROUTINE convflu_loc( xflu,yflu,nbniv,convfl )
    2   !
     2
    33  !  P. Le Van
    4   !
    5   !
     4
     5
    66  !    *******************************************************************
    77  !  ... calcule la (convergence horiz. * aire locale)du flux ayant pour
    … …  
    1010  !  xflu , yflu et nbniv sont des arguments d'entree pour le s-pg ..
    1111  !  convfl                est  un argument de sortie pour le s-pg .
    12   !
     12
    1313  ! njxflu  est le nombre de lignes de latitude de xflu,
    1414  ! ( = jjm ou jjp1 )
    1515  ! nbniv   est le nombre de niveaux vert. de  xflu et de yflu .
    16   !
     16
    1717  USE parallel_lmdz
    1818  USE lmdz_ssum_scopy, ONLY: ssum
    1919  USE lmdz_comgeom
    2020
     21USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     22  USE lmdz_paramet
    2123  IMPLICIT NONE
    2224  !
    23   INCLUDE "dimensions.h"
    24   INCLUDE "paramet.h"
     25
     26
    2527  REAL :: xflu,yflu,convfl,convpn,convps
    2628  INTEGER :: l,ij,nbniv
    2729  DIMENSION  xflu( ijb_u:ije_u,nbniv ),yflu( ijb_v:ije_v,nbniv ) , &
    2830        convfl( ijb_u:ije_u,nbniv )
    29   !
     31
    3032  INTEGER :: ijb,ije
    3133
    3234!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3335  DO l = 1,nbniv
    34   !
     36
    3537    ijb=ij_begin
    3638    ije=ij_end+iip1
    … …  
    4345            yflu(ij +1,l ) - yflu( ij -iim,l )
    4446  END DO
    45   !
     47
    4648  !
    4749
    4850  ! ....  correction pour  convfl( 1,j,l)  ......
    4951  ! ....   convfl(1,j,l)= convfl(iip1,j,l) ...
    50   !
     52
    5153  !DIR$ IVDEP
    5254    DO ij = ijb,ije,iip1
    5355      convfl( ij,l ) = convfl( ij + iim,l )
    5456  END DO
    55   !
     57
    5658  ! ......  calcul aux poles  .......
    57   !
     59
    5860    IF (pole_nord) THEN
    5961

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

    r5136 r5159  
    1010  USE lmdz_comgeom
    1111
     12USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     13  USE lmdz_paramet
    1214  IMPLICIT NONE
    13   INCLUDE "dimensions.h"
    14   INCLUDE "paramet.h"
     15
     16
    1517!===============================================================================
    1618! Arguments:

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

    r5136 r5159  
    99  USE lmdz_comgeom
    1010
     11USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     12  USE lmdz_paramet
    1113  IMPLICIT NONE
    12   INCLUDE "dimensions.h"
    13   INCLUDE "paramet.h"
     14
     15
    1416!===============================================================================
    1517! Arguments:

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

    r5136 r5159  
    99  USE lmdz_comgeom
    1010
     11USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     12  USE lmdz_paramet
    1113  IMPLICIT NONE
    12   INCLUDE "dimensions.h"
    13   INCLUDE "paramet.h"
     14
     15
    1416!===============================================================================
    1517! Arguments:

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

    r5136 r5159  
    33  USE lmdz_comgeom
    44
     5  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     6  USE lmdz_paramet
    57  IMPLICIT NONE
    68
    79  !=======================================================================
    8   !
     10
    911  !   Auteur:  P. Le Van
    1012  !   -------
    11   !
     13
    1214  !   Objet:
    1315  !   ------
    14   !
     16
    1517  !  *********************************************************************
    1618  !    calcul des compos. contravariantes a partir des comp.covariantes
    1719  !  ********************************************************************
    18   !
     20
    1921  !=======================================================================
    2022
    21   INCLUDE "dimensions.h"
    22   INCLUDE "paramet.h"
     23
     24
    2325
    2426  INTEGER :: klevel

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

    r5136 r5159  
    66  USE lmdz_comgeom
    77
     8  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     9  USE lmdz_paramet
    810  IMPLICIT NONE
    911
    1012  !=======================================================================
    11   !
     13
    1214  !   Auteur:  F Hourdin Phu LeVan
    1315  !   -------
    14   !
     16
    1517  !   Objet:
    1618  !   ------
    17   !
     19
    1820  !  *********************************************************************
    1921  !    calcul des compos. naturelles a partir des comp.covariantes
    2022  !  ********************************************************************
    21   !
     23
    2224  !=======================================================================
    2325
    24   INCLUDE "dimensions.h"
    25   INCLUDE "paramet.h"
     26
     27
    2628
    2729  INTEGER :: klevel

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

    r5136 r5159  
    22
    33SUBROUTINE dissip_loc(vcov, ucov, teta, p, dv, du, dh)
    4   !
     4
    55  USE parallel_lmdz
    66  USE write_field_loc
    … …  
    1313  USE lmdz_comgeom
    1414
     15  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    1618
    … …  
    2022
    2123  !=======================================================================
    22   !
     24
    2325  !   Auteur:  P. Le Van
    2426  !   -------
    25   !
     27
    2628  !   Objet:
    2729  !   ------
    28   !
     30
    2931  !   Dissipation horizontale
    30   !
     32
    3133  !=======================================================================
    3234  !-----------------------------------------------------------------------
    … …  
    3436  !   -------------
    3537
    36   INCLUDE "dimensions.h"
    37   INCLUDE "paramet.h"
     38
     39
    3840
    3941  !   Arguments:

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

    r5101 r5159  
    99  USE allocate_field_mod
    1010  USE parallel_lmdz
    11   USE dimensions_mod
     11  USE lmdz_dimensions
     12  USE lmdz_paramet
    1213  USE gradiv2_mod, ONLY: gradiv2_allocate
    1314  USE nxgraro2_mod, ONLY: nxgraro2_allocate

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

    r5140 r5159  
    11SUBROUTINE diverg_gam_loc(klevel,cuvscvgam,cvuscugam,unsairegam, &
    22        unsapolnga,unsapolsga,  x, y,  div )
    3   !
     3
    44  ! P. Le Van
    5   !
     5
    66  !  *********************************************************************
    77  !  ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
    … …  
    1313  USE lmdz_comgeom
    1414
     15  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    16   !
     18
    1719  !  x  et  y  sont des arguments  d'entree pour le s-prog
    1820  !    div      est  un argument  de sortie pour le s-prog
    1921
    20   INCLUDE "dimensions.h"
    21   INCLUDE "paramet.h"
    22   !
     22
     23
     24
    2325  !    ..........          variables en arguments    ...................
    24   !
     26
    2527  INTEGER :: klevel
    2628  REAL :: x( ijb_u:ije_u,klevel ),y( ijb_v:ije_v,klevel )
    … …  
    2830  REAL :: cuvscvgam(ip1jm),cvuscugam(ip1jmp1),unsairegam(ip1jmp1)
    2931  REAL :: unsapolnga,unsapolsga
    30   !
     32
    3133  !    ...............     variables  locales   .........................
    3234
    … …  
    3638  !    ...................................................................
    3739  INTEGER :: ijb,ije,jjb,jje
    38   !
    39   !
     40
     41
    4042  ijb=ij_begin
    4143  ije=ij_end
    … …  
    4547!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    4648  DO l = 1,klevel
    47   !
     49
    4850    DO  ij = ijb, ije - 1
    4951     div( ij + 1, l )     = ( &
    … …  
    5254           unsairegam( ij+1 )
    5355    ENDDO
    54   !
     56
    5557  ! ....  correction pour  div( 1,j,l)  ......
    5658  ! ....   div(1,j,l)= div(iip1,j,l) ....
    57   !
     59
    5860  !DIR$ IVDEP
    5961    DO  ij = ijb,ije,iip1
    6062     div( ij,l ) = div( ij + iim,l )
    6163    ENDDO
    62   !
     64
    6365  ! ....  calcul  aux poles  .....
    64   !
     66
    6567   IF (pole_nord) THEN
    6668      DO  ij  = 1,iim
    … …  
    6870      ENDDO
    6971      sumypn = SSUM ( iim,aiy1,1 ) * unsapolnga
    70   !
     72
    7173      DO  ij = 1,iip1
    7274       div(     ij    , l ) = - sumypn
    … …  
    7981      ENDDO
    8082      sumyps = SSUM ( iim,aiy2,1 ) * unsapolsga
    81   !
     83
    8284      DO  ij = 1,iip1
    8385       div( ij + ip1jm, l ) =   sumyps

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

    r5140 r5159  
    11SUBROUTINE diverg_p(klevel,x,y,div)
    2   !
     2
    33  ! P. Le Van
    4   !
     4
    55  !  *********************************************************************
    66  !  ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
    … …  
    1212  USE lmdz_comgeom
    1313
     14  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15  USE lmdz_paramet
    1416  IMPLICIT NONE
    15   !
     17
    1618  !  x  et  y  sont des arguments  d'entree pour le s-prog
    1719  !    div      est  un argument  de sortie pour le s-prog
    1820  !
    1921
    20   INCLUDE "dimensions.h"
    21   INCLUDE "paramet.h"
    22   !
     22
     23
     24
    2325  !    ..........          variables en arguments    ...................
    24   !
     26
    2527  INTEGER :: klevel
    2628  REAL :: x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
    2729  INTEGER :: l,ij
    28   !
     30
    2931  !    ...............     variables  locales   .........................
    3032
    … …  
    3335  INTEGER :: ijb,ije
    3436  !    ...................................................................
    35   !
    36   !
     37
     38
    3739  ijb=ij_begin
    3840  ije=ij_end
    … …  
    4244!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    4345  DO l = 1,klevel
    44   !
     46
    4547    DO  ij = ijb, ije - 1
    4648     div( ij + 1, l )     = &
    … …  
    4850           cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)
    4951    ENDDO
    50   !
     52
    5153  ! ....  correction pour  div( 1,j,l)  ......
    5254  ! ....   div(1,j,l)= div(iip1,j,l) ....
    53   !
     55
    5456  !DIR$ IVDEP
    5557    DO  ij = ijb,ije,iip1
    5658     div( ij,l ) = div( ij + iim,l )
    5759    ENDDO
    58   !
     60
    5961  ! ....  calcul  aux poles  .....
    60   !
     62
    6163    IF (pole_nord) THEN
    6264      DO  ij  = 1,iim
    … …  
    6466      ENDDO
    6567      sumypn = SSUM ( iim,aiy1,1 ) / apoln
    66   !
     68
    6769      DO  ij = 1,iip1
    6870       div(     ij    , l ) = - sumypn
    … …  
    7577      ENDDO
    7678      sumyps = SSUM ( iim,aiy2,1 ) / apols
    77   !
     79
    7880      DO  ij = 1,iip1
    7981       div( ij + ip1jm, l ) =   sumyps
    … …  
    8890  !cc        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
    8991
    90   !
     92
    9193!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9294    DO l = 1, klevel

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

    r5140 r5159  
    11SUBROUTINE divergf_loc(klevel,x,y,div)
    2   !
     2
    33  ! P. Le Van
    4   !
     4
    55  !  *********************************************************************
    66  !  ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
    … …  
    1313  USE lmdz_comgeom
    1414
     15  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    16   !
     18
    1719  !  x  et  y  sont des arguments  d'entree pour le s-prog
    1820  !    div      est  un argument  de sortie pour le s-prog
    1921  !
    20   INCLUDE "dimensions.h"
    21   INCLUDE "paramet.h"
    22   !
     22
     23
     24
    2325  !    ..........          variables en arguments    ...................
    24   !
     26
    2527  INTEGER :: klevel
    2628  REAL :: x( ijb_u:ije_u,klevel ),y( ijb_v:ije_v,klevel )
    2729  REAL :: div( ijb_u:ije_u,klevel )
    2830  INTEGER :: l,ij
    29   !
     31
    3032  !    ...............     variables  locales   .........................
    3133
    … …  
    3436  !    ...................................................................
    3537  INTEGER :: ijb,ije,jjb,jje
    36   !
    37   !
     38
     39
    3840  ijb=ij_begin
    3941  ije=ij_end
    … …  
    4345!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    4446  DO l = 1,klevel
    45   !
     47
    4648    DO  ij = ijb, ije - 1
    4749     div( ij + 1, l )     = &
    … …  
    5052    ENDDO
    5153
    52   !
     54
    5355  ! ....  correction pour  div( 1,j,l)  ......
    5456  ! ....   div(1,j,l)= div(iip1,j,l) ....
    55   !
     57
    5658  !DIR$ IVDEP
    5759    DO  ij = ijb,ije,iip1
    5860     div( ij,l ) = div( ij + iim,l )
    5961    ENDDO
    60   !
     62
    6163  ! ....  calcul  aux poles  .....
    62   !
     64
    6365    IF (pole_nord) THEN
    6466      DO  ij  = 1,iim
    … …  
    6769      sumypn = SSUM ( iim,aiy1,1 ) / apoln
    6870
    69   !
     71
    7072      DO  ij = 1,iip1
    7173       div(     ij    , l ) = - sumypn
    … …  
    7981      ENDDO
    8082      sumyps = SSUM ( iim,aiy2,1 ) / apols
    81   !
     83
    8284      DO  ij = 1,iip1
    8385       div( ij + ip1jm, l ) =   sumyps
    … …  
    8991!$OMP END DO NOWAIT
    9092
    91   !
     93
    9294    jjb=jj_begin
    9395    jje=jj_end
    … …  
    9799          klevel, 2, 2, .TRUE., 1 )
    98100
    99   !
     101
    100102!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    101103    DO l = 1, klevel

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

    r5136 r5159  
    11SUBROUTINE divgrad2_loc( klevel, h, deltapres, lh, divgra_out )
    2   !
     2
    33  ! P. Le Van
    4   !
     4
    55  !   ***************************************************************
    6   !
     6
    77  ! .....   calcul de  (div( grad ))   de (  pext * h ) .....
    88  !   ****************************************************************
    99  !   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
    1010  !     divgra     est  un argument  de sortie pour le s-prg
    11   !
     11
    1212  USE parallel_lmdz
    1313  USE times
    … …  
    1717  USE lmdz_comgeom2
    1818
     19USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     20  USE lmdz_paramet
    1921  IMPLICIT NONE
    2022  !
    21   INCLUDE "dimensions.h"
    22   INCLUDE "paramet.h"
     23
     24
    2325
    2426  !    .......    variables en arguments   .......
    25   !
     27
    2628  INTEGER :: klevel
    2729  REAL :: h( ijb_u:ije_u,klevel ), deltapres( ijb_u:ije_u,klevel )
    2830  REAL :: divgra_out( ijb_u:ije_u,klevel)
    2931  !    .......    variables  locales    ..........
    30   !
     32
    3133  REAL :: signe, nudivgrs, sqrtps( ijb_u:ije_u,llm )
    3234  INTEGER :: l,ij,iter,lh
    … …  
    3638  INTEGER :: ijb,ije
    3739
    38   !
    39   !
     40
     41
    4042  signe    = (-1.)**lh
    4143  nudivgrs = signe * cdivh
    … …  
    4951  ENDDO
    5052!$OMP END DO NOWAIT
    51   !
     53
    5254!$OMP BARRIER
    5355   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
    … …  
    6769!$OMP END DO NOWAIT
    6870
    69   !
     71
    7072!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    7173  DO l = 1, klevel
    … …  
    7779
    7880  !    ........    Iteration de l'operateur  laplacien_gam    ........
    79   !
     81
    8082  DO  iter = 1, lh - 2
    8183!$OMP BARRIER
    … …  
    9193         unsapolnga2, unsapolsga2,  divgra, divgra )
    9294  ENDDO
    93   !
     95
    9496  !    ...............................................................
    9597
    … …  
    101103  ENDDO
    102104!$OMP END DO NOWAIT
    103   !
     105
    104106!$OMP BARRIER
    105107   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
    … …  
    110112
    111113  CALL laplacien_loc ( klevel, divgra, divgra )
    112   !
     114
    113115!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    114116  DO l  = 1,klevel

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

    r1907 r5159  
    99  USE allocate_field_mod
    1010  USE parallel_lmdz
    11   USE dimensions_mod
     11  USE lmdz_dimensions
     12  USE lmdz_paramet
    1213  IMPLICIT NONE
    1314    TYPE(distrib),POINTER :: d

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

    r5158 r5159  
    33  USE write_field_p
    44  USE lmdz_filtreg_p
     5  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     6  USE lmdz_paramet
    57  IMPLICIT NONE
    68
    79  !=======================================================================
    8   !
     10
    911  !   Auteur:  P. Le Van
    1012  !   -------
    1113  ! Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
    12   !
     14
    1315  !   ********************************************************************
    1416  !   ... calcul du terme de convergence horizontale du flux d'enthalpie
    … …  
    1719  !  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
    1820  ! dteta               sont des arguments de sortie pour le s-pg ....
    19   !
     21
    2022  !=======================================================================
    2123
    2224
    23   INCLUDE "dimensions.h"
    24   INCLUDE "paramet.h"
     25
     26
    2527
    2628  REAL :: teta( ijb_u:ije_u,llm )
    … …  
    3133  REAL :: hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm )
    3234
    33   !
     35
    3436  INTEGER :: ijb,ije,jjb,jje
    3537

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

    r5117 r5159  
    11SUBROUTINE dudv1_loc( vorpot, pbaru, pbarv, du, dv )
    22  USE parallel_lmdz
     3  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     4  USE lmdz_paramet
    35  IMPLICIT NONE
    4   !
     6
    57  !-----------------------------------------------------------------------
    6   !
     8
    79  !   Auteur:   P. Le Van
    810  !   -------
    9   !
     11
    1012  !   Objet:
    1113  !   ------
    … …  
    1416  !   vorpot, pbaru et pbarv sont des arguments d'entree  pour le s-pg ..
    1517  !   du  et dv              sont des arguments de sortie pour le s-pg ..
    16   !
     18
    1719  !-----------------------------------------------------------------------
    1820
    19   INCLUDE "dimensions.h"
    20   INCLUDE "paramet.h"
     21
     22
    2123
    2224  REAL :: vorpot( ijb_v:ije_v,llm ) ,pbaru( ijb_u:ije_u,llm ) , &
    … …  
    2426  REAL :: du( ijb_u:ije_u,llm ) ,dv( ijb_v:ije_v,llm )
    2527  INTEGER :: l,ij,ijb,ije
    26   !
     28
    2729  !
    2830
    2931!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3032  DO l = 1,llm
    31   !
     33
    3234  ijb=ij_begin
    3335  ije=ij_end
    … …  
    4345
    4446
    45   !
     47
    4648  IF (pole_nord) ijb=ij_begin
    4749
    … …  
    5153        pbaru(ij+iip1, l)  +  pbaru(ij+iip2, l)  )
    5254  END DO
    53   !
     55
    5456  !    .... correction  pour  dv( 1,j,l )  .....
    5557  !    ....   dv(1,j,l)= dv(iip1,j,l) ....
    56   !
     58
    5759  !DIR$ IVDEP
    5860  DO ij = ijb, ije, iip1
    5961  dv( ij,l ) = dv( ij + iim, l )
    6062  END DO
    61   !
     63
    6264  END DO
    6365!$OMP END DO NOWAIT

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

    r5134 r5159  
    11SUBROUTINE dudv2_loc( teta, pkf, bern, du, dv  )
    22  USE parallel_lmdz
     3  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     4  USE lmdz_paramet
    35  IMPLICIT NONE
    4   !
     6
    57  !=======================================================================
    6   !
     8
    79  !   Auteur:  P. Le Van
    810  !   -------
    9   !
     11
    1012  !   Objet:
    1113  !   ------
    12   !
     14
    1315  !   *****************************************************************
    1416  !   ..... calcul du terme de pression (gradient de p/densite )   et
    … …  
    1618  !   *****************************************************************
    1719  !      Ces termes sont ajoutes a  d(ucov)/dt et a d(vcov)/dt  ..
    18   !
    19   !
     20
     21
    2022  !    teta , pkf, bern  sont des arguments d'entree  pour le s-pg  ....
    2123  !    du et dv          sont des arguments de sortie pour le s-pg  ....
    22   !
     24
    2325  !=======================================================================
    2426  !
    25   INCLUDE "dimensions.h"
    26   INCLUDE "paramet.h"
     27
     28
    2729
    2830  REAL :: teta( ijb_u:ije_u,llm ),pkf( ijb_u:ije_u,llm )
    … …  
    3032  REAL :: du( ijb_u:ije_u,llm ),  dv( ijb_v:ije_v,llm )
    3133  INTEGER :: l,ij,ijb,ije
    32   !
    33   !
     34
     35
    3436!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3537  DO l = 1,llm
    36   !
     38
    3739  ijb=ij_begin
    3840  ije=ij_end
    … …  
    4446         ( pkf( ij,l ) - pkf(ij+1,l) )  + bern(ij,l) - bern(ij+1,l)
    4547  END DO
    46   !
    47   !
     48
     49
    4850  !    .....  correction  pour du(iip1,j,l),  j=2,jjm   ......
    4951  !    ...          du(iip1,j,l) = du(1,j,l)                 ...
    50   !
     52
    5153  !DIR$ IVDEP
    5254  DO ij = ijb+iip1-1, ije, iip1
    5355  du( ij,l ) = du( ij - iim,l )
    5456  END DO
    55   !
    56   !
     57
     58
    5759  IF (pole_nord) ijb=ijb-iip1
    5860
    … …  
    6264        +   bern( ij+iip1,l ) - bern( ij  ,l )
    6365  END DO
    64   !
     66
    6567  END DO
    6668!$OMP END DO NOWAIT

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

    r5136 r5159  
    2525  USE lmdz_comgeom
    2626
     27USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     28  USE lmdz_paramet
    2729  IMPLICIT NONE
    28   INCLUDE "dimensions.h"
    29   INCLUDE "paramet.h"
     30
     31
    3032!===============================================================================
    3133! Arguments:

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

    r5136 r5159  
    2525  USE lmdz_comgeom
    2626
     27USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     28  USE lmdz_paramet
    2729  IMPLICIT NONE
    28   INCLUDE "dimensions.h"
    29   INCLUDE "paramet.h"
     30
     31
    3032  !===============================================================================
    3133  ! Arguments:
    … …  
    178180  USE lmdz_comgeom
    179181
     182USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     183  USE lmdz_paramet
    180184  IMPLICIT NONE
    181   INCLUDE "dimensions.h"
    182   INCLUDE "paramet.h"
     185
     186
    183187  !===============================================================================
    184188  ! Arguments:

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

    r5128 r5159  
    11MODULE dynredem_mod
    22
    3   USE dimensions_mod
     3  USE lmdz_dimensions
     4  USE lmdz_paramet
    45  USE parallel_lmdz
    56  USE mod_hallo

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

    r5136 r5159  
    88  USE lmdz_comgeom
    99
     10USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     11  USE lmdz_paramet
    1012  IMPLICIT NONE
    11   INCLUDE "dimensions.h"
    12   INCLUDE "paramet.h"
     13
     14
    1315!===============================================================================
    1416! Arguments:

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

    r5136 r5159  
    3939    USE lmdz_comgeom
    4040
     41USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     42  USE lmdz_paramet
    4143    IMPLICIT NONE
    4244
    43     INCLUDE "dimensions.h"
    44     INCLUDE "paramet.h"
     45
     46
    4547
    4648    INTEGER  ngrid

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

    r5136 r5159  
    3535    USE lmdz_comgeom
    3636   
     37USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     38  USE lmdz_paramet
    3739    IMPLICIT NONE
    3840
    39     INCLUDE "dimensions.h"
    40     INCLUDE "paramet.h"
     41
     42
    4143
    4244    INTEGER  ngrid

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

    r5136 r5159  
    88  USE lmdz_comgeom
    99
     10USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     11  USE lmdz_paramet
    1012  IMPLICIT NONE
    11   INCLUDE "dimensions.h"
    12   INCLUDE "paramet.h"
     13
     14
    1315!===============================================================================
    1416! Arguments:

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

    r5137 r5159  
    11! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
    22
    3 !
    4 !
     3
     4
    55SUBROUTINE fluxstokenc_p(pbaru, pbarv, masse, teta, phi)
    66  USE parallel_lmdz
    … …  
    1414  USE lmdz_tracstoke
    1515
     16  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     17  USE lmdz_paramet
    1618  IMPLICIT NONE
    17   !
     19
    1820  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
    19   !
    20   !=======================================================================
    21   !
    22   !   Shema de  Van Leer
    23   !
     21
    2422  !=======================================================================
    2523
    26   INCLUDE "dimensions.h"
    27   INCLUDE "paramet.h"
     24  !   Shema de  Van Leer
     25
     26  !=======================================================================
     27
     28
     29
    2830
    2931  !   Arguments:

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

    r5158 r5159  
    1111  USE lmdz_comgeom2
    1212
     13  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     14  USE lmdz_paramet
    1315  IMPLICIT NONE
    1416
    … …  
    2527  !=======================================================================
    2628
    27   INCLUDE "dimensions.h"
    28   INCLUDE "paramet.h"
     29
     30
    2931
    3032  ! arguments:

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

    r5137 r5159  
    3232  USE lmdz_tracstoke
    3333
     34  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     35  USE lmdz_paramet
    3436  IMPLICIT NONE
    3537
    3638  !      ......   Version  du 10/01/98    ..........
    3739
    38   !             avec  coordonnees  verticales hybrides 
     40  !             avec  coordonnees  verticales hybrides
    3941  !   avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
    4042
    … …  
    6365  !   Declarations:
    6466  !   -------------
    65   INCLUDE "dimensions.h"
    66   INCLUDE "paramet.h"
     67
     68
    6769
    6870  REAL zdtvr

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

    r5134 r5159  
    11SUBROUTINE geopot_loc( ngrid, teta, pk, pks, phis, phi )
    22  USE parallel_lmdz
     3  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     4  USE lmdz_paramet
    35  IMPLICIT NONE
    46
    57
    68  !=======================================================================
    7   !
     9
    810  !   Auteur:  P. Le Van
    911  !   -------
    10   !
     12
    1113  !   Objet:
    1214  !   ------
    13   !
     15
    1416  !    *******************************************************************
    1517  !    ....   calcul du geopotentiel aux milieux des couches    .....
    1618  !    *******************************************************************
    17   !
     19
    1820  ! ....   l'integration se fait de bas en haut  ....
    19   !
     21
    2022  ! .. ngrid,teta,pk,pks,phis sont des argum. d'entree pour le s-pg ..
    2123  !          phi               est un  argum. de sortie pour le s-pg .
    22   !
     24
    2325  !=======================================================================
    2426  !-----------------------------------------------------------------------
    … …  
    2628  !   -------------
    2729
    28   INCLUDE "dimensions.h"
    29   INCLUDE "paramet.h"
     30
     31
    3032
    3133  !   Arguments:

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

    r5136 r5159  
    55  !%W%    %G%
    66  !=======================================================================
    7   !
     7
    88  !   Author:    Frederic Hourdin      original: 11/11/92
    99  !   -------
    10   !
     10
    1111  !   Subject:
    1212  !   ------
    13   !
     13
    1414  !   Method:
    1515  !   --------
    16   !
     16
    1717  !   Interface:
    1818  !   ----------
    19   !
     19
    2020  !  Input:
    2121  !  ------
    22   !
     22
    2323  !  Output:
    2424  !  -------
    25   !
     25
    2626  !=======================================================================
    2727  USE parallel_lmdz
    2828  USE lmdz_comgeom
    2929
     30  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     31  USE lmdz_paramet
    3032  IMPLICIT NONE
    3133  !-----------------------------------------------------------------------
    … …  
    3335  !   ---------------
    3436
    35   INCLUDE "dimensions.h"
    36   INCLUDE "paramet.h"
     37
     38
    3739
    3840  !   Arguments:

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

    r5136 r5159  
    55  !%W%    %G%
    66  !=======================================================================
    7   !
     7
    88  !   Author:    Frederic Hourdin      original: 11/11/92
    99  !   -------
    10   !
     10
    1111  !   Subject:
    1212  !   ------
    13   !
     13
    1414  !   Method:
    1515  !   --------
    16   !
     16
    1717  !   Interface:
    1818  !   ----------
    19   !
     19
    2020  !  Input:
    2121  !  ------
    22   !
     22
    2323  !  Output:
    2424  !  -------
    25   !
     25
    2626  !=======================================================================
    2727  USE parallel_lmdz
    2828  USE lmdz_comgeom
    2929
     30  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     31  USE lmdz_paramet
    3032  IMPLICIT NONE
    3133  !-----------------------------------------------------------------------
    … …  
    3335  !   ---------------
    3436
    35   INCLUDE "dimensions.h"
    36   INCLUDE "paramet.h"
     37
     38
    3739
    3840  !   Arguments:

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

    r5117 r5159  
    11SUBROUTINE  grad_loc(klevel, pg,pgx,pgy )
    2   !
     2
    33  !  P. Le Van
    4   !
     4
    55  !    ******************************************************************
    66  ! .. calcul des composantes covariantes en x et y du gradient de g
    7   !
     7
    88  !    ******************************************************************
    99  !         pg        est un   argument  d'entree pour le s-prog
    1010  !   pgx  et  pgy    sont des arguments de sortie pour le s-prog
    11   !
     11
    1212  USE parallel_lmdz
     13USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     14  USE lmdz_paramet
    1315  IMPLICIT NONE
    1416  !
    15   INCLUDE "dimensions.h"
    16   INCLUDE "paramet.h"
     17
     18
    1719  INTEGER :: klevel
    1820  REAL :: pg( ijb_u:ije_u,klevel )
    … …  
    2022  INTEGER :: l,ij
    2123  INTEGER :: ijb,ije,jjb,jje
    22   !
    23   !
     24
     25
    2426!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2527  DO l = 1,klevel
    26   !
     28
    2729  ijb=ij_begin
    2830  ije=ij_end
    … …  
    3032    pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
    3133  END DO
    32   !
     34
    3335  !    .... correction pour  pgx(ip1,j,l)  ....
    3436  !    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
    … …  
    3739    pgx( ij,l ) = pgx( ij -iim,l )
    3840  END DO
    39   !
     41
    4042  ijb=ij_begin-iip1
    4143  ije=ij_end
    … …  
    4648    pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
    4749  END DO
    48   !
     50
    4951  END DO
    5052!$OMP END DO NOWAIT

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

    r5117 r5159  
    11SUBROUTINE  grad_p(klevel, pg,pgx,pgy )
    2   !
     2
    33  !  P. Le Van
    4   !
     4
    55  !    ******************************************************************
    66  ! .. calcul des composantes covariantes en x et y du gradient de g
    7   !
     7
    88  !    ******************************************************************
    99  !         pg        est un   argument  d'entree pour le s-prog
    1010  !   pgx  et  pgy    sont des arguments de sortie pour le s-prog
    11   !
     11
    1212  USE parallel_lmdz
     13USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     14  USE lmdz_paramet
    1315  IMPLICIT NONE
    1416  !
    15   INCLUDE "dimensions.h"
    16   INCLUDE "paramet.h"
     17
     18
    1719  INTEGER :: klevel
    1820  REAL :: pg( ip1jmp1,klevel )
    … …  
    2022  INTEGER :: l,ij
    2123  INTEGER :: ijb,ije,jjb,jje
    22   !
    23   !
     24
     25
    2426!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2527  DO l = 1,klevel
    26   !
     28
    2729  ijb=ij_begin
    2830  ije=ij_end
    … …  
    3032    pgx( ij,l ) = pg( ij +1,l ) - pg( ij,l )
    3133  END DO
    32   !
     34
    3335  !    .... correction pour  pgx(ip1,j,l)  ....
    3436  !    ...    pgx(iip1,j,l)= pgx(1,j,l)  ....
    … …  
    3739    pgx( ij,l ) = pgx( ij -iim,l )
    3840  END DO
    39   !
     41
    4042  ijb=ij_begin-iip1
    4143  ije=ij_end
    … …  
    4648    pgy( ij,l ) = pg( ij,l ) - pg( ij +iip1,l )
    4749  END DO
    48   !
     50
    4951  END DO
    5052!$OMP END DO NOWAIT

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

    r5136 r5159  
    11SUBROUTINE gradiv2_loc(klevel, xcov, ycov, ld, gdx_out, gdy_out )
    2   !
     2
    33  ! P. Le Van
    4   !
     4
    55  !   **********************************************************
    66  !                            ld
    77  !   calcul  de  (grad (div) )   du vect. v ....
    8   !
     8
    99  ! xcov et ycov etant les composant.covariantes de v
    1010  !   **********************************************************
    1111  ! xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
    1212  !  gdx   et  gdy       sont des arguments de sortie pour le s-prog
    13   !
    14   !
     13
     14
    1515  USE parallel_lmdz
    1616  USE times
    … …  
    2222  USE lmdz_comgeom
    2323
     24USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     25  USE lmdz_paramet
    2426  IMPLICIT NONE
    2527  !
    26   INCLUDE "dimensions.h"
    27   INCLUDE "paramet.h"
    28   !
     28
     29
     30
    2931  ! ........    variables en arguments      ........
    3032
    … …  
    3234  REAL :: xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel )
    3335  REAL :: gdx_out( ijb_u:ije_u,klevel ), gdy_out( ijb_v:ije_v,klevel)
    34   !
     36
    3537  ! ........       variables locales       .........
    36   !
     38
    3739  REAL      :: tmp_div2(ijb_u:ije_u,llm)
    3840  REAL :: signe, nugrads
    … …  
    4244!$OMP THREADPRIVATE(request_dissip)
    4345  !    ........................................................
    44   !
    45   !
     46
     47
    4648  !  CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
    4749  !  CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
    … …  
    7274   CALL WaitRequest(Request_dissip)
    7375!$OMP BARRIER
    74   !
    75   !
     76
     77
    7678  signe   = (-1.)**ld
    7779  nugrads = signe * cdivu
    … …  
    127129   CALL  grad_loc( klevel,  div,   gdx,  gdy )
    128130
    129   !
     131
    130132  ijb=ij_begin
    131133  ije=ij_end

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

    r1907 r5159  
    1111  USE allocate_field_mod
    1212  USE parallel_lmdz
    13   USE dimensions_mod
     13  USE lmdz_dimensions
     14  USE lmdz_paramet
    1415  IMPLICIT NONE
    1516    TYPE(distrib),POINTER :: d

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

    r5158 r5159  
    77  USE lmdz_comgeom2
    88
     9  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     10  USE lmdz_paramet
    911  IMPLICIT NONE
    1012
    … …  
    1214  !   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
    1315  !   et a mesure qu'on se rapproche du pole.
    14   !
     16
    1517  !   en entree: pext, pbaru et pbarv
    16   !
     18
    1719  !   en sortie:  pbarum,pbarvm et wm.
    18   !
     20
    1921  !   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
    2022  !   pas besoin de w en entree.
    2123
    22   INCLUDE "dimensions.h"
    23   INCLUDE "paramet.h"
     24
     25
    2426
    2527  ! integer ngroup
    … …  
    4648  CALL convflu_loc(pbaru, pbarv, llm, zconvm)
    4749
    48   !
     50
    4951  !  CALL scopy(ijp1llm,zconvm,1,zconvmm,1)
    5052  !  CALL scopy(ijmllm,pbarv,1,pbarvm,1)

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

    r5101 r5159  
    1212!  USE infotrac
    1313  USE advtrac_mod, ONLY: advtrac_allocate
     14USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15  USE lmdz_paramet
    1416  IMPLICIT NONE
    15   INCLUDE "dimensions.h"
    16   INCLUDE "paramet.h"
     17
     18
    1719  TYPE(distrib),POINTER :: d
    1820

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

    r5136 r5159  
    55  USE lmdz_comgeom2
    66
     7USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     8  USE lmdz_paramet
    79  IMPLICIT NONE
    810
    9   INCLUDE "dimensions.h"
    10   INCLUDE "paramet.h"
     11
     12
    1113
    1214  INTEGER :: jjmax,llmax,sb,se,jjb,jje
    … …  
    140142  USE lmdz_comgeom2
    141143
     144USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     145  USE lmdz_paramet
    142146  IMPLICIT NONE
    143147
    144   INCLUDE "dimensions.h"
    145   INCLUDE "paramet.h"
     148
     149
    146150
    147151  ! INTEGER ngroup

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

    r5158 r5159  
    7878    USE serre_mod, ONLY: grossismx
    7979
     80USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     81  USE lmdz_paramet
    8082    IMPLICIT NONE
    8183
    82     INCLUDE "dimensions.h"
    83     INCLUDE "paramet.h"
     84
     85
    8486
    8587    INTEGER :: error, ncidpl, rid, rcod
    … …  
    362364    USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner
    363365
     366USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     367  USE lmdz_paramet
    364368    IMPLICIT NONE
    365369
    366     INCLUDE "dimensions.h"
    367     INCLUDE "paramet.h"
     370
     371
    368372
    369373    ! Variables entree
    … …  
    722726    ! field1=a*field1+alpha*field2
    723727
     728USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     729  USE lmdz_paramet
    724730    IMPLICIT NONE
    725     INCLUDE "dimensions.h"
    726     INCLUDE "paramet.h"
     731
     732
    727733
    728734    ! input variables
    … …  
    745751    ! field1=a*field1+alpha*field2
    746752
     753USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     754  USE lmdz_paramet
    747755    IMPLICIT NONE
    748     INCLUDE "dimensions.h"
    749     INCLUDE "paramet.h"
     756
     757
    750758
    751759    ! input variables
    … …  
    771779    USE lmdz_comgeom
    772780
     781USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     782  USE lmdz_paramet
    773783    IMPLICIT NONE
    774784
    775     INCLUDE "dimensions.h"
    776     INCLUDE "paramet.h"
     785
     786
    777787
    778788    ! input/output variables
    … …  
    843853    USE lmdz_comgeom
    844854
     855USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     856  USE lmdz_paramet
    845857    IMPLICIT NONE
    846858
    847     INCLUDE "dimensions.h"
    848     INCLUDE "paramet.h"
     859
     860
    849861
    850862    ! input/output variables
    … …  
    916928    USE lmdz_comgeom2
    917929
     930USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     931  USE lmdz_paramet
    918932    IMPLICIT NONE
    919933
    920     INCLUDE "dimensions.h"
    921     INCLUDE "paramet.h"
     934
     935
    922936
    923937    REAL, DIMENSION (iip1, jjb_u:jje_u), INTENT(IN) :: psi ! Psol gcm
    … …  
    14001414    USE lmdz_comgeom2
    14011415
     1416USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     1417  USE lmdz_paramet
    14021418    IMPLICIT NONE
    14031419
    1404     INCLUDE "dimensions.h"
    1405     INCLUDE "paramet.h"
     1420
     1421
    14061422
    14071423    ! input arguments :
    … …  
    15651581  SUBROUTINE guide_read(timestep)
    15661582
     1583USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     1584  USE lmdz_paramet
    15671585    IMPLICIT NONE
    15681586
    1569     INCLUDE "dimensions.h"
    1570     INCLUDE "paramet.h"
     1587
     1588
    15711589
    15721590    INTEGER, INTENT(IN) :: timestep
    … …  
    18801898  SUBROUTINE guide_read2D(timestep)
    18811899
     1900USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     1901  USE lmdz_paramet
    18821902    IMPLICIT NONE
    18831903
    1884     INCLUDE "dimensions.h"
    1885     INCLUDE "paramet.h"
     1904
     1905
    18861906
    18871907    INTEGER, INTENT(IN) :: timestep
    … …  
    21592179    USE lmdz_comgeom2
    21602180
     2181USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     2182  USE lmdz_paramet
    21612183    IMPLICIT NONE
    21622184
    2163     INCLUDE "dimensions.h"
    2164     INCLUDE "paramet.h"
     2185
     2186
    21652187
    21662188    ! Variables entree
    … …  
    23802402    USE parallel_lmdz
    23812403    USE mod_hallo
     2404USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     2405  USE lmdz_paramet
    23822406    IMPLICIT NONE
    2383     INCLUDE 'dimensions.h'
    2384     INCLUDE 'paramet.h'
     2407
     2408
    23852409
    23862410    CHARACTER (len = *) :: varname
    … …  
    24102434    USE lmdz_comgeom
    24112435
     2436USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     2437  USE lmdz_paramet
    24122438    IMPLICIT NONE
    2413     INCLUDE "dimensions.h"
    2414     INCLUDE "paramet.h"
     2439
     2440
    24152441    CALL barrier
    24162442    CALL dump2du(alpha_u(ijb_u:ije_u), '  alpha_u couche 1')

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

    r5158 r5159  
    2727  ! of the American Meteorological Society, 75, 1825.
    2828
     29  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     30  USE lmdz_paramet
    2931  IMPLICIT NONE
    3032
    … …  
    3234  !   ---------------
    3335
    34   INCLUDE "dimensions.h"
    35   INCLUDE "paramet.h"
     36
     37
    3638
    3739  !   Arguments:

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

    r5158 r5159  
    1818  USE lmdz_comgeom
    1919
     20  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     21  USE lmdz_paramet
    2022  IMPLICIT NONE
    2123
    22   !
     24
    2325  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    2426  !   au format IOIPSL. Initialisation du fichier histoire moyenne.
    25   !
     27
    2628  !   Appels succesifs des routines: histbeg
    2729  !                              histhori
    … …  
    2931  !                              histdef
    3032  !                              histend
    31   !
     33
    3234  !   Entree:
    33   !
     35
    3436  !  day0,anne0: date de reference
    3537  !  tstep : frequence d'ecriture
    3638  !  t_ops: frequence de l'operation pour IOIPSL
    3739  !  t_wrt: frequence d'ecriture sur le fichier
    38   !
     40
    3941  !   Sortie:
    4042  !  fileid: ID du fichier netcdf cree
    41   !
     43
    4244  !   L. Fairhead, LMD, 03/99
    43   !
     45
    4446  ! =====================================================================
    45   !
     47
    4648  !   Declarations
    47   INCLUDE "dimensions.h"
    48   INCLUDE "paramet.h"
     49
     50
    4951
    5052  !   Arguments
    51   !
     53
    5254  INTEGER(kind = 4) day0, anne0
    5355  REAL :: tstep, t_ops, t_wrt
    … …  
    5557  ! This routine needs IOIPSL
    5658  !   Variables locales
    57   !
     59
    5860  INTEGER :: tau0
    5961  REAL :: zjulian
    … …  
    8284  IF (adjust) return
    8385
    84   !
     86
    8587  !  Initialisations
    86   !
     88
    8789  pi = 4. * atan (1.)
    88   !
     90
    8991  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    9092  !
    … …  
    192194
    193195
    194   !
     196
    195197  !  Appel a histvert pour la grille verticale
    196   !
     198
    197199  CALL histvert(histaveid, 'presnivs', 'Niveaux Pression&
    198200          &     approximatifs', 'mb', llm, presnivs / 100., zvertiid, 'down')
    … …  
    202204          &     approximatifs', 'mb', llm, presnivs / 100., zvertiidu, 'down')
    203205
    204   !
     206
    205207  !  Appels a histdef pour la definition des variables a sauvegarder
    206   !
     208
    207209  !  Vents U
    208   !
     210
    209211  jjn = jj_nb
    210212  CALL histdef(histuaveid, 'u', 'vent u moyen ', &
    … …  
    212214          32, 'ave(X)', t_ops, t_wrt)
    213215
    214   !
     216
    215217  !  Vents V
    216   !
     218
    217219  IF (pole_sud) jjn = jj_nb - 1
    218220  CALL histdef(histvaveid, 'v', 'vent v moyen', &
    … …  
    220222          32, 'ave(X)', t_ops, t_wrt)
    221223
    222   !
     224
    223225  !  Temperature
    224   !
     226
    225227  jjn = jj_nb
    226228  CALL histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
    227229          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    228230          32, 'ave(X)', t_ops, t_wrt)
    229   !
     231
    230232  !  Temperature potentielle
    231   !
     233
    232234  CALL histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
    233235          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    … …  
    235237
    236238
    237   !
     239
    238240  !  Geopotentiel
    239   !
     241
    240242  CALL histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
    241243          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    242244          32, 'ave(X)', t_ops, t_wrt)
    243   !
     245
    244246  !  Traceurs
    245   !
     247
    246248  !    DO iq=1,nqtot
    247249  !      CALL histdef(histaveid, tracers(iq)%name,
    … …  
    250252  ! .             32, 'ave(X)', t_ops, t_wrt)
    251253  !    enddo
    252   !
     254
    253255  !  Masse
    254   !
     256
    255257  CALL histdef(histaveid, 'masse', 'masse moyenne', 'kg', &
    256258          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    257259          32, 'ave(X)', t_ops, t_wrt)
    258   !
     260
    259261  !  Pression au sol
    260   !
     262
    261263  CALL histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
    262264          iip1, jjn, thoriid, 1, 1, 1, -99, &
    263265          32, 'ave(X)', t_ops, t_wrt)
    264   !
     266
    265267  !  Geopotentiel au sol
    266   !
     268
    267269  !  CALL histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
    268270  ! .             iip1, jjn, thoriid, 1, 1, 1, -99,
    269271  ! .             32, 'ave(X)', t_ops, t_wrt)
    270   !
     272
    271273  !  Fin
    272   !
     274
    273275  CALL histend(histaveid)
    274276  CALL histend(histuaveid)

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

    r5158 r5159  
    1313  USE lmdz_comgeom
    1414
     15  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    1618
    17   !
     19
    1820  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    1921  !   au format IOIPSL
    20   !
     22
    2123  !   Appels succesifs des routines: histbeg
    2224  !                              histhori
    … …  
    2426  !                              histdef
    2527  !                              histend
    26   !
     28
    2729  !   Entree:
    28   !
     30
    2931  !  infile: nom du fichier histoire a creer
    3032  !  day0,anne0: date de reference
    … …  
    3234  !  t_ops: frequence de l'operation pour IOIPSL
    3335  !  t_wrt: frequence d'ecriture sur le fichier
    34   !
     36
    3537  !   Sortie:
    3638  !  fileid: ID du fichier netcdf cree
    3739  !  filevid:ID du fichier netcdf pour la grille v
    38   !
     40
    3941  !   L. Fairhead, LMD, 03/99
    40   !
     42
    4143  ! =====================================================================
    42   !
     44
    4345  !   Declarations
    44   INCLUDE "dimensions.h"
    45   INCLUDE "paramet.h"
     46
     47
    4648
    4749  !   Arguments
    48   !
     50
    4951  CHARACTER(LEN = *) :: infile
    5052  REAL :: tstep, t_ops, t_wrt
    … …  
    5355  ! This routine needs IOIPSL
    5456  !   Variables locales
    55   !
     57
    5658  REAL :: nivd(1)
    5759  INTEGER :: tau0
    … …  
    8082  INTEGER :: dynv_domain_id
    8183
    82   !
     84
    8385  !  Initialisations
    84   !
     86
    8587  pi = 4. * atan (1.)
    8688  str = 'q  '
    8789  ctrac = 'traceur   '
    8890  ok_sync = .TRUE.
    89   !
     91
    9092  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    9193  !
    … …  
    121123          1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, &
    122124          fileid, dynu_domain_id)
    123   !
     125
    124126  !  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
    125127  !  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
    … …  
    162164
    163165  ENDIF
    164   !
     166
    165167  !  Appel a histhori pour rajouter les autres grilles horizontales
    166   !
     168
    167169  DO jj = 1, jjp1
    168170    DO ii = 1, iip1
    … …  
    179181          'scalar', 'Grille points scalaires', thoriid)
    180182
    181   !
     183
    182184  !  Appel a histvert pour la grille verticale
    183   !
     185
    184186  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', &
    185187          'sigma_level', &
    … …  
    196198            1, nivd, dvertiid)
    197199  ENDIF
    198   !
     200
    199201  !  Appels a histdef pour la definition des variables a sauvegarder
    200202
    … …  
    221223
    222224  ENDIF
    223   !
     225
    224226  ! Masse
    225   !
     227
    226228  CALL histdef(fileid, 'masse', 'Masse', 'kg', &
    227229          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    228230          32, 'inst(X)', t_ops, t_wrt)
    229   !
     231
    230232  !  Pbaru
    231   !
     233
    232234  CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', &
    233235          iip1, jjn, uhoriid, llm, 1, llm, zvertiid, &
    234236          32, 'inst(X)', t_ops, t_wrt)
    235237
    236   !
     238
    237239  !  Pbarv
    238   !
     240
    239241  IF (pole_sud) jjn = jj_nb - 1
    240242
    … …  
    242244          iip1, jjn, vhoriid, llm, 1, llm, zvertiid, &
    243245          32, 'inst(X)', t_ops, t_wrt)
    244   !
     246
    245247  !  w
    246   !
     248
    247249  IF (pole_sud) jjn = jj_nb
    248250  CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', &
    … …  
    250252          32, 'inst(X)', t_ops, t_wrt)
    251253
     254
     255  !  Temperature potentielle
     256
     257  CALL histdef(fileid, 'teta', 'temperature potentielle', '-', &
     258          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     259          32, 'inst(X)', t_ops, t_wrt)
    252260  !
    253   !  Temperature potentielle
    254   !
    255   CALL histdef(fileid, 'teta', 'temperature potentielle', '-', &
    256           iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    257           32, 'inst(X)', t_ops, t_wrt)
    258   !
    259 
    260   !
     261
     262
    261263  ! Geopotentiel
    262   !
     264
    263265  CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', &
    264266          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    265267          32, 'inst(X)', t_ops, t_wrt)
    266   !
     268
    267269  !  Fin
    268   !
     270
    269271  CALL histend(fileid)
    270272  CALL histend(filevid)

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

    r5158 r5159  
    1717  USE lmdz_comgeom
    1818
     19  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     20  USE lmdz_paramet
    1921  IMPLICIT NONE
    2022
    21   !
     23
    2224  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    2325  !   au format IOIPSL
    24   !
     26
    2527  !   Appels succesifs des routines: histbeg
    2628  !                              histhori
    … …  
    2830  !                              histdef
    2931  !                              histend
    30   !
     32
    3133  !   Entree:
    32   !
     34
    3335  !  day0,anne0: date de reference
    3436  !  tstep: duree du pas de temps en seconde
    … …  
    3638  !  t_wrt: frequence d'ecriture sur le fichier
    3739  !  nq: nombre de traceurs
    38   !
    39   !
     40
     41
    4042  !   L. Fairhead, LMD, 03/99
    41   !
     43
    4244  ! =====================================================================
    43   !
     45
    4446  !   Declarations
    45   INCLUDE "dimensions.h"
    46   INCLUDE "paramet.h"
     47
     48
    4749
    4850  !   Arguments
    49   !
     51
    5052  INTEGER :: day0, anne0
    5153  REAL :: tstep, t_ops, t_wrt
    … …  
    5355  ! This routine needs IOIPSL
    5456  !   Variables locales
    55   !
     57
    5658  INTEGER :: tau0
    5759  REAL :: zjulian
    … …  
    8082  IF (adjust) return
    8183
    82   !
     84
    8385  !  Initialisations
    84   !
     86
    8587  pi = 4. * atan (1.)
    86   !
     88
    8789  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    8890  !
    … …  
    200202          llm, presnivs / 100., zvertiidu, 'down')
    201203
    202   !
     204
    203205  ! -------------------------------------------------------------
    204206  !  Appels a histdef pour la definition des variables a sauvegarder
    205207  ! -------------------------------------------------------------
    206   !
     208
    207209  !  Vents U
    208   !
     210
    209211  jjn = jj_nb
    210212  CALL histdef(histuid, 'u', 'vent u', &
    … …  
    212214          32, 'inst(X)', t_ops, t_wrt)
    213215
    214   !
     216
    215217  !  Vents V
    216   !
     218
    217219  IF (pole_sud) jjn = jj_nb - 1
    218220  CALL histdef(histvid, 'v', 'vent v', &
    … …  
    220222          32, 'inst(X)', t_ops, t_wrt)
    221223
    222   !
     224
    223225  !  Temperature
    224   !
     226
    225227  jjn = jj_nb
    226228  CALL histdef(histid, 'temp', 'temperature', 'K', &
    227229          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    228230          32, 'inst(X)', t_ops, t_wrt)
    229   !
     231
    230232  !  Temperature potentielle
    231   !
     233
    232234  CALL histdef(histid, 'theta', 'temperature potentielle', 'K', &
    233235          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    … …  
    235237
    236238
    237   !
     239
    238240  !  Geopotentiel
    239   !
     241
    240242  CALL histdef(histid, 'phi', 'geopotentiel', '-', &
    241243          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    242244          32, 'inst(X)', t_ops, t_wrt)
    243   !
     245
    244246  !  Traceurs
    245   !
     247
    246248  !    DO iq=1,nqtot
    247249  !      CALL histdef(histid, tracers(iq)%name,
    … …  
    250252  ! .             32, 'inst(X)', t_ops, t_wrt)
    251253  !    enddo
    252   !
     254
    253255  !  Masse
    254   !
     256
    255257  CALL histdef(histid, 'masse', 'masse', 'kg', &
    256258          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    257259          32, 'inst(X)', t_ops, t_wrt)
    258   !
     260
    259261  !  Pression au sol
    260   !
     262
    261263  CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', &
    262264          iip1, jjn, thoriid, 1, 1, 1, -99, &
    263265          32, 'inst(X)', t_ops, t_wrt)
    264   !
     266
    265267  !  Geopotentiel au sol
    266   !
     268
    267269  !  CALL histdef(histid, 'phis', 'geopotentiel au sol', '-',
    268270  ! .             iip1, jjn, thoriid, 1, 1, 1, -99,
    269271  ! .             32, 'inst(X)', t_ops, t_wrt)
    270   !
     272
    271273  !  Fin
    272   !
     274
    273275  CALL histend(histid)
    274276  CALL histend(histuid)

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

    r5158 r5159  
    2020  USE lmdz_comgeom
    2121
     22  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     23  USE lmdz_paramet
    2224  IMPLICIT NONE
    2325
    2426
    2527  !=======================================================================
    26   !
     28
    2729  !   Auteur:  P. Le Van
    2830  !   -------
    29   !
     31
    3032  !   objet:
    3133  !   ------
    32   !
     34
    3335  !   Incrementation des tendances dynamiques
    34   !
     36
    3537  !=======================================================================
    3638  !-----------------------------------------------------------------------
    … …  
    3840  !   -------------
    3941
    40   INCLUDE "dimensions.h"
    41   INCLUDE "paramet.h"
     42
     43
    4244
    4345  !   Arguments:
    … …  
    191193
    192194
    193   !
     195
    194196  !   !WRITE(*,*) 'integrd 200'
    195197!$OMP MASTER
    … …  
    220222!$OMP BARRIER
    221223  !WRITE(*,*) 'integrd 217'
    222   !
     224
    223225  !  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...
    224226  !
    … …  
    281283
    282284  !   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......
    283   !
    284   !
     285
     286
    285287  !   !WRITE(*,*) 'integrd 291'
    286288  IF (pole_nord) THEN
    … …  
    327329!$OMP END DO NOWAIT
    328330
    329   !
     331
    330332  !   .......  integration de   q   ......
    331   !
     333
    332334  ijb=ij_begin
    333335  ije=ij_end
    … …  
    353355
    354356    CALL check_isotopes(q,ijb,ije,'integrd 346')
    355   !
     357
    356358  !    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
    357   !
     359
    358360!$OMP BARRIER
    359361  IF (pole_nord) THEN
    … …  
    416418  ENDIF ! of if (planet_type.EQ."earth")
    417419
    418   !
    419   !
     420
     421
    420422  ! .....   FIN  de l'integration  de   q    .......
    421423

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

    r5101 r5159  
    1313  USE allocate_field_mod
    1414  USE parallel_lmdz
    15   USE dimensions_mod
     15  USE lmdz_dimensions
     16  USE lmdz_paramet
    1617  USE advect_new_mod,ONLY: advect_new_allocate
    1718  IMPLICIT NONE

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

    r5136 r5159  
    33
    44  !  P. Le Van
    5   !
     5
    66  !   ************************************************************
    7   !
     7
    88  !  ....   calcul de  (div( grad ))   de   teta  .....
    99  !   ************************************************************
    1010  !    klevel et teta  sont des arguments  d'entree pour le s-prog
    1111  !  divgra     est  un argument  de sortie pour le s-prog
    12   !
     12
    1313  USE parallel_lmdz
    1414  USE lmdz_comgeom
    1515
     16USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     17  USE lmdz_paramet
    1618  IMPLICIT NONE
    1719  !
    18   INCLUDE "dimensions.h"
    19   INCLUDE "paramet.h"
    2020
    21   !
     21
     22
     23
    2224  !    ............     variables  en arguments    ..........
    23   !
     25
    2426  INTEGER :: klevel
    2527  REAL :: teta( ijb_u:ije_u,klevel ), divgra( ijb_u:ije_u,klevel )
    … …  
    2729  REAL :: unsaigam(ip1jmp1)
    2830  REAL :: unsapolnga, unsapolsga
    29   !
     31
    3032  !    ...........    variables  locales    .................
    31   !
     33
    3234  REAL :: ghy(ijb_v:ije_v,llm), ghx(ijb_u:ije_u,llm)
    3335  !    ......................................................
    … …  
    3537  INTEGER :: ijb,ije
    3638  INTEGER :: l
    37   !
    38   !
     39
     40
    3941  !   ...  cvuscugam  = ( cvu/ cu ) ** (- gamdissip )
    4042  !   ...  cuvscvgam  = ( cuv/ cv ) ** (- gamdissip )  calcules dans inigeom  ..
    … …  
    5557!$OMP END DO NOWAIT
    5658
    57   !
     59
    5860  CALL   grad_loc ( klevel, divgra, ghx, ghy )
    59   !
     61
    6062  CALL  diverg_gam_loc ( klevel, cuvsga, cvusga,  unsaigam  , &
    6163        unsapolnga, unsapolsga, ghx , ghy , divgra )

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

    r5136 r5159  
    11SUBROUTINE laplacien_loc( klevel, teta, divgra )
    2   !
     2
    33  ! P. Le Van
    4   !
     4
    55  !   ************************************************************
    66  !    ....     calcul de  (div( grad ))   de   teta  .....
    … …  
    88  ! klevel et teta  sont des arguments  d'entree pour le s-prog
    99  !  divgra     est  un argument  de sortie pour le s-prog
    10   !
     10
    1111  USE parallel_lmdz
    1212  USE lmdz_filtreg_p
    1313  USE lmdz_comgeom
    1414
     15USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    1618  !
    17   INCLUDE "dimensions.h"
    18   INCLUDE "paramet.h"
    1919
    20   !
     20
     21
     22
    2123  !    .........      variables  en arguments   ..............
    22   !
     24
    2325  INTEGER :: klevel
    2426  REAL :: teta( ijb_u:ije_u,klevel ), divgra( ijb_u:ije_u,klevel )
    2527  INTEGER :: l
    26   !
     28
    2729  !    ............     variables  locales      ..............
    28   !
     30
    2931  REAL :: ghy(ijb_v:ije_v,llm), ghx(ijb_u:ije_u,llm)
    3032  !    .......................................................
    … …  
    3234
    3335  INTEGER :: ijb,ije,jjb,jje
    34   !
     36
    3537  !  CALL SCOPY ( ip1jmp1 * klevel, teta, 1, divgra, 1 )
    3638

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

    r5136 r5159  
    11SUBROUTINE laplacien_rot_loc( klevel, rotin, rotout,ghx,ghy )
    2   !
     2
    33  !    P. Le Van
    4   !
     4
    55  !   ************************************************************
    66  !    ...  calcul de  ( rotat x nxgrad )  du rotationnel rotin  .
    77  !   ************************************************************
    8   !
     8
    99  ! klevel et rotin  sont des arguments  d'entree pour le s-prog
    1010  !  rotout           est  un argument  de sortie pour le s-prog
    11   !
     11
    1212  USE parallel_lmdz
    1313  USE lmdz_filtreg_p
    1414  USE lmdz_comgeom
    1515
     16USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     17  USE lmdz_paramet
    1618  IMPLICIT NONE
    1719  !
    18   INCLUDE "dimensions.h"
    19   INCLUDE "paramet.h"
    2020
    21   !
     21
     22
     23
    2224  !   ..........    variables  en  arguments     .............
    23   !
     25
    2426  INTEGER :: klevel
    2527  REAL :: rotin(ijb_v:ije_v,klevel ), rotout( ijb_v:ije_v,klevel )
    26   !
     28
    2729  !   ..........    variables   locales       ................
    28   !
     30
    2931  REAL :: ghy(ijb_v:ije_v,klevel), ghx(ijb_u:ije_u,klevel)
    3032  !   ........................................................
    31   !
    32   !
     33
     34
    3335  INTEGER :: ijb,ije,jjb,jje
    3436

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

    r5136 r5159  
    11SUBROUTINE laplacien_rotgam_loc( klevel, rotin, rotout )
    2   !
     2
    33  ! P. Le Van
    4   !
     4
    55  !   ************************************************************
    66  !   ... calcul de  (rotat x nxgrad)_gam  du rotationnel rotin ..
    … …  
    88  ! klevel et teta  sont des arguments  d'entree pour le s-prog
    99  !  divgra     est  un argument  de sortie pour le s-prog
    10   !
     10
    1111  USE parallel_lmdz
    1212  USE lmdz_comgeom
    1313
     14USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15  USE lmdz_paramet
    1416  IMPLICIT NONE
    1517  !
    16   INCLUDE "dimensions.h"
    17   INCLUDE "paramet.h"
    1818
    19   !
     19
     20
     21
    2022  !    .............   variables  en  arguments    ...........
    21   !
     23
    2224  INTEGER :: klevel
    2325  REAL :: rotin( ijb_v:ije_v,klevel ), rotout( ijb_v:ije_v,klevel )
    24   !
     26
    2527  !   ............     variables   locales     ...............
    26   !
     28
    2729  INTEGER :: l, ij
    2830  REAL :: ghy(ijb_v:ije_v,llm), ghx(ijb_u:ije_u,llm)
    2931  !   ........................................................
    30   !
     32
    3133  INTEGER :: ijb,ije
    3234
    … …  
    3537  CALL   nxgrad_gam_loc ( klevel, rotin,   ghx ,   ghy  )
    3638  CALL   rotat_nfil_loc ( klevel, ghx  ,   ghy , rotout )
    37   !
     39
    3840  ijb=ij_begin
    3941  ije=ij_end

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

    r5158 r5159  
    4747  USE lmdz_comgeom
    4848
     49  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     50  USE lmdz_paramet
    4951  IMPLICIT NONE
    5052
    … …  
    5557
    5658  !=======================================================================
    57   !
     59
    5860  !   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
    5961  !   -------
    60   !
     62
    6163  !   Objet:
    6264  !   ------
    63   !
     65
    6466  !   GCM LMD nouvelle grille
    65   !
     67
    6668  !=======================================================================
    67   !
     69
    6870  !  ... Dans inigeom , nouveaux calculs pour les elongations  cu , cv
    6971  !  et possibilite d'appeler une fonction f(y)  a derivee tangente
    … …  
    7274  !  ... Possibilite de choisir le shema pour l'advection de
    7375  !    q  , en modifiant iadv dans traceur.def  (10/02) .
    74   !
     76
    7577  !  Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
    7678  !  Pour Van-Leer iadv=10
    77   !
     79
    7880  !-----------------------------------------------------------------------
    7981  !   Declarations:
    8082  !   -------------
    8183
    82   INCLUDE "dimensions.h"
    83   INCLUDE "paramet.h"
     84
     85
    8486
    8587  REAL, INTENT(IN) :: time_0 ! not used
    … …  
    130132
    131133  REAL :: tppn(iim), tpps(iim), tpn, tps
    132   !
     134
    133135  INTEGER :: itau, itaufinp1, iav
    134136  ! INTEGER  iday ! jour julien
    … …  
    322324
    323325
    324   !
     326
    325327  ! IF( MOD( itau, 10* day_step ).EQ.0 )  THEN
    326328  !   CALL  test_period ( ucov,vcov,teta,q,p,phis )
    327329  !   PRINT *,' ----   Test_period apres continue   OK ! -----', itau
    328330  ! ENDIF
    329   !
     331
    330332  !ym      CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
    331333  !ym      CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
    … …  
    422424  !   gestion des appels de la physique et des dissipations:
    423425  !   ------------------------------------------------------
    424   !
     426
    425427  !   ...    P.Le Van  ( 6/02/95 )  ....
    426428
    … …  
    780782  !$OMP END MASTER
    781783  ! .P.Le Van (26/04/94  ajout de  finvpold dans l'appel d'integrd)
    782   !
     784
    783785  !-----------------------------------------------------------------------
    784786  !   calcul des tendances physiques:
    785787  !   -------------------------------
    786788  !    ########   P.Le Van ( Modif le  6/02/95 )   ###########
    787   !
     789
    788790  IF(purmats)  THEN
    789791    IF(itau==itaufin.AND..NOT.forward) lafin = .TRUE.
    … …  
    794796  !c$OMP END PARALLEL
    795797
    796   !
    797   !
     798
     799
    798800  IF(apphys)  THEN
    799801

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

    r5101 r5159  
    3939  USE allocate_field_mod
    4040  USE parallel_lmdz
    41   USE dimensions_mod
     41  USE lmdz_dimensions
     42  USE lmdz_paramet
    4243  USE infotrac
    4344  USE caldyn_mod,ONLY: caldyn_allocate

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

    r5118 r5159  
    3434    USE allocate_field_mod
    3535    USE parallel_lmdz
    36     USE dimensions_mod
     36    USE lmdz_dimensions
     37    USE lmdz_paramet
    3738    USE infotrac, ONLY: nqtot
    3839    IMPLICIT NONE
    … …  
    7071  SUBROUTINE call_calfis(itau, lafin, ucov_dyn, vcov_dyn, teta_dyn, masse_dyn, ps_dyn, &
    7172          phis_dyn, q_dyn, flxw_dyn)
    72     USE dimensions_mod
     73    USE lmdz_dimensions
     74    USE lmdz_paramet
    7375    USE exner_hyb_loc_m, ONLY: exner_hyb_loc
    7476    USE exner_milieu_loc_m, ONLY: exner_milieu_loc

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

    r5128 r5159  
    22  USE lmdz_filtreg, ONLY: matrinvn, matrinvs, matriceun, matriceus, matricevn, matricevs
    33
     4  USE lmdz_paramet
    45  IMPLICIT NONE; PRIVATE
    56  PUBLIC filtreg_p
    … …  
    1213    USE lmdz_filtre_fft_loc, ONLY: use_filtre_fft, filtre_u_fft, &
    1314            filtre_v_fft, filtre_inv_fft
     15  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    1416    USE lmdz_timer_filtre, ONLY: init_timer, start_timer, stop_timer
    1517    USE lmdz_coefils, ONLY: jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, unsddu, unsddv, modfrstv, modfrstu
    … …  
    1719
    1820    !=======================================================================
    19     !
     21
    2022    !   Auteur: P. Le Van        07/10/97
    2123    !   ------
    22     !
     24
    2325    !   Objet: filtre matriciel longitudinal ,avec les matrices precalculees
    2426    !                 pour l'operateur  Filtre    .
    2527    !   ------
    26     !
     28
    2729    !   Arguments:
    2830    !   ----------
    29     !
    30     !
     31
     32
    3133    !  ibeg..iend            lattitude a filtrer
    3234    !  nlat                  nombre de latitudes du champ
    … …  
    3840    !                        +2  Filtre directe
    3941    !                        -2  Filtre inverse
    40     !
     42
    4143    !  iaire                 1   si champ intensif
    4244    !                        2   si champ extensif (pondere par les aires)
    43     !
     45
    4446    !  iter                  1   filtre simple
    45     !
     47
    4648    !=======================================================================
    47     !
    48     !
     49
     50
    4951    !                  Variable Intensive
    5052    !            ifiltre = 1     filtre directe
    5153    !            ifiltre =-1     filtre inverse
    52     !
     54
    5355    !                  Variable Extensive
    5456    !            ifiltre = 2     filtre directe
    5557    !            ifiltre =-2     filtre inverse
     58
    5659    !
    57     !
    58     INCLUDE "dimensions.h"
    59     INCLUDE "paramet.h"
    60     !
     60
     61
     62
    6163    INTEGER, INTENT(IN) :: jjb, jje, ibeg, iend, nlat, nbniv, ifiltre, iter
    6264    INTEGER, INTENT(IN) :: iaire
    … …  
    128130    iim2 = iim * iim
    129131    immjm = iim * jjm
    130     !
    131     !
     132
     133
    132134    IF(griscal)   THEN
    133135      IF(nlat /= jjp1)  THEN
    134136        CALL abort_gcm("lmdz_filtreg_p", " nlat. NE. jjp1", 1)
    135137      ELSE
    136         !
     138
    137139        IF(iaire==1)  THEN
    138140          sdd1_type = type_sddv
    … …  
    142144          sdd2_type = type_sddv
    143145        ENDIF
    144         !
     146
    145147        jdfil1 = 2
    146148        jffil1 = jfiltnu
    … …  
    152154        CALL abort_gcm("lmdz_filtreg_p", " nlat. NE. jjm", 1)
    153155      ELSE
    154         !
     156
    155157        IF(iaire==1)  THEN
    156158          sdd1_type = type_sddu
    … …  
    160162          sdd2_type = type_sddu
    161163        ENDIF
    162         !
     164
    163165        jdfil1 = 1
    164166        jffil1 = jfiltnv
    … …  
    167169      ENDIF
    168170    ENDIF
    169     !
     171
    170172    DO hemisph = 1, 2
    171       !
     173
    172174      IF (hemisph==1)  THEN
    173175        !ym
    … …  
    402404          !$OMP END DO NOWAIT
    403405        ENDIF
    404         !
     406
    405407        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    406408        DO l = 1, nbniv
    … …  
    427429    ! &            sum(champ-champ_fft)/sum(champ)
    428430
    429     !
     431
    430432    !$OMP MASTER
    431433    CALL stop_timer

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

    r5158 r5159  
     1MODULE lmdz_paramet
     2  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    13
    2 ! $Id$
     4  IMPLICIT NONE; PRIVATE
     5  PUBLIC iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
     6          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
    37
     8  INTEGER  iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1
     9  INTEGER  kftd, ip1jm, ip1jmp1, ip1jmi1, ijp1llm
     10  INTEGER  ijmllm, mvar
     11  INTEGER jcfil, jcfllm
    412
    5 !  ATTENTION!!!!: ce fichier INCLUDE est compatible format fixe/format libre
    6 !                 veillez  n'utiliser que des ! pour les commentaires
    7 !                 et  bien positionner les & des lignes de continuation
    8 !                 (les placer en colonne 6 et en colonne 73)
     13  PARAMETER(iip1 = iim + 1 - 1 / iim, iip2 = iim + 2, iip3 = iim + 3, jjp1 = jjm + 1 - 1 / jjm)
     14  PARAMETER(llmp1 = llm + 1, llmp2 = llm + 2, llmm1 = llm - 1)
     15  PARAMETER(kftd = iim / 2 - ndm)
     16  PARAMETER(ip1jm = iip1 * jjm, ip1jmp1 = iip1 * jjp1)
     17  PARAMETER(ip1jmi1 = ip1jm - iip1)
     18  PARAMETER(ijp1llm = ip1jmp1 * llm, ijmllm = ip1jm * llm)
     19  PARAMETER(mvar = ip1jmp1 * (2 * llm + 1) + ijmllm)
     20  PARAMETER(jcfil = jjm / 2 + 5, jcfllm = jcfil * llm)
    921
    10 
    11 !-----------------------------------------------------------------------
    12 !   INCLUDE 'paramet.h'
    13 
    14       INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
    15       INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
    16       INTEGER  ijmllm,mvar
    17       INTEGER jcfil,jcfllm
    18 
    19       PARAMETER( iip1= iim+1-1/iim,iip2=iim+2,iip3=iim+3                &
    20           ,jjp1=jjm+1-1/jjm)
    21       PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
    22       PARAMETER( kftd  = iim/2 -ndm )
    23       PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
    24       PARAMETER( ip1jmi1= ip1jm - iip1 )
    25       PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
    26       PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
    27       PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
    28 
    29 !-----------------------------------------------------------------------
     22END MODULE lmdz_paramet

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

    r5136 r5159  
    99  USE lmdz_comgeom
    1010
     11USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     12  USE lmdz_paramet
    1113  IMPLICIT NONE
    12   INCLUDE "dimensions.h"
    13   INCLUDE "paramet.h"
     14
     15
    1416!===============================================================================
    1517! Arguments:

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

    r5136 r5159  
    99  USE lmdz_comgeom
    1010
     11USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     12  USE lmdz_paramet
    1113  IMPLICIT NONE
    12   INCLUDE "dimensions.h"
    13   INCLUDE "paramet.h"
     14
     15
    1416!===============================================================================
    1517! Arguments:

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

    r5136 r5159  
    33  USE lmdz_comgeom
    44
    5   !
     5
    66  ! *********************************************************************
    77  !   ....  Calcule la masse d'air  dans chaque maille   ....
    88  ! *********************************************************************
    9   !
     9
    1010  !    Auteurs : P. Le Van , Fr. Hourdin  .
    1111  !   ..........
    12   !
     12
    1313  !  ..    p                      est  un argum. d'entree pour le s-pg ...
    1414  !  ..  masse                    est un  argum.de sortie pour le s-pg ...
    15   !
     15
    1616  !  ....  p est defini aux interfaces des llm couches   .....
    17   !
     17
     18USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     19  USE lmdz_paramet
    1820  IMPLICIT NONE
    1921  !
    20   INCLUDE "dimensions.h"
    21   INCLUDE "paramet.h"
    22   !
     22
     23
     24
    2325  !  .....   arguments  ....
    24   !
     26
    2527  REAL :: p(ijb_u:ije_u,llmp1), masse(ijb_u:ije_u,llm)
    2628
    … …  
    3133  REAL :: massemoyn, massemoys
    3234
    33   !
    34   !
     35
     36
    3537  !   Methode pour calculer massebx et masseby .
    3638  !   ----------------------------------------
    37   !
     39
    3840  !    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
    3941  !   alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
    … …  
    4143  !   alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
    4244  !   alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
    43   !
     45
    4446  !    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
    45   !
     47
    4648  !    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
    47   !
    48   !
    49   !
     49
     50
     51
    5052  !   alpha4 .         . alpha1    . alpha4
    5153  !    (i,j)             (i,j)       (i+1,j)
    52   !
     54
    5355  !         P .        U .          . P
    5456  !       (i,j)       (i,j)         (i+1,j)
    55   !
     57
    5658  !   alpha3 .         . alpha2    .alpha3
    5759  !    (i,j)              (i,j)     (i+1,j)
    58   !
     60
    5961  !         V .        Z .          . V
    6062  !       (i,j)
    61   !
     63
    6264  !   alpha4 .         . alpha1    .alpha4
    6365  !   (i,j+1)            (i,j+1)   (i+1,j+1)
    64   !
     66
    6567  !         P .        U .          . P
    6668  !      (i,j+1)                    (i+1,j+1)
    67   !
    68   !
    69   !
     69
     70
     71
    7072  !                   On  a :
    71   !
     73
    7274  !    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
    7375  !               masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
    7476  ! localise  au point  ... U (i,j) ...
    75   !
     77
    7678  !    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
    7779  !               masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)
    7880  ! localise  au point  ... V (i,j) ...
    79   !
    80   !
     81
     82
    8183  !=======================================================================
    8284
    … …  
    9294!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    9395  DO   l = 1 , llm
    94   !
     96
    9597    DO    ij     = ijb, ije
    9698     masse(ij,l) = airesurg(ij) * ( p(ij,l) - p(ij,l+1) )
    9799    ENDDO
    98   !
     100
    99101    DO   ij = ijb, ije,iip1
    100102     masse(ij+ iim,l) = masse(ij,l)
    101103    ENDDO
    102   !
     104
    103105  !   DO    ij     = 1,  iim
    104106  !    masse(   ij   ,l) = masse(   ij   ,l) * aire(  ij    )

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

    r5158 r5159  
    11module mod_Hallo
    2 USE parallel_lmdz
    3 IMPLICIT NONE
    4   logical,save :: use_mpi_alloc
    5   INTEGER, parameter :: MaxProc=512
    6   INTEGER, parameter :: DefaultMaxBufferSize=1024*1024*100
    7   INTEGER, SAVE :: MaxBufferSize=0
    8   INTEGER, parameter :: ListSize=1000
    9  
    10   INTEGER,save      :: MaxBufferSize_Used
    11 !$OMP THREADPRIVATE( MaxBufferSize_Used)
    12 
    13    REAL,SAVE,pointer,DIMENSION(:) :: Buffer
    14 !$OMP THREADPRIVATE(Buffer)
    15 
    16    INTEGER,SAVE,DIMENSION(Listsize) :: Buffer_Pos
    17    INTEGER,save :: Index_Pos
    18 !$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
    19    
     2  USE parallel_lmdz
     3  IMPLICIT NONE
     4  logical, save :: use_mpi_alloc
     5  INTEGER, parameter :: MaxProc = 512
     6  INTEGER, parameter :: DefaultMaxBufferSize = 1024 * 1024 * 100
     7  INTEGER, SAVE :: MaxBufferSize = 0
     8  INTEGER, parameter :: ListSize = 1000
     9
     10  INTEGER, save :: MaxBufferSize_Used
     11  !$OMP THREADPRIVATE( MaxBufferSize_Used)
     12
     13  REAL, SAVE, pointer, DIMENSION(:) :: Buffer
     14  !$OMP THREADPRIVATE(Buffer)
     15
     16  INTEGER, SAVE, DIMENSION(Listsize) :: Buffer_Pos
     17  INTEGER, save :: Index_Pos
     18  !$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
     19
    2020  type Hallo
    21     REAL, DIMENSION(:,:),pointer :: Field
     21    REAL, DIMENSION(:, :), pointer :: Field
    2222    INTEGER :: offset
    2323    INTEGER :: size
    … …  
    2525    INTEGER :: Stride
    2626  end type Hallo
    27  
     27
    2828  type request_SR
    29     INTEGER :: NbRequest=0
    30     INTEGER :: NbRequestMax=0
     29    INTEGER :: NbRequest = 0
     30    INTEGER :: NbRequestMax = 0
    3131    INTEGER :: BufferSize
    3232    INTEGER :: Pos
    … …  
    3737
    3838  type request
    39     type(request_SR),DIMENSION(0:MaxProc-1) :: RequestSend
    40     type(request_SR),DIMENSION(0:MaxProc-1) :: RequestRecv
    41     INTEGER :: tag=1
     39    type(request_SR), DIMENSION(0:MaxProc - 1) :: RequestSend
     40    type(request_SR), DIMENSION(0:MaxProc - 1) :: RequestRecv
     41    INTEGER :: tag = 1
    4242  end type request
    43  
    44    TYPE(distrib),SAVE :: distrib_gather
    45 
     43
     44  TYPE(distrib), SAVE :: distrib_gather
    4645
    4746  INTERFACE Register_SwapField_u
    48     MODULE PROCEDURE Register_SwapField1d_u,Register_SwapField2d_u1d,Register_SwapField3d_u, &
    49                      Register_SwapField1d_u_bis,Register_SwapField2d_u1d_bis,Register_SwapField3d_u_bis
     47    MODULE PROCEDURE Register_SwapField1d_u, Register_SwapField2d_u1d, Register_SwapField3d_u, &
     48            Register_SwapField1d_u_bis, Register_SwapField2d_u1d_bis, Register_SwapField3d_u_bis
    5049  END INTERFACE Register_SwapField_u
    5150
    5251  INTERFACE Register_SwapField_v
    53     MODULE PROCEDURE Register_SwapField1d_v,Register_SwapField2d_v1d,Register_SwapField3d_v,&
    54                      Register_SwapField1d_v_bis,Register_SwapField2d_v1d_bis,Register_SwapField3d_v_bis
     52    MODULE PROCEDURE Register_SwapField1d_v, Register_SwapField2d_v1d, Register_SwapField3d_v, &
     53            Register_SwapField1d_v_bis, Register_SwapField2d_v1d_bis, Register_SwapField3d_v_bis
    5554  END INTERFACE Register_SwapField_v
    5655
    5756  INTERFACE Register_SwapField2d_u
    58     MODULE PROCEDURE Register_SwapField1d_u2d,Register_SwapField2d_u2d,Register_SwapField3d_u2d, &
    59                      Register_SwapField1d_u2d_bis,Register_SwapField2d_u2d_bis,Register_SwapField3d_u2d_bis
     57    MODULE PROCEDURE Register_SwapField1d_u2d, Register_SwapField2d_u2d, Register_SwapField3d_u2d, &
     58            Register_SwapField1d_u2d_bis, Register_SwapField2d_u2d_bis, Register_SwapField3d_u2d_bis
    6059  END INTERFACE Register_SwapField2d_u
    6160
    6261  INTERFACE Register_SwapField2d_v
    63     MODULE PROCEDURE Register_SwapField1d_v2d,Register_SwapField2d_v2d,Register_SwapField3d_v2d, &
    64                      Register_SwapField1d_v2d_bis,Register_SwapField2d_v2d_bis,Register_SwapField3d_v2d_bis
     62    MODULE PROCEDURE Register_SwapField1d_v2d, Register_SwapField2d_v2d, Register_SwapField3d_v2d, &
     63            Register_SwapField1d_v2d_bis, Register_SwapField2d_v2d_bis, Register_SwapField3d_v2d_bis
    6564  END INTERFACE Register_SwapField2d_v
    6665
    67   CONTAINS
     66CONTAINS
    6867
    6968  SUBROUTINE Init_mod_hallo
    70   USE dimensions_mod
    71   USE IOIPSL
    72     IMPLICIT NONE
    73     INTEGER :: jj_nb_gather(0:mpi_size-1)
    74    
    75     Index_Pos=1
    76     Buffer_Pos(Index_Pos)=1
    77     MaxBufferSize_Used=0
    78 !$OMP MASTER     
    79     MaxBufferSize=DefaultMaxBufferSize
    80     CALL getin("mpi_buffer_size",MaxBufferSize)
    81 !$OMP END MASTER
    82 !$OMP BARRIER
    83    
     69    USE lmdz_dimensions
     70    USE lmdz_paramet
     71    USE IOIPSL
     72    IMPLICIT NONE
     73    INTEGER :: jj_nb_gather(0:mpi_size - 1)
     74
     75    Index_Pos = 1
     76    Buffer_Pos(Index_Pos) = 1
     77    MaxBufferSize_Used = 0
     78    !$OMP MASTER
     79    MaxBufferSize = DefaultMaxBufferSize
     80    CALL getin("mpi_buffer_size", MaxBufferSize)
     81    !$OMP END MASTER
     82    !$OMP BARRIER
     83
    8484    IF (use_mpi_alloc .AND. using_mpi) THEN
    8585      CALL create_global_mpi_buffer
    86     ELSE 
     86    ELSE
    8787      CALL create_standard_mpi_buffer
    8888    ENDIF
    89      
    90 !$OMP MASTER     
    91      jj_nb_gather(:)=0
    92      jj_nb_gather(0)=jjp1
    93      
    94      CALL create_distrib(jj_nb_gather,distrib_gather)
    95 !$OMP END MASTER
    96 !$OMP BARRIER
     89
     90    !$OMP MASTER
     91    jj_nb_gather(:) = 0
     92    jj_nb_gather(0) = jjp1
     93
     94    CALL create_distrib(jj_nb_gather, distrib_gather)
     95    !$OMP END MASTER
     96    !$OMP BARRIER
    9797
    9898  END SUBROUTINE  init_mod_hallo
    9999
    100100  SUBROUTINE create_standard_mpi_buffer
    101   IMPLICIT NONE
    102    
     101    IMPLICIT NONE
     102
    103103    ALLOCATE(Buffer(MaxBufferSize))
    104    
     104
    105105  END SUBROUTINE create_standard_mpi_buffer
    106  
     106
    107107  SUBROUTINE create_global_mpi_buffer
    108   USE lmdz_mpi
    109   IMPLICIT NONE
    110     POINTER (Pbuffer,MPI_Buffer(MaxBufferSize))
     108    USE lmdz_mpi
     109    IMPLICIT NONE
     110    POINTER (Pbuffer, MPI_Buffer(MaxBufferSize))
    111111    REAL :: MPI_Buffer
    112     INTEGER(KIND=MPI_ADDRESS_KIND) :: BS
    113     INTEGER :: i,ierr
    114 
    115 !  Allocation du buffer MPI
    116       Bs=8*MaxBufferSize
    117 !$OMP CRITICAL (MPI)
    118       CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
    119 !$OMP END CRITICAL (MPI)
    120       DO i=1,MaxBufferSize
    121     MPI_Buffer(i)=i
    122       ENDDO
    123      
    124       CALL  Associate_buffer(MPI_Buffer)
    125      
     112    INTEGER(KIND = MPI_ADDRESS_KIND) :: BS
     113    INTEGER :: i, ierr
     114
     115    !  Allocation du buffer MPI
     116    Bs = 8 * MaxBufferSize
     117    !$OMP CRITICAL (MPI)
     118    CALL MPI_ALLOC_MEM(BS, MPI_INFO_NULL, Pbuffer, ierr)
     119    !$OMP END CRITICAL (MPI)
     120    DO i = 1, MaxBufferSize
     121      MPI_Buffer(i) = i
     122    ENDDO
     123
     124    CALL  Associate_buffer(MPI_Buffer)
     125
    126126  CONTAINS
    127      
    128      SUBROUTINE Associate_buffer(MPI_Buffer)
    129      IMPLICIT NONE
    130        REAL,DIMENSION(:),target :: MPI_Buffer 
    131 
    132          Buffer=>MPI_Buffer
    133  
    134       END SUBROUTINE  Associate_buffer
    135                                      
     127
     128    SUBROUTINE Associate_buffer(MPI_Buffer)
     129      IMPLICIT NONE
     130      REAL, DIMENSION(:), target :: MPI_Buffer
     131
     132      Buffer => MPI_Buffer
     133
     134    END SUBROUTINE  Associate_buffer
     135
    136136  END SUBROUTINE create_global_mpi_buffer
    137  
    138      
    139   SUBROUTINE allocate_buffer(Size,Index,Pos)
    140 
    141   IMPLICIT NONE
     137
     138
     139  SUBROUTINE allocate_buffer(Size, Index, Pos)
     140
     141    IMPLICIT NONE
    142142    INTEGER :: Size
    143143    INTEGER :: Index
    144144    INTEGER :: Pos
    145145
    146     IF (Buffer_pos(Index_pos)+Size>MaxBufferSize_Used) MaxBufferSize_Used=Buffer_pos(Index_pos)+Size
    147     IF (Buffer_pos(Index_pos)+Size>MaxBufferSize) THEN
    148       print *,'STOP :: La taille de MaxBufferSize dans mod_hallo.F90 est trop petite !!!!'
    149       CALL abort_gcm("mod_hallo","stopped",1)
     146    IF (Buffer_pos(Index_pos) + Size>MaxBufferSize_Used) MaxBufferSize_Used = Buffer_pos(Index_pos) + Size
     147    IF (Buffer_pos(Index_pos) + Size>MaxBufferSize) THEN
     148      print *, 'STOP :: La taille de MaxBufferSize dans mod_hallo.F90 est trop petite !!!!'
     149      CALL abort_gcm("mod_hallo", "stopped", 1)
    150150    endif
    151    
     151
    152152    IF (Index_pos>=ListSize) THEN
    153       print *,'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
    154       CALL abort_gcm("mod_hallo","stopped",1)
     153      print *, 'STOP :: La taille de ListSize dans mod_hallo.F90 est trop petite !!!!'
     154      CALL abort_gcm("mod_hallo", "stopped", 1)
    155155    endif
    156      
    157     Pos=Buffer_Pos(Index_Pos)
    158     Buffer_Pos(Index_pos+1)=Buffer_Pos(Index_Pos)+Size
    159     Index_Pos=Index_Pos+1
    160     Index=Index_Pos
    161    
     156
     157    Pos = Buffer_Pos(Index_Pos)
     158    Buffer_Pos(Index_pos + 1) = Buffer_Pos(Index_Pos) + Size
     159    Index_Pos = Index_Pos + 1
     160    Index = Index_Pos
     161
    162162  END SUBROUTINE  allocate_buffer
    163      
     163
    164164  SUBROUTINE deallocate_buffer(Index)
    165   IMPLICIT NONE
     165    IMPLICIT NONE
    166166    INTEGER :: Index
    167    
    168     Buffer_Pos(Index)=-1
    169    
     167
     168    Buffer_Pos(Index) = -1
     169
    170170    DO while (Buffer_Pos(Index_Pos)==-1 .AND. Index_Pos>1)
    171       Index_Pos=Index_Pos-1
     171      Index_Pos = Index_Pos - 1
    172172    END DO
    173173
    174174  END SUBROUTINE  deallocate_buffer
    175  
    176   SUBROUTINE SetTag(a_request,tag)
    177   IMPLICIT NONE
    178     type(request):: a_request
     175
     176  SUBROUTINE SetTag(a_request, tag)
     177    IMPLICIT NONE
     178    type(request) :: a_request
    179179    INTEGER :: tag
    180    
    181     a_request%tag=tag
     180
     181    a_request%tag = tag
    182182  END SUBROUTINE  SetTag
    183  
    184  
    185   SUBROUTINE New_Hallo(Field,Stride,NbLevel,offset,size,Ptr_request)
     183
     184
     185  SUBROUTINE New_Hallo(Field, Stride, NbLevel, offset, size, Ptr_request)
    186186    INTEGER :: Stride
    187187    INTEGER :: NbLevel
    188188    INTEGER :: size
    189189    INTEGER :: offset
    190     REAL, DIMENSION(Stride,NbLevel),target :: Field
    191     type(request_SR),pointer :: Ptr_request
    192     type(Hallo),POINTER :: NewHallos(:),HalloSwitch(:), NewHallo
    193    
    194     Ptr_Request%NbRequest=Ptr_Request%NbRequest+1
     190    REAL, DIMENSION(Stride, NbLevel), target :: Field
     191    type(request_SR), pointer :: Ptr_request
     192    type(Hallo), POINTER :: NewHallos(:), HalloSwitch(:), NewHallo
     193
     194    Ptr_Request%NbRequest = Ptr_Request%NbRequest + 1
    195195    IF(Ptr_Request%NbRequestMax==0) THEN
    196        Ptr_Request%NbRequestMax=10
    197        ALLOCATE(Ptr_Request%Hallo(Ptr_Request%NbRequestMax))
    198     ELSE IF ( Ptr_Request%NbRequest > Ptr_Request%NbRequestMax) THEN
    199       Ptr_Request%NbRequestMax=INT(Ptr_Request%NbRequestMax*1.2)
     196      Ptr_Request%NbRequestMax = 10
     197      ALLOCATE(Ptr_Request%Hallo(Ptr_Request%NbRequestMax))
     198    ELSE IF (Ptr_Request%NbRequest > Ptr_Request%NbRequestMax) THEN
     199      Ptr_Request%NbRequestMax = INT(Ptr_Request%NbRequestMax * 1.2)
    200200      ALLOCATE(NewHallos(Ptr_Request%NbRequestMax))
    201       NewHallos(1:Ptr_Request%NbRequest-1)=Ptr_Request%hallo(1:Ptr_Request%NbRequest-1)
    202       HalloSwitch=>Ptr_Request%hallo
    203       Ptr_Request%hallo=>NewHallos
     201      NewHallos(1:Ptr_Request%NbRequest - 1) = Ptr_Request%hallo(1:Ptr_Request%NbRequest - 1)
     202      HalloSwitch => Ptr_Request%hallo
     203      Ptr_Request%hallo => NewHallos
    204204      DEALLOCATE(HalloSwitch)
    205205    ENDIF
    206    
    207     NewHallo=>Ptr_Request%hallo(Ptr_Request%NbRequest)
    208          
    209     NewHallo%Field=>Field
    210     NewHallo%Stride=Stride
    211     NewHallo%NbLevel=NbLevel
    212     NewHallo%size=size
    213     NewHallo%offset=offset
    214    
     206
     207    NewHallo => Ptr_Request%hallo(Ptr_Request%NbRequest)
     208
     209    NewHallo%Field => Field
     210    NewHallo%Stride = Stride
     211    NewHallo%NbLevel = NbLevel
     212    NewHallo%size = size
     213    NewHallo%offset = offset
     214
    215215  END SUBROUTINE  New_Hallo
    216  
    217   SUBROUTINE Register_SendField(Field,ij,ll,offset,size,target,a_request)
    218   USE dimensions_mod
    219   IMPLICIT NONE
    220 
    221    
    222       INTEGER :: ij,ll,offset,size,target
    223       REAL, DIMENSION(ij,ll) :: Field
    224       type(request),target :: a_request
    225       type(request_SR),pointer :: Ptr_request
    226 
    227       Ptr_Request=>a_request%RequestSend(target)
    228 
    229       CALL New_Hallo(Field,ij,ll,offset,size,Ptr_request)
    230      
    231    END SUBROUTINE  Register_SendField
    232      
    233   SUBROUTINE Register_RecvField(Field,ij,ll,offset,size,target,a_request)
    234   USE dimensions_mod
    235   IMPLICIT NONE
    236 
    237    
    238       INTEGER :: ij,ll,offset,size,target
    239       REAL, DIMENSION(ij,ll) :: Field
    240       type(request),target :: a_request
    241       type(request_SR),pointer :: Ptr_request
    242 
    243       Ptr_Request=>a_request%RequestRecv(target)
    244            
    245       CALL New_Hallo(Field,ij,ll,offset,size,Ptr_request)
    246 
    247      
    248    END SUBROUTINE  Register_RecvField
    249  
    250   SUBROUTINE Register_SwapField(FieldS,FieldR,ij,ll,jj_Nb_New,a_request)
    251   USE dimensions_mod
    252       IMPLICIT NONE
    253 
    254    
    255     INTEGER :: ij,ll
    256     REAL, DIMENSION(ij,ll) :: FieldS
    257     REAL, DIMENSION(ij,ll) :: FieldR
     216
     217  SUBROUTINE Register_SendField(Field, ij, ll, offset, size, target, a_request)
     218    USE lmdz_dimensions
     219    USE lmdz_paramet
     220    IMPLICIT NONE
     221
     222    INTEGER :: ij, ll, offset, size, target
     223    REAL, DIMENSION(ij, ll) :: Field
     224    type(request), target :: a_request
     225    type(request_SR), pointer :: Ptr_request
     226
     227    Ptr_Request => a_request%RequestSend(target)
     228
     229    CALL New_Hallo(Field, ij, ll, offset, size, Ptr_request)
     230
     231  END SUBROUTINE  Register_SendField
     232
     233  SUBROUTINE Register_RecvField(Field, ij, ll, offset, size, target, a_request)
     234    USE lmdz_dimensions
     235    USE lmdz_paramet
     236    IMPLICIT NONE
     237
     238    INTEGER :: ij, ll, offset, size, target
     239    REAL, DIMENSION(ij, ll) :: Field
     240    type(request), target :: a_request
     241    type(request_SR), pointer :: Ptr_request
     242
     243    Ptr_Request => a_request%RequestRecv(target)
     244
     245    CALL New_Hallo(Field, ij, ll, offset, size, Ptr_request)
     246
     247  END SUBROUTINE  Register_RecvField
     248
     249  SUBROUTINE Register_SwapField(FieldS, FieldR, ij, ll, jj_Nb_New, a_request)
     250    USE lmdz_dimensions
     251    USE lmdz_paramet
     252    IMPLICIT NONE
     253
     254    INTEGER :: ij, ll
     255    REAL, DIMENSION(ij, ll) :: FieldS
     256    REAL, DIMENSION(ij, ll) :: FieldR
    258257    type(request) :: a_request
    259     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
    260     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    261    
    262     INTEGER ::i,jje,jjb
    263    
    264     jj_begin_New(0)=1
    265     jj_End_New(0)=jj_Nb_New(0)
    266     DO i=1,MPI_Size-1
    267       jj_begin_New(i)=jj_end_New(i-1)+1
    268       jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
     258    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
     259    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
     260
     261    INTEGER :: i, jje, jjb
     262
     263    jj_begin_New(0) = 1
     264    jj_End_New(0) = jj_Nb_New(0)
     265    DO i = 1, MPI_Size - 1
     266      jj_begin_New(i) = jj_end_New(i - 1) + 1
     267      jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
    269268    enddo
    270    
    271     DO i=0,MPI_Size-1
     269
     270    DO i = 0, MPI_Size - 1
    272271      IF (i /= MPI_Rank) THEN
    273         jjb=max(jj_begin_new(i),jj_begin)
    274         jje=min(jj_end_new(i),jj_end)
    275        
    276         IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
    277        
     272        jjb = max(jj_begin_new(i), jj_begin)
     273        jje = min(jj_end_new(i), jj_end)
     274
     275        IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
     276
    278277        IF (jje >= jjb) THEN
    279           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
     278          CALL Register_SendField(FieldS, ij, ll, jjb, jje - jjb + 1, i, a_request)
    280279        endif
    281        
    282         jjb=max(jj_begin_new(MPI_Rank),jj_begin_Para(i))
    283         jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
    284        
    285         IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
    286        
     280
     281        jjb = max(jj_begin_new(MPI_Rank), jj_begin_Para(i))
     282        jje = min(jj_end_new(MPI_Rank), jj_end_Para(i))
     283
     284        IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
     285
    287286        IF (jje >= jjb) THEN
    288           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
     287          CALL Register_RecvField(FieldR, ij, ll, jjb, jje - jjb + 1, i, a_request)
    289288        endif
    290        
     289
    291290      endif
    292291    enddo
    293    
     292
    294293  END SUBROUTINE  Register_SwapField
    295  
    296 
    297  
    298   SUBROUTINE Register_SwapFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down,a_request)
    299   USE dimensions_mod
    300  
    301       IMPLICIT NONE
    302    
    303     INTEGER :: ij,ll,Up,Down
    304     REAL, DIMENSION(ij,ll) :: FieldS
    305     REAL, DIMENSION(ij,ll) :: FieldR
     294
     295
     296  SUBROUTINE Register_SwapFieldHallo(FieldS, FieldR, ij, ll, jj_Nb_New, Up, Down, a_request)
     297    USE lmdz_dimensions
     298    USE lmdz_paramet
     299
     300    IMPLICIT NONE
     301
     302    INTEGER :: ij, ll, Up, Down
     303    REAL, DIMENSION(ij, ll) :: FieldS
     304    REAL, DIMENSION(ij, ll) :: FieldR
    306305    type(request) :: a_request
    307     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
    308     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    309    
    310     INTEGER ::i,jje,jjb
    311    
    312     jj_begin_New(0)=1
    313     jj_End_New(0)=jj_Nb_New(0)
    314     DO i=1,MPI_Size-1
    315       jj_begin_New(i)=jj_end_New(i-1)+1
    316       jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
     306    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
     307    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
     308
     309    INTEGER :: i, jje, jjb
     310
     311    jj_begin_New(0) = 1
     312    jj_End_New(0) = jj_Nb_New(0)
     313    DO i = 1, MPI_Size - 1
     314      jj_begin_New(i) = jj_end_New(i - 1) + 1
     315      jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
    317316    enddo
    318    
    319     DO i=0,MPI_Size-1
    320       jj_begin_New(i)=max(1,jj_begin_New(i)-Up)
    321       jj_end_New(i)=min(jjp1,jj_end_new(i)+Down)
     317
     318    DO i = 0, MPI_Size - 1
     319      jj_begin_New(i) = max(1, jj_begin_New(i) - Up)
     320      jj_end_New(i) = min(jjp1, jj_end_new(i) + Down)
    322321    enddo
    323    
    324     DO i=0,MPI_Size-1
     322
     323    DO i = 0, MPI_Size - 1
    325324      IF (i /= MPI_Rank) THEN
    326         jjb=max(jj_begin_new(i),jj_begin)
    327         jje=min(jj_end_new(i),jj_end)
    328        
    329         IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
    330        
     325        jjb = max(jj_begin_new(i), jj_begin)
     326        jje = min(jj_end_new(i), jj_end)
     327
     328        IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
     329
    331330        IF (jje >= jjb) THEN
    332           CALL Register_SendField(FieldS,ij,ll,jjb,jje-jjb+1,i,a_request)
     331          CALL Register_SendField(FieldS, ij, ll, jjb, jje - jjb + 1, i, a_request)
    333332        endif
    334        
    335         jjb=max(jj_begin_new(MPI_Rank),jj_begin_Para(i))
    336         jje=min(jj_end_new(MPI_Rank),jj_end_Para(i))
    337        
    338         IF (ij==ip1jm .AND. jje==jjp1) jje=jjm
    339        
     333
     334        jjb = max(jj_begin_new(MPI_Rank), jj_begin_Para(i))
     335        jje = min(jj_end_new(MPI_Rank), jj_end_Para(i))
     336
     337        IF (ij==ip1jm .AND. jje==jjp1) jje = jjm
     338
    340339        IF (jje >= jjb) THEN
    341           CALL Register_RecvField(FieldR,ij,ll,jjb,jje-jjb+1,i,a_request)
     340          CALL Register_RecvField(FieldR, ij, ll, jjb, jje - jjb + 1, i, a_request)
    342341        endif
    343        
     342
    344343      endif
    345344    enddo
    346    
     345
    347346  END SUBROUTINE  Register_SwapFieldHallo
    348347
    349348
    350 
    351   SUBROUTINE Register_SwapField1d_u(FieldS,FieldR,new_dist,a_request,up,down)
    352   USE parallel_lmdz
    353   USE dimensions_mod
    354       IMPLICIT NONE
    355    
    356     TYPE(distrib),INTENT(IN)          :: new_dist
    357     REAL, DIMENSION(current_dist%ijb_u:),INTENT(IN)     :: FieldS
    358     REAL, DIMENSION(new_dist%ijb_u:),INTENT(OUT)    :: FieldR
    359     INTEGER,OPTIONAL,INTENT(IN)       :: up
    360     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    361     TYPE(request),INTENT(INOUT)         :: a_request
    362 
    363     INTEGER                           :: halo_up
    364     INTEGER                           :: halo_down
    365    
    366    
    367     halo_up=0
    368     halo_down=0
    369     IF (PRESENT(up))   halo_up=up
    370     IF (PRESENT(down)) halo_down=down
    371 
    372     CALL  Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
    373        
    374   END SUBROUTINE  Register_SwapField1d_u
    375 
    376   SUBROUTINE Register_SwapField1d_u_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    377   USE parallel_lmdz
    378   USE dimensions_mod
    379       IMPLICIT NONE
    380    
    381     TYPE(distrib),INTENT(IN)          :: new_dist
    382     TYPE(distrib),INTENT(IN)          :: old_dist
    383     REAL, DIMENSION(old_dist%ijb_u:),INTENT(IN)     :: FieldS
    384     REAL, DIMENSION(new_dist%ijb_u:),INTENT(OUT)    :: FieldR
    385     INTEGER,OPTIONAL,INTENT(IN)       :: up
    386     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    387     TYPE(request),INTENT(INOUT)         :: a_request
    388 
    389     INTEGER                           :: halo_up
    390     INTEGER                           :: halo_down
    391    
    392    
    393     halo_up=0
    394     halo_down=0
    395     IF (PRESENT(up))   halo_up=up
    396     IF (PRESENT(down)) halo_down=down
    397 
    398     CALL  Register_SwapField_gen_u(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
    399        
    400   END SUBROUTINE  Register_SwapField1d_u_bis
    401 
    402 
    403   SUBROUTINE Register_SwapField2d_u1d(FieldS,FieldR,new_dist,a_request,up,down)
    404   USE parallel_lmdz
    405   USE dimensions_mod
    406     IMPLICIT NONE
    407    
    408     TYPE(distrib),INTENT(IN)          :: new_dist
    409     REAL, DIMENSION(current_dist%ijb_u:,:),INTENT(IN)     :: FieldS
    410     REAL, DIMENSION(new_dist%ijb_u:,:),INTENT(OUT)    :: FieldR
    411     INTEGER,OPTIONAL,INTENT(IN)       :: up
    412     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    413     TYPE(request),INTENT(INOUT)         :: a_request
    414 
    415     INTEGER                           :: halo_up
    416     INTEGER                           :: halo_down
    417     INTEGER                           :: ll
    418        
    419    
    420     halo_up=0
    421     halo_down=0
    422     IF (PRESENT(up))   halo_up=up
    423     IF (PRESENT(down)) halo_down=down
    424    
    425     ll=size(FieldS,2)
    426    
    427     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    428    
     349  SUBROUTINE Register_SwapField1d_u(FieldS, FieldR, new_dist, a_request, up, down)
     350    USE parallel_lmdz
     351    USE lmdz_dimensions
     352    USE lmdz_paramet
     353    IMPLICIT NONE
     354
     355    TYPE(distrib), INTENT(IN) :: new_dist
     356    REAL, DIMENSION(current_dist%ijb_u:), INTENT(IN) :: FieldS
     357    REAL, DIMENSION(new_dist%ijb_u:), INTENT(OUT) :: FieldR
     358    INTEGER, OPTIONAL, INTENT(IN) :: up
     359    INTEGER, OPTIONAL, INTENT(IN) :: down
     360    TYPE(request), INTENT(INOUT) :: a_request
     361
     362    INTEGER :: halo_up
     363    INTEGER :: halo_down
     364
     365    halo_up = 0
     366    halo_down = 0
     367    IF (PRESENT(up))   halo_up = up
     368    IF (PRESENT(down)) halo_down = down
     369
     370    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
     371
     372  END SUBROUTINE  Register_SwapField1d_u
     373
     374  SUBROUTINE Register_SwapField1d_u_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     375    USE parallel_lmdz
     376    USE lmdz_dimensions
     377    USE lmdz_paramet
     378    IMPLICIT NONE
     379
     380    TYPE(distrib), INTENT(IN) :: new_dist
     381    TYPE(distrib), INTENT(IN) :: old_dist
     382    REAL, DIMENSION(old_dist%ijb_u:), INTENT(IN) :: FieldS
     383    REAL, DIMENSION(new_dist%ijb_u:), INTENT(OUT) :: FieldR
     384    INTEGER, OPTIONAL, INTENT(IN) :: up
     385    INTEGER, OPTIONAL, INTENT(IN) :: down
     386    TYPE(request), INTENT(INOUT) :: a_request
     387
     388    INTEGER :: halo_up
     389    INTEGER :: halo_down
     390
     391    halo_up = 0
     392    halo_down = 0
     393    IF (PRESENT(up))   halo_up = up
     394    IF (PRESENT(down)) halo_down = down
     395
     396    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
     397
     398  END SUBROUTINE  Register_SwapField1d_u_bis
     399
     400
     401  SUBROUTINE Register_SwapField2d_u1d(FieldS, FieldR, new_dist, a_request, up, down)
     402    USE parallel_lmdz
     403    USE lmdz_dimensions
     404    USE lmdz_paramet
     405    IMPLICIT NONE
     406
     407    TYPE(distrib), INTENT(IN) :: new_dist
     408    REAL, DIMENSION(current_dist%ijb_u:, :), INTENT(IN) :: FieldS
     409    REAL, DIMENSION(new_dist%ijb_u:, :), INTENT(OUT) :: FieldR
     410    INTEGER, OPTIONAL, INTENT(IN) :: up
     411    INTEGER, OPTIONAL, INTENT(IN) :: down
     412    TYPE(request), INTENT(INOUT) :: a_request
     413
     414    INTEGER :: halo_up
     415    INTEGER :: halo_down
     416    INTEGER :: ll
     417
     418    halo_up = 0
     419    halo_down = 0
     420    IF (PRESENT(up))   halo_up = up
     421    IF (PRESENT(down)) halo_down = down
     422
     423    ll = size(FieldS, 2)
     424
     425    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     426
    429427  END SUBROUTINE  Register_SwapField2d_u1d
    430428
    431   SUBROUTINE Register_SwapField2d_u1d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    432   USE parallel_lmdz
    433   USE dimensions_mod
    434     IMPLICIT NONE
    435    
    436     TYPE(distrib),INTENT(IN)          :: new_dist
    437     TYPE(distrib),INTENT(IN) :: old_dist
    438     REAL, DIMENSION(old_dist%ijb_u:,:),INTENT(IN)     :: FieldS
    439     REAL, DIMENSION(new_dist%ijb_u:,:),INTENT(OUT)    :: FieldR
    440     INTEGER,OPTIONAL,INTENT(IN)       :: up
    441     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    442     TYPE(request),INTENT(INOUT)         :: a_request
    443 
    444     INTEGER                           :: halo_up
    445     INTEGER                           :: halo_down
    446     INTEGER                           :: ll
    447        
    448    
    449     halo_up=0
    450     halo_down=0
    451     IF (PRESENT(up))   halo_up=up
    452     IF (PRESENT(down)) halo_down=down
    453    
    454     ll=size(FieldS,2)
    455    
    456     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    457    
     429  SUBROUTINE Register_SwapField2d_u1d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     430    USE parallel_lmdz
     431    USE lmdz_dimensions
     432    USE lmdz_paramet
     433    IMPLICIT NONE
     434
     435    TYPE(distrib), INTENT(IN) :: new_dist
     436    TYPE(distrib), INTENT(IN) :: old_dist
     437    REAL, DIMENSION(old_dist%ijb_u:, :), INTENT(IN) :: FieldS
     438    REAL, DIMENSION(new_dist%ijb_u:, :), INTENT(OUT) :: FieldR
     439    INTEGER, OPTIONAL, INTENT(IN) :: up
     440    INTEGER, OPTIONAL, INTENT(IN) :: down
     441    TYPE(request), INTENT(INOUT) :: a_request
     442
     443    INTEGER :: halo_up
     444    INTEGER :: halo_down
     445    INTEGER :: ll
     446
     447    halo_up = 0
     448    halo_down = 0
     449    IF (PRESENT(up))   halo_up = up
     450    IF (PRESENT(down)) halo_down = down
     451
     452    ll = size(FieldS, 2)
     453
     454    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     455
    458456  END SUBROUTINE  Register_SwapField2d_u1d_bis
    459    
    460 
    461   SUBROUTINE Register_SwapField3d_u(FieldS,FieldR,new_dist,a_request,up,down)
    462   USE parallel_lmdz
    463   USE dimensions_mod
    464       IMPLICIT NONE
    465    
    466     TYPE(distrib),INTENT(IN)          :: new_dist
    467     REAL, DIMENSION(current_dist%ijb_u:,:,:),INTENT(IN)     :: FieldS
    468     REAL, DIMENSION(new_dist%ijb_u:,:,:),INTENT(OUT)    :: FieldR
    469     INTEGER,OPTIONAL,INTENT(IN)       :: up
    470     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    471     TYPE(request),INTENT(INOUT)         :: a_request
    472 
    473     INTEGER                           :: halo_up
    474     INTEGER                           :: halo_down
    475     INTEGER                           :: ll
    476        
    477    
    478     halo_up=0
    479     halo_down=0
    480     IF (PRESENT(up))   halo_up=up
    481     IF (PRESENT(down)) halo_down=down
    482    
    483     ll=size(FieldS,2)*size(FieldS,3)
    484    
    485     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    486    
    487   END SUBROUTINE  Register_SwapField3d_u
    488 
    489   SUBROUTINE Register_SwapField3d_u_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    490   USE parallel_lmdz
    491   USE dimensions_mod
    492       IMPLICIT NONE
    493    
    494     TYPE(distrib),INTENT(IN)          :: new_dist
    495     TYPE(distrib),INTENT(IN) :: old_dist
    496     REAL, DIMENSION(old_dist%ijb_u:,:,:),INTENT(IN)     :: FieldS
    497     REAL, DIMENSION(new_dist%ijb_u:,:,:),INTENT(OUT)    :: FieldR
    498     INTEGER,OPTIONAL,INTENT(IN)       :: up
    499     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    500     TYPE(request),INTENT(INOUT)         :: a_request
    501 
    502     INTEGER                           :: halo_up
    503     INTEGER                           :: halo_down
    504     INTEGER                           :: ll
    505        
    506    
    507     halo_up=0
    508     halo_down=0
    509     IF (PRESENT(up))   halo_up=up
    510     IF (PRESENT(down)) halo_down=down
    511    
    512     ll=size(FieldS,2)*size(FieldS,3)
    513    
    514     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    515    
    516   END SUBROUTINE  Register_SwapField3d_u_bis
    517  
    518 
    519 
    520  SUBROUTINE Register_SwapField1d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
    521   USE parallel_lmdz
    522   USE dimensions_mod
    523 
    524       IMPLICIT NONE
    525 
    526     TYPE(distrib),INTENT(IN)          :: new_dist !LF
    527     REAL, DIMENSION(current_dist%jjb_u:,:),INTENT(IN)     :: FieldS
    528     REAL, DIMENSION(new_dist%jjb_u:,:),INTENT(OUT)    :: FieldR
    529     INTEGER,OPTIONAL,INTENT(IN)       :: up
    530     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    531     TYPE(request),INTENT(INOUT)         :: a_request
    532 
    533     INTEGER                           :: halo_up
    534     INTEGER                           :: halo_down
    535    
    536    
    537     halo_up=0
    538     halo_down=0
    539     IF (PRESENT(up))   halo_up=up
    540     IF (PRESENT(down)) halo_down=down
    541 
    542     CALL  Register_SwapField_gen_u(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
    543        
    544   END SUBROUTINE  Register_SwapField1d_u2d
    545 
    546  SUBROUTINE Register_SwapField1d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    547   USE parallel_lmdz
    548   USE dimensions_mod
    549 
    550       IMPLICIT NONE
    551 
    552     TYPE(distrib),INTENT(IN)          :: new_dist !LF
    553     TYPE(distrib),INTENT(IN)          :: old_dist
    554     REAL, DIMENSION(old_dist%jjb_u:,:),INTENT(IN)     :: FieldS
    555     REAL, DIMENSION(new_dist%jjb_u:,:),INTENT(OUT)    :: FieldR
    556     INTEGER,OPTIONAL,INTENT(IN)       :: up
    557     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    558     TYPE(request),INTENT(INOUT)         :: a_request
    559 
    560     INTEGER                           :: halo_up
    561     INTEGER                           :: halo_down
    562    
    563    
    564     halo_up=0
    565     halo_down=0
    566     IF (PRESENT(up))   halo_up=up
    567     IF (PRESENT(down)) halo_down=down
    568 
    569     CALL  Register_SwapField_gen_u(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
    570        
    571   END SUBROUTINE  Register_SwapField1d_u2d_bis
    572 
    573 
    574   SUBROUTINE Register_SwapField2d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
    575   USE parallel_lmdz
    576   USE dimensions_mod
    577 
    578       IMPLICIT NONE
    579    
    580     TYPE(distrib),INTENT(IN)          :: new_dist
    581     REAL, DIMENSION(current_dist%jjb_u:,:,:),INTENT(IN)     :: FieldS
    582     REAL, DIMENSION(new_dist%jjb_u:,:,:),INTENT(OUT)    :: FieldR
    583     INTEGER,OPTIONAL,INTENT(IN)       :: up
    584     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    585     TYPE(request),INTENT(INOUT)         :: a_request
    586 
    587     INTEGER                           :: halo_up
    588     INTEGER                           :: halo_down
    589     INTEGER                           :: ll
    590        
    591    
    592     halo_up=0
    593     halo_down=0
    594     IF (PRESENT(up))   halo_up=up
    595     IF (PRESENT(down)) halo_down=down
    596    
    597     ll=size(FieldS,3)
    598    
    599     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    600    
     457
     458
     459  SUBROUTINE Register_SwapField3d_u(FieldS, FieldR, new_dist, a_request, up, down)
     460    USE parallel_lmdz
     461    USE lmdz_dimensions
     462    USE lmdz_paramet
     463    IMPLICIT NONE
     464
     465    TYPE(distrib), INTENT(IN) :: new_dist
     466    REAL, DIMENSION(current_dist%ijb_u:, :, :), INTENT(IN) :: FieldS
     467    REAL, DIMENSION(new_dist%ijb_u:, :, :), INTENT(OUT) :: FieldR
     468    INTEGER, OPTIONAL, INTENT(IN) :: up
     469    INTEGER, OPTIONAL, INTENT(IN) :: down
     470    TYPE(request), INTENT(INOUT) :: a_request
     471
     472    INTEGER :: halo_up
     473    INTEGER :: halo_down
     474    INTEGER :: ll
     475
     476    halo_up = 0
     477    halo_down = 0
     478    IF (PRESENT(up))   halo_up = up
     479    IF (PRESENT(down)) halo_down = down
     480
     481    ll = size(FieldS, 2) * size(FieldS, 3)
     482
     483    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     484
     485  END SUBROUTINE  Register_SwapField3d_u
     486
     487  SUBROUTINE Register_SwapField3d_u_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     488    USE parallel_lmdz
     489    USE lmdz_dimensions
     490    USE lmdz_paramet
     491    IMPLICIT NONE
     492
     493    TYPE(distrib), INTENT(IN) :: new_dist
     494    TYPE(distrib), INTENT(IN) :: old_dist
     495    REAL, DIMENSION(old_dist%ijb_u:, :, :), INTENT(IN) :: FieldS
     496    REAL, DIMENSION(new_dist%ijb_u:, :, :), INTENT(OUT) :: FieldR
     497    INTEGER, OPTIONAL, INTENT(IN) :: up
     498    INTEGER, OPTIONAL, INTENT(IN) :: down
     499    TYPE(request), INTENT(INOUT) :: a_request
     500
     501    INTEGER :: halo_up
     502    INTEGER :: halo_down
     503    INTEGER :: ll
     504
     505    halo_up = 0
     506    halo_down = 0
     507    IF (PRESENT(up))   halo_up = up
     508    IF (PRESENT(down)) halo_down = down
     509
     510    ll = size(FieldS, 2) * size(FieldS, 3)
     511
     512    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     513
     514  END SUBROUTINE  Register_SwapField3d_u_bis
     515
     516
     517  SUBROUTINE Register_SwapField1d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
     518    USE parallel_lmdz
     519    USE lmdz_dimensions
     520    USE lmdz_paramet
     521
     522    IMPLICIT NONE
     523
     524    TYPE(distrib), INTENT(IN) :: new_dist !LF
     525    REAL, DIMENSION(current_dist%jjb_u:, :), INTENT(IN) :: FieldS
     526    REAL, DIMENSION(new_dist%jjb_u:, :), INTENT(OUT) :: FieldR
     527    INTEGER, OPTIONAL, INTENT(IN) :: up
     528    INTEGER, OPTIONAL, INTENT(IN) :: down
     529    TYPE(request), INTENT(INOUT) :: a_request
     530
     531    INTEGER :: halo_up
     532    INTEGER :: halo_down
     533
     534    halo_up = 0
     535    halo_down = 0
     536    IF (PRESENT(up))   halo_up = up
     537    IF (PRESENT(down)) halo_down = down
     538
     539    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
     540
     541  END SUBROUTINE  Register_SwapField1d_u2d
     542
     543  SUBROUTINE Register_SwapField1d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     544    USE parallel_lmdz
     545    USE lmdz_dimensions
     546    USE lmdz_paramet
     547
     548    IMPLICIT NONE
     549
     550    TYPE(distrib), INTENT(IN) :: new_dist !LF
     551    TYPE(distrib), INTENT(IN) :: old_dist
     552    REAL, DIMENSION(old_dist%jjb_u:, :), INTENT(IN) :: FieldS
     553    REAL, DIMENSION(new_dist%jjb_u:, :), INTENT(OUT) :: FieldR
     554    INTEGER, OPTIONAL, INTENT(IN) :: up
     555    INTEGER, OPTIONAL, INTENT(IN) :: down
     556    TYPE(request), INTENT(INOUT) :: a_request
     557
     558    INTEGER :: halo_up
     559    INTEGER :: halo_down
     560
     561    halo_up = 0
     562    halo_down = 0
     563    IF (PRESENT(up))   halo_up = up
     564    IF (PRESENT(down)) halo_down = down
     565
     566    CALL  Register_SwapField_gen_u(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
     567
     568  END SUBROUTINE  Register_SwapField1d_u2d_bis
     569
     570
     571  SUBROUTINE Register_SwapField2d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
     572    USE parallel_lmdz
     573    USE lmdz_dimensions
     574    USE lmdz_paramet
     575
     576    IMPLICIT NONE
     577
     578    TYPE(distrib), INTENT(IN) :: new_dist
     579    REAL, DIMENSION(current_dist%jjb_u:, :, :), INTENT(IN) :: FieldS
     580    REAL, DIMENSION(new_dist%jjb_u:, :, :), INTENT(OUT) :: FieldR
     581    INTEGER, OPTIONAL, INTENT(IN) :: up
     582    INTEGER, OPTIONAL, INTENT(IN) :: down
     583    TYPE(request), INTENT(INOUT) :: a_request
     584
     585    INTEGER :: halo_up
     586    INTEGER :: halo_down
     587    INTEGER :: ll
     588
     589    halo_up = 0
     590    halo_down = 0
     591    IF (PRESENT(up))   halo_up = up
     592    IF (PRESENT(down)) halo_down = down
     593
     594    ll = size(FieldS, 3)
     595
     596    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     597
    601598  END SUBROUTINE  Register_SwapField2d_u2d
    602599
    603   SUBROUTINE Register_SwapField2d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    604   USE parallel_lmdz
    605   USE dimensions_mod
    606 
    607       IMPLICIT NONE
    608    
    609     TYPE(distrib),INTENT(IN)          :: new_dist
    610     TYPE(distrib),INTENT(IN) :: old_dist
    611     REAL, DIMENSION(old_dist%jjb_u:,:,:),INTENT(IN)     :: FieldS
    612     REAL, DIMENSION(new_dist%jjb_u:,:,:),INTENT(OUT)    :: FieldR
    613     INTEGER,OPTIONAL,INTENT(IN)       :: up
    614     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    615     TYPE(request),INTENT(INOUT)         :: a_request
    616 
    617     INTEGER                           :: halo_up
    618     INTEGER                           :: halo_down
    619     INTEGER                           :: ll
    620        
    621    
    622     halo_up=0
    623     halo_down=0
    624     IF (PRESENT(up))   halo_up=up
    625     IF (PRESENT(down)) halo_down=down
    626    
    627     ll=size(FieldS,3)
    628    
    629     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    630    
     600  SUBROUTINE Register_SwapField2d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     601    USE parallel_lmdz
     602    USE lmdz_dimensions
     603    USE lmdz_paramet
     604
     605    IMPLICIT NONE
     606
     607    TYPE(distrib), INTENT(IN) :: new_dist
     608    TYPE(distrib), INTENT(IN) :: old_dist
     609    REAL, DIMENSION(old_dist%jjb_u:, :, :), INTENT(IN) :: FieldS
     610    REAL, DIMENSION(new_dist%jjb_u:, :, :), INTENT(OUT) :: FieldR
     611    INTEGER, OPTIONAL, INTENT(IN) :: up
     612    INTEGER, OPTIONAL, INTENT(IN) :: down
     613    TYPE(request), INTENT(INOUT) :: a_request
     614
     615    INTEGER :: halo_up
     616    INTEGER :: halo_down
     617    INTEGER :: ll
     618
     619    halo_up = 0
     620    halo_down = 0
     621    IF (PRESENT(up))   halo_up = up
     622    IF (PRESENT(down)) halo_down = down
     623
     624    ll = size(FieldS, 3)
     625
     626    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     627
    631628  END SUBROUTINE  Register_SwapField2d_u2d_bis
    632    
    633 
    634   SUBROUTINE Register_SwapField3d_u2d(FieldS,FieldR,new_dist,a_request,up,down)
    635   USE parallel_lmdz
    636   USE dimensions_mod
    637       IMPLICIT NONE
    638    
    639     TYPE(distrib),INTENT(IN)          :: new_dist
    640     REAL, DIMENSION(current_dist%jjb_u:,:,:,:),INTENT(IN)     :: FieldS
    641     REAL, DIMENSION(new_dist%jjb_u:,:,:,:),INTENT(OUT)    :: FieldR
    642     INTEGER,OPTIONAL,INTENT(IN)       :: up
    643     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    644     TYPE(request),INTENT(INOUT)         :: a_request
    645 
    646     INTEGER                           :: halo_up
    647     INTEGER                           :: halo_down
    648     INTEGER                           :: ll
    649        
    650    
    651     halo_up=0
    652     halo_down=0
    653     IF (PRESENT(up))   halo_up=up
    654     IF (PRESENT(down)) halo_down=down
    655    
    656     ll=size(FieldS,3)*size(FieldS,4)
    657    
    658     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    659    
    660   END SUBROUTINE  Register_SwapField3d_u2d
    661 
    662   SUBROUTINE Register_SwapField3d_u2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    663   USE parallel_lmdz
    664   USE dimensions_mod
    665       IMPLICIT NONE
    666    
    667     TYPE(distrib),INTENT(IN)          :: new_dist
    668     TYPE(distrib),INTENT(IN) :: old_dist
    669     REAL, DIMENSION(old_dist%jjb_u:,:,:,:),INTENT(IN)     :: FieldS
    670     REAL, DIMENSION(new_dist%jjb_u:,:,:,:),INTENT(OUT)    :: FieldR
    671     INTEGER,OPTIONAL,INTENT(IN)       :: up
    672     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    673     TYPE(request),INTENT(INOUT)         :: a_request
    674 
    675     INTEGER                           :: halo_up
    676     INTEGER                           :: halo_down
    677     INTEGER                           :: ll
    678        
    679    
    680     halo_up=0
    681     halo_down=0
    682     IF (PRESENT(up))   halo_up=up
    683     IF (PRESENT(down)) halo_down=down
    684    
    685     ll=size(FieldS,3)*size(FieldS,4)
    686    
    687     CALL  Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    688    
    689   END SUBROUTINE  Register_SwapField3d_u2d_bis
    690 
    691 
    692 
    693 
    694 
    695 
    696 
    697   SUBROUTINE Register_SwapField1d_v(FieldS,FieldR,new_dist,a_request,up,down)
    698   USE parallel_lmdz
    699   USE dimensions_mod
    700       IMPLICIT NONE
    701    
    702     TYPE(distrib),INTENT(IN)          :: new_dist
    703     REAL, DIMENSION(current_dist%ijb_v:),INTENT(IN)     :: FieldS
    704     REAL, DIMENSION(new_dist%ijb_v:),INTENT(OUT)    :: FieldR
    705     INTEGER,OPTIONAL,INTENT(IN)       :: up
    706     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    707     TYPE(request),INTENT(INOUT)         :: a_request
    708 
    709     INTEGER                           :: halo_up
    710     INTEGER                           :: halo_down
    711    
    712    
    713     halo_up=0
    714     halo_down=0
    715     IF (PRESENT(up))   halo_up=up
    716     IF (PRESENT(down)) halo_down=down
    717 
    718     CALL  Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
    719        
    720   END SUBROUTINE  Register_SwapField1d_v
    721 
    722   SUBROUTINE Register_SwapField1d_v_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    723   USE parallel_lmdz
    724   USE dimensions_mod
    725       IMPLICIT NONE
    726    
    727     TYPE(distrib),INTENT(IN)          :: new_dist
    728     TYPE(distrib),INTENT(IN) :: old_dist
    729     REAL, DIMENSION(old_dist%ijb_v:),INTENT(IN)     :: FieldS
    730     REAL, DIMENSION(new_dist%ijb_v:),INTENT(OUT)    :: FieldR
    731     INTEGER,OPTIONAL,INTENT(IN)       :: up
    732     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    733     TYPE(request),INTENT(INOUT)         :: a_request
    734 
    735     INTEGER                           :: halo_up
    736     INTEGER                           :: halo_down
    737    
    738    
    739     halo_up=0
    740     halo_down=0
    741     IF (PRESENT(up))   halo_up=up
    742     IF (PRESENT(down)) halo_down=down
    743 
    744     CALL  Register_SwapField_gen_v(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
    745        
    746   END SUBROUTINE  Register_SwapField1d_v_bis
    747 
    748 
    749   SUBROUTINE Register_SwapField2d_v1d(FieldS,FieldR,new_dist,a_request,up,down)
    750   USE parallel_lmdz
    751   USE dimensions_mod
    752       IMPLICIT NONE
    753    
    754     TYPE(distrib),INTENT(IN)          :: new_dist
    755     REAL, DIMENSION(current_dist%ijb_v:,:),INTENT(IN)     :: FieldS
    756     REAL, DIMENSION(new_dist%ijb_v:,:),INTENT(OUT)    :: FieldR
    757     INTEGER,OPTIONAL,INTENT(IN)       :: up
    758     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    759     TYPE(request),INTENT(INOUT)         :: a_request
    760 
    761     INTEGER                           :: halo_up
    762     INTEGER                           :: halo_down
    763     INTEGER                           :: ll
    764        
    765    
    766     halo_up=0
    767     halo_down=0
    768     IF (PRESENT(up))   halo_up=up
    769     IF (PRESENT(down)) halo_down=down
    770    
    771     ll=size(FieldS,2)
    772    
    773     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    774    
     629
     630
     631  SUBROUTINE Register_SwapField3d_u2d(FieldS, FieldR, new_dist, a_request, up, down)
     632    USE parallel_lmdz
     633    USE lmdz_dimensions
     634    USE lmdz_paramet
     635    IMPLICIT NONE
     636
     637    TYPE(distrib), INTENT(IN) :: new_dist
     638    REAL, DIMENSION(current_dist%jjb_u:, :, :, :), INTENT(IN) :: FieldS
     639    REAL, DIMENSION(new_dist%jjb_u:, :, :, :), INTENT(OUT) :: FieldR
     640    INTEGER, OPTIONAL, INTENT(IN) :: up
     641    INTEGER, OPTIONAL, INTENT(IN) :: down
     642    TYPE(request), INTENT(INOUT) :: a_request
     643
     644    INTEGER :: halo_up
     645    INTEGER :: halo_down
     646    INTEGER :: ll
     647
     648    halo_up = 0
     649    halo_down = 0
     650    IF (PRESENT(up))   halo_up = up
     651    IF (PRESENT(down)) halo_down = down
     652
     653    ll = size(FieldS, 3) * size(FieldS, 4)
     654
     655    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     656
     657  END SUBROUTINE  Register_SwapField3d_u2d
     658
     659  SUBROUTINE Register_SwapField3d_u2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     660    USE parallel_lmdz
     661    USE lmdz_dimensions
     662    USE lmdz_paramet
     663    IMPLICIT NONE
     664
     665    TYPE(distrib), INTENT(IN) :: new_dist
     666    TYPE(distrib), INTENT(IN) :: old_dist
     667    REAL, DIMENSION(old_dist%jjb_u:, :, :, :), INTENT(IN) :: FieldS
     668    REAL, DIMENSION(new_dist%jjb_u:, :, :, :), INTENT(OUT) :: FieldR
     669    INTEGER, OPTIONAL, INTENT(IN) :: up
     670    INTEGER, OPTIONAL, INTENT(IN) :: down
     671    TYPE(request), INTENT(INOUT) :: a_request
     672
     673    INTEGER :: halo_up
     674    INTEGER :: halo_down
     675    INTEGER :: ll
     676
     677    halo_up = 0
     678    halo_down = 0
     679    IF (PRESENT(up))   halo_up = up
     680    IF (PRESENT(down)) halo_down = down
     681
     682    ll = size(FieldS, 3) * size(FieldS, 4)
     683
     684    CALL  Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     685
     686  END SUBROUTINE  Register_SwapField3d_u2d_bis
     687
     688
     689  SUBROUTINE Register_SwapField1d_v(FieldS, FieldR, new_dist, a_request, up, down)
     690    USE parallel_lmdz
     691    USE lmdz_dimensions
     692    USE lmdz_paramet
     693    IMPLICIT NONE
     694
     695    TYPE(distrib), INTENT(IN) :: new_dist
     696    REAL, DIMENSION(current_dist%ijb_v:), INTENT(IN) :: FieldS
     697    REAL, DIMENSION(new_dist%ijb_v:), INTENT(OUT) :: FieldR
     698    INTEGER, OPTIONAL, INTENT(IN) :: up
     699    INTEGER, OPTIONAL, INTENT(IN) :: down
     700    TYPE(request), INTENT(INOUT) :: a_request
     701
     702    INTEGER :: halo_up
     703    INTEGER :: halo_down
     704
     705    halo_up = 0
     706    halo_down = 0
     707    IF (PRESENT(up))   halo_up = up
     708    IF (PRESENT(down)) halo_down = down
     709
     710    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
     711
     712  END SUBROUTINE  Register_SwapField1d_v
     713
     714  SUBROUTINE Register_SwapField1d_v_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     715    USE parallel_lmdz
     716    USE lmdz_dimensions
     717    USE lmdz_paramet
     718    IMPLICIT NONE
     719
     720    TYPE(distrib), INTENT(IN) :: new_dist
     721    TYPE(distrib), INTENT(IN) :: old_dist
     722    REAL, DIMENSION(old_dist%ijb_v:), INTENT(IN) :: FieldS
     723    REAL, DIMENSION(new_dist%ijb_v:), INTENT(OUT) :: FieldR
     724    INTEGER, OPTIONAL, INTENT(IN) :: up
     725    INTEGER, OPTIONAL, INTENT(IN) :: down
     726    TYPE(request), INTENT(INOUT) :: a_request
     727
     728    INTEGER :: halo_up
     729    INTEGER :: halo_down
     730
     731    halo_up = 0
     732    halo_down = 0
     733    IF (PRESENT(up))   halo_up = up
     734    IF (PRESENT(down)) halo_down = down
     735
     736    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
     737
     738  END SUBROUTINE  Register_SwapField1d_v_bis
     739
     740
     741  SUBROUTINE Register_SwapField2d_v1d(FieldS, FieldR, new_dist, a_request, up, down)
     742    USE parallel_lmdz
     743    USE lmdz_dimensions
     744    USE lmdz_paramet
     745    IMPLICIT NONE
     746
     747    TYPE(distrib), INTENT(IN) :: new_dist
     748    REAL, DIMENSION(current_dist%ijb_v:, :), INTENT(IN) :: FieldS
     749    REAL, DIMENSION(new_dist%ijb_v:, :), INTENT(OUT) :: FieldR
     750    INTEGER, OPTIONAL, INTENT(IN) :: up
     751    INTEGER, OPTIONAL, INTENT(IN) :: down
     752    TYPE(request), INTENT(INOUT) :: a_request
     753
     754    INTEGER :: halo_up
     755    INTEGER :: halo_down
     756    INTEGER :: ll
     757
     758    halo_up = 0
     759    halo_down = 0
     760    IF (PRESENT(up))   halo_up = up
     761    IF (PRESENT(down)) halo_down = down
     762
     763    ll = size(FieldS, 2)
     764
     765    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     766
    775767  END SUBROUTINE  Register_SwapField2d_v1d
    776  
    777   SUBROUTINE Register_SwapField2d_v1d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    778   USE parallel_lmdz
    779   USE dimensions_mod
    780       IMPLICIT NONE
    781    
    782     TYPE(distrib),INTENT(IN)          :: new_dist
    783     TYPE(distrib),INTENT(IN)          :: old_dist
    784     REAL, DIMENSION(old_dist%ijb_v:,:),INTENT(IN)     :: FieldS
    785     REAL, DIMENSION(new_dist%ijb_v:,:),INTENT(OUT)    :: FieldR
    786     INTEGER,OPTIONAL,INTENT(IN)       :: up
    787     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    788     TYPE(request),INTENT(INOUT)         :: a_request
    789 
    790     INTEGER                           :: halo_up
    791     INTEGER                           :: halo_down
    792     INTEGER                           :: ll
    793        
    794    
    795     halo_up=0
    796     halo_down=0
    797     IF (PRESENT(up))   halo_up=up
    798     IF (PRESENT(down)) halo_down=down
    799    
    800     ll=size(FieldS,2)
    801    
    802     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    803    
     768
     769  SUBROUTINE Register_SwapField2d_v1d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     770    USE parallel_lmdz
     771    USE lmdz_dimensions
     772    USE lmdz_paramet
     773    IMPLICIT NONE
     774
     775    TYPE(distrib), INTENT(IN) :: new_dist
     776    TYPE(distrib), INTENT(IN) :: old_dist
     777    REAL, DIMENSION(old_dist%ijb_v:, :), INTENT(IN) :: FieldS
     778    REAL, DIMENSION(new_dist%ijb_v:, :), INTENT(OUT) :: FieldR
     779    INTEGER, OPTIONAL, INTENT(IN) :: up
     780    INTEGER, OPTIONAL, INTENT(IN) :: down
     781    TYPE(request), INTENT(INOUT) :: a_request
     782
     783    INTEGER :: halo_up
     784    INTEGER :: halo_down
     785    INTEGER :: ll
     786
     787    halo_up = 0
     788    halo_down = 0
     789    IF (PRESENT(up))   halo_up = up
     790    IF (PRESENT(down)) halo_down = down
     791
     792    ll = size(FieldS, 2)
     793
     794    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     795
    804796  END SUBROUTINE  Register_SwapField2d_v1d_bis
    805  
    806    
    807 
    808   SUBROUTINE Register_SwapField3d_v(FieldS,FieldR,new_dist,a_request,up,down)
    809   USE parallel_lmdz
    810   USE dimensions_mod
    811       IMPLICIT NONE
    812    
    813     TYPE(distrib),INTENT(IN)          :: new_dist
    814     REAL, DIMENSION(current_dist%ijb_v:,:,:),INTENT(IN)     :: FieldS
    815     REAL, DIMENSION(new_dist%ijb_v:,:,:),INTENT(OUT)    :: FieldR
    816     INTEGER,OPTIONAL,INTENT(IN)       :: up
    817     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    818     TYPE(request),INTENT(INOUT)         :: a_request
    819 
    820     INTEGER                           :: halo_up
    821     INTEGER                           :: halo_down
    822     INTEGER                           :: ll
    823        
    824    
    825     halo_up=0
    826     halo_down=0
    827     IF (PRESENT(up))   halo_up=up
    828     IF (PRESENT(down)) halo_down=down
    829    
    830     ll=size(FieldS,2)*size(FieldS,3)
    831    
    832     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    833    
    834   END SUBROUTINE  Register_SwapField3d_v
    835 
    836   SUBROUTINE Register_SwapField3d_v_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    837   USE parallel_lmdz
    838   USE dimensions_mod
    839       IMPLICIT NONE
    840    
    841     TYPE(distrib),INTENT(IN)          :: new_dist
    842     TYPE(distrib),INTENT(IN) :: old_dist
    843     REAL, DIMENSION(old_dist%ijb_v:,:,:),INTENT(IN)     :: FieldS
    844     REAL, DIMENSION(new_dist%ijb_v:,:,:),INTENT(OUT)    :: FieldR
    845     INTEGER,OPTIONAL,INTENT(IN)       :: up
    846     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    847     TYPE(request),INTENT(INOUT)         :: a_request
    848 
    849     INTEGER                           :: halo_up
    850     INTEGER                           :: halo_down
    851     INTEGER                           :: ll
    852        
    853    
    854     halo_up=0
    855     halo_down=0
    856     IF (PRESENT(up))   halo_up=up
    857     IF (PRESENT(down)) halo_down=down
    858    
    859     ll=size(FieldS,2)*size(FieldS,3)
    860    
    861     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    862    
    863   END SUBROUTINE  Register_SwapField3d_v_bis
    864 
    865 
    866 
    867 
    868   SUBROUTINE Register_SwapField1d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
    869   USE parallel_lmdz
    870   USE dimensions_mod
    871       IMPLICIT NONE
    872    
    873     TYPE(distrib),INTENT(IN)          :: new_dist !LF
    874     REAL, DIMENSION(current_dist%jjb_v:,:),INTENT(IN)     :: FieldS
    875     REAL, DIMENSION(new_dist%jjb_v:,:),INTENT(OUT)    :: FieldR
    876     INTEGER,OPTIONAL,INTENT(IN)       :: up
    877     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    878     TYPE(request),INTENT(INOUT)         :: a_request
    879 
    880     INTEGER                           :: halo_up
    881     INTEGER                           :: halo_down
    882    
    883    
    884     halo_up=0
    885     halo_down=0
    886     IF (PRESENT(up))   halo_up=up
    887     IF (PRESENT(down)) halo_down=down
    888 
    889     CALL  Register_SwapField_gen_v(FieldS,FieldR,1,current_dist,new_dist,halo_up,halo_down,a_request)
    890        
     797
     798
     799  SUBROUTINE Register_SwapField3d_v(FieldS, FieldR, new_dist, a_request, up, down)
     800    USE parallel_lmdz
     801    USE lmdz_dimensions
     802    USE lmdz_paramet
     803    IMPLICIT NONE
     804
     805    TYPE(distrib), INTENT(IN) :: new_dist
     806    REAL, DIMENSION(current_dist%ijb_v:, :, :), INTENT(IN) :: FieldS
     807    REAL, DIMENSION(new_dist%ijb_v:, :, :), INTENT(OUT) :: FieldR
     808    INTEGER, OPTIONAL, INTENT(IN) :: up
     809    INTEGER, OPTIONAL, INTENT(IN) :: down
     810    TYPE(request), INTENT(INOUT) :: a_request
     811
     812    INTEGER :: halo_up
     813    INTEGER :: halo_down
     814    INTEGER :: ll
     815
     816    halo_up = 0
     817    halo_down = 0
     818    IF (PRESENT(up))   halo_up = up
     819    IF (PRESENT(down)) halo_down = down
     820
     821    ll = size(FieldS, 2) * size(FieldS, 3)
     822
     823    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     824
     825  END SUBROUTINE  Register_SwapField3d_v
     826
     827  SUBROUTINE Register_SwapField3d_v_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     828    USE parallel_lmdz
     829    USE lmdz_dimensions
     830    USE lmdz_paramet
     831    IMPLICIT NONE
     832
     833    TYPE(distrib), INTENT(IN) :: new_dist
     834    TYPE(distrib), INTENT(IN) :: old_dist
     835    REAL, DIMENSION(old_dist%ijb_v:, :, :), INTENT(IN) :: FieldS
     836    REAL, DIMENSION(new_dist%ijb_v:, :, :), INTENT(OUT) :: FieldR
     837    INTEGER, OPTIONAL, INTENT(IN) :: up
     838    INTEGER, OPTIONAL, INTENT(IN) :: down
     839    TYPE(request), INTENT(INOUT) :: a_request
     840
     841    INTEGER :: halo_up
     842    INTEGER :: halo_down
     843    INTEGER :: ll
     844
     845    halo_up = 0
     846    halo_down = 0
     847    IF (PRESENT(up))   halo_up = up
     848    IF (PRESENT(down)) halo_down = down
     849
     850    ll = size(FieldS, 2) * size(FieldS, 3)
     851
     852    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     853
     854  END SUBROUTINE  Register_SwapField3d_v_bis
     855
     856
     857  SUBROUTINE Register_SwapField1d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
     858    USE parallel_lmdz
     859    USE lmdz_dimensions
     860    USE lmdz_paramet
     861    IMPLICIT NONE
     862
     863    TYPE(distrib), INTENT(IN) :: new_dist !LF
     864    REAL, DIMENSION(current_dist%jjb_v:, :), INTENT(IN) :: FieldS
     865    REAL, DIMENSION(new_dist%jjb_v:, :), INTENT(OUT) :: FieldR
     866    INTEGER, OPTIONAL, INTENT(IN) :: up
     867    INTEGER, OPTIONAL, INTENT(IN) :: down
     868    TYPE(request), INTENT(INOUT) :: a_request
     869
     870    INTEGER :: halo_up
     871    INTEGER :: halo_down
     872
     873    halo_up = 0
     874    halo_down = 0
     875    IF (PRESENT(up))   halo_up = up
     876    IF (PRESENT(down)) halo_down = down
     877
     878    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, current_dist, new_dist, halo_up, halo_down, a_request)
     879
    891880  END SUBROUTINE  Register_SwapField1d_v2d
    892881
    893   SUBROUTINE Register_SwapField1d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    894   USE parallel_lmdz
    895   USE dimensions_mod
    896       IMPLICIT NONE
    897    
    898     TYPE(distrib),INTENT(IN)          :: new_dist !LF
    899     TYPE(distrib),INTENT(IN) :: old_dist
    900     REAL, DIMENSION(old_dist%jjb_v:,:),INTENT(IN)     :: FieldS
    901     REAL, DIMENSION(new_dist%jjb_v:,:),INTENT(OUT)    :: FieldR
    902     INTEGER,OPTIONAL,INTENT(IN)       :: up
    903     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    904     TYPE(request),INTENT(INOUT)         :: a_request
    905 
    906     INTEGER                           :: halo_up
    907     INTEGER                           :: halo_down
    908    
    909    
    910     halo_up=0
    911     halo_down=0
    912     IF (PRESENT(up))   halo_up=up
    913     IF (PRESENT(down)) halo_down=down
    914 
    915     CALL  Register_SwapField_gen_v(FieldS,FieldR,1,old_dist,new_dist,halo_up,halo_down,a_request)
    916        
     882  SUBROUTINE Register_SwapField1d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     883    USE parallel_lmdz
     884    USE lmdz_dimensions
     885    USE lmdz_paramet
     886    IMPLICIT NONE
     887
     888    TYPE(distrib), INTENT(IN) :: new_dist !LF
     889    TYPE(distrib), INTENT(IN) :: old_dist
     890    REAL, DIMENSION(old_dist%jjb_v:, :), INTENT(IN) :: FieldS
     891    REAL, DIMENSION(new_dist%jjb_v:, :), INTENT(OUT) :: FieldR
     892    INTEGER, OPTIONAL, INTENT(IN) :: up
     893    INTEGER, OPTIONAL, INTENT(IN) :: down
     894    TYPE(request), INTENT(INOUT) :: a_request
     895
     896    INTEGER :: halo_up
     897    INTEGER :: halo_down
     898
     899    halo_up = 0
     900    halo_down = 0
     901    IF (PRESENT(up))   halo_up = up
     902    IF (PRESENT(down)) halo_down = down
     903
     904    CALL  Register_SwapField_gen_v(FieldS, FieldR, 1, old_dist, new_dist, halo_up, halo_down, a_request)
     905
    917906  END SUBROUTINE  Register_SwapField1d_v2d_bis
    918907
    919908
    920   SUBROUTINE Register_SwapField2d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
    921   USE parallel_lmdz
    922   USE dimensions_mod
    923       IMPLICIT NONE
    924    
    925     TYPE(distrib),INTENT(IN)          :: new_dist
    926     REAL, DIMENSION(current_dist%jjb_v:,:,:),INTENT(IN)     :: FieldS
    927     REAL, DIMENSION(new_dist%jjb_v:,:,:),INTENT(OUT)    :: FieldR
    928     INTEGER,OPTIONAL,INTENT(IN)       :: up
    929     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    930     TYPE(request),INTENT(INOUT)         :: a_request
    931 
    932     INTEGER                           :: halo_up
    933     INTEGER                           :: halo_down
    934     INTEGER                           :: ll
    935        
    936    
    937     halo_up=0
    938     halo_down=0
    939     IF (PRESENT(up))   halo_up=up
    940     IF (PRESENT(down)) halo_down=down
    941    
    942     ll=size(FieldS,3)
    943    
    944     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    945    
     909  SUBROUTINE Register_SwapField2d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
     910    USE parallel_lmdz
     911    USE lmdz_dimensions
     912    USE lmdz_paramet
     913    IMPLICIT NONE
     914
     915    TYPE(distrib), INTENT(IN) :: new_dist
     916    REAL, DIMENSION(current_dist%jjb_v:, :, :), INTENT(IN) :: FieldS
     917    REAL, DIMENSION(new_dist%jjb_v:, :, :), INTENT(OUT) :: FieldR
     918    INTEGER, OPTIONAL, INTENT(IN) :: up
     919    INTEGER, OPTIONAL, INTENT(IN) :: down
     920    TYPE(request), INTENT(INOUT) :: a_request
     921
     922    INTEGER :: halo_up
     923    INTEGER :: halo_down
     924    INTEGER :: ll
     925
     926    halo_up = 0
     927    halo_down = 0
     928    IF (PRESENT(up))   halo_up = up
     929    IF (PRESENT(down)) halo_down = down
     930
     931    ll = size(FieldS, 3)
     932
     933    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     934
    946935  END SUBROUTINE  Register_SwapField2d_v2d
    947    
    948   SUBROUTINE Register_SwapField2d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    949   USE parallel_lmdz
    950   USE dimensions_mod
    951       IMPLICIT NONE
    952    
    953     TYPE(distrib),INTENT(IN)          :: new_dist
    954     TYPE(distrib),INTENT(IN) :: old_dist
    955     REAL, DIMENSION(old_dist%jjb_v:,:,:),INTENT(IN)     :: FieldS
    956     REAL, DIMENSION(new_dist%jjb_v:,:,:),INTENT(OUT)    :: FieldR
    957     INTEGER,OPTIONAL,INTENT(IN)       :: up
    958     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    959     TYPE(request),INTENT(INOUT)         :: a_request
    960 
    961     INTEGER                           :: halo_up
    962     INTEGER                           :: halo_down
    963     INTEGER                           :: ll
    964        
    965    
    966     halo_up=0
    967     halo_down=0
    968     IF (PRESENT(up))   halo_up=up
    969     IF (PRESENT(down)) halo_down=down
    970    
    971     ll=size(FieldS,3)
    972    
    973     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    974    
     936
     937  SUBROUTINE Register_SwapField2d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     938    USE parallel_lmdz
     939    USE lmdz_dimensions
     940    USE lmdz_paramet
     941    IMPLICIT NONE
     942
     943    TYPE(distrib), INTENT(IN) :: new_dist
     944    TYPE(distrib), INTENT(IN) :: old_dist
     945    REAL, DIMENSION(old_dist%jjb_v:, :, :), INTENT(IN) :: FieldS
     946    REAL, DIMENSION(new_dist%jjb_v:, :, :), INTENT(OUT) :: FieldR
     947    INTEGER, OPTIONAL, INTENT(IN) :: up
     948    INTEGER, OPTIONAL, INTENT(IN) :: down
     949    TYPE(request), INTENT(INOUT) :: a_request
     950
     951    INTEGER :: halo_up
     952    INTEGER :: halo_down
     953    INTEGER :: ll
     954
     955    halo_up = 0
     956    halo_down = 0
     957    IF (PRESENT(up))   halo_up = up
     958    IF (PRESENT(down)) halo_down = down
     959
     960    ll = size(FieldS, 3)
     961
     962    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     963
    975964  END SUBROUTINE  Register_SwapField2d_v2d_bis
    976    
    977 
    978   SUBROUTINE Register_SwapField3d_v2d(FieldS,FieldR,new_dist,a_request,up,down)
    979   USE parallel_lmdz
    980   USE dimensions_mod
    981       IMPLICIT NONE
    982    
    983     TYPE(distrib),INTENT(IN)          :: new_dist
    984     REAL, DIMENSION(current_dist%jjb_v:,:,:,:),INTENT(IN)     :: FieldS
    985     REAL, DIMENSION(new_dist%jjb_v:,:,:,:),INTENT(OUT)    :: FieldR
    986     INTEGER,OPTIONAL,INTENT(IN)       :: up
    987     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    988     TYPE(request),INTENT(INOUT)         :: a_request
    989 
    990     INTEGER                           :: halo_up
    991     INTEGER                           :: halo_down
    992     INTEGER                           :: ll
    993        
    994    
    995     halo_up=0
    996     halo_down=0
    997     IF (PRESENT(up))   halo_up=up
    998     IF (PRESENT(down)) halo_down=down
    999    
    1000     ll=size(FieldS,3)*size(FieldS,4)
    1001    
    1002     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,current_dist,new_dist,halo_up,halo_down,a_request)
    1003    
    1004   END SUBROUTINE  Register_SwapField3d_v2d 
    1005  
    1006   SUBROUTINE Register_SwapField3d_v2d_bis(FieldS,FieldR,new_dist,a_request,old_dist,up,down)
    1007   USE parallel_lmdz
    1008   USE dimensions_mod
    1009       IMPLICIT NONE
    1010    
    1011     TYPE(distrib),INTENT(IN)          :: new_dist
    1012     TYPE(distrib),INTENT(IN) :: old_dist
    1013     REAL, DIMENSION(old_dist%jjb_v:,:,:,:),INTENT(IN)     :: FieldS
    1014     REAL, DIMENSION(new_dist%jjb_v:,:,:,:),INTENT(OUT)    :: FieldR
    1015     INTEGER,OPTIONAL,INTENT(IN)       :: up
    1016     INTEGER,OPTIONAL,INTENT(IN)       :: down     
    1017     TYPE(request),INTENT(INOUT)         :: a_request
    1018 
    1019     INTEGER                           :: halo_up
    1020     INTEGER                           :: halo_down
    1021     INTEGER                           :: ll
    1022        
    1023    
    1024     halo_up=0
    1025     halo_down=0
    1026     IF (PRESENT(up))   halo_up=up
    1027     IF (PRESENT(down)) halo_down=down
    1028    
    1029     ll=size(FieldS,3)*size(FieldS,4)
    1030    
    1031     CALL  Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,halo_up,halo_down,a_request)
    1032    
    1033   END SUBROUTINE  Register_SwapField3d_v2d_bis 
    1034  
    1035  
    1036 
    1037   SUBROUTINE Register_SwapField_gen_u(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
    1038   USE parallel_lmdz
    1039   USE dimensions_mod
    1040       IMPLICIT NONE
    1041    
    1042     INTEGER :: ll,Up,Down
    1043     TYPE(distrib)  :: old_dist
    1044     TYPE(distrib)  :: new_dist
    1045     REAL, DIMENSION(old_dist%ijb_u:old_dist%ije_u,ll) :: FieldS
    1046     REAL, DIMENSION(new_dist%ijb_u:new_dist%ije_u,ll) :: FieldR
     965
     966
     967  SUBROUTINE Register_SwapField3d_v2d(FieldS, FieldR, new_dist, a_request, up, down)
     968    USE parallel_lmdz
     969    USE lmdz_dimensions
     970    USE lmdz_paramet
     971    IMPLICIT NONE
     972
     973    TYPE(distrib), INTENT(IN) :: new_dist
     974    REAL, DIMENSION(current_dist%jjb_v:, :, :, :), INTENT(IN) :: FieldS
     975    REAL, DIMENSION(new_dist%jjb_v:, :, :, :), INTENT(OUT) :: FieldR
     976    INTEGER, OPTIONAL, INTENT(IN) :: up
     977    INTEGER, OPTIONAL, INTENT(IN) :: down
     978    TYPE(request), INTENT(INOUT) :: a_request
     979
     980    INTEGER :: halo_up
     981    INTEGER :: halo_down
     982    INTEGER :: ll
     983
     984    halo_up = 0
     985    halo_down = 0
     986    IF (PRESENT(up))   halo_up = up
     987    IF (PRESENT(down)) halo_down = down
     988
     989    ll = size(FieldS, 3) * size(FieldS, 4)
     990
     991    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, current_dist, new_dist, halo_up, halo_down, a_request)
     992
     993  END SUBROUTINE  Register_SwapField3d_v2d
     994
     995  SUBROUTINE Register_SwapField3d_v2d_bis(FieldS, FieldR, new_dist, a_request, old_dist, up, down)
     996    USE parallel_lmdz
     997    USE lmdz_dimensions
     998    USE lmdz_paramet
     999    IMPLICIT NONE
     1000
     1001    TYPE(distrib), INTENT(IN) :: new_dist
     1002    TYPE(distrib), INTENT(IN) :: old_dist
     1003    REAL, DIMENSION(old_dist%jjb_v:, :, :, :), INTENT(IN) :: FieldS
     1004    REAL, DIMENSION(new_dist%jjb_v:, :, :, :), INTENT(OUT) :: FieldR
     1005    INTEGER, OPTIONAL, INTENT(IN) :: up
     1006    INTEGER, OPTIONAL, INTENT(IN) :: down
     1007    TYPE(request), INTENT(INOUT) :: a_request
     1008
     1009    INTEGER :: halo_up
     1010    INTEGER :: halo_down
     1011    INTEGER :: ll
     1012
     1013    halo_up = 0
     1014    halo_down = 0
     1015    IF (PRESENT(up))   halo_up = up
     1016    IF (PRESENT(down)) halo_down = down
     1017
     1018    ll = size(FieldS, 3) * size(FieldS, 4)
     1019
     1020    CALL  Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, halo_up, halo_down, a_request)
     1021
     1022  END SUBROUTINE  Register_SwapField3d_v2d_bis
     1023
     1024
     1025  SUBROUTINE Register_SwapField_gen_u(FieldS, FieldR, ll, old_dist, new_dist, Up, Down, a_request)
     1026    USE parallel_lmdz
     1027    USE lmdz_dimensions
     1028    USE lmdz_paramet
     1029    IMPLICIT NONE
     1030
     1031    INTEGER :: ll, Up, Down
     1032    TYPE(distrib) :: old_dist
     1033    TYPE(distrib) :: new_dist
     1034    REAL, DIMENSION(old_dist%ijb_u:old_dist%ije_u, ll) :: FieldS
     1035    REAL, DIMENSION(new_dist%ijb_u:new_dist%ije_u, ll) :: FieldR
    10471036    TYPE(request) :: a_request
    1048     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New   
    1049     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    1050    
    1051     INTEGER ::i,l,jje,jjb,ijb,ije
    1052    
    1053     DO i=0,MPI_Size-1
    1054       jj_begin_New(i)=max(1,new_dist%jj_begin_para(i)-Up)
    1055       jj_end_New(i)=min(jjp1,new_dist%jj_end_para(i)+Down)
     1037    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
     1038    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
     1039
     1040    INTEGER :: i, l, jje, jjb, ijb, ije
     1041
     1042    DO i = 0, MPI_Size - 1
     1043      jj_begin_New(i) = max(1, new_dist%jj_begin_para(i) - Up)
     1044      jj_end_New(i) = min(jjp1, new_dist%jj_end_para(i) + Down)
    10561045    ENDDO
    1057    
    1058     DO i=0,MPI_Size-1
     1046
     1047    DO i = 0, MPI_Size - 1
    10591048      IF (i /= MPI_Rank) THEN
    1060         jjb=max(jj_begin_new(i),old_dist%jj_begin)
    1061         jje=min(jj_end_new(i),old_dist%jj_end)
    1062        
     1049        jjb = max(jj_begin_new(i), old_dist%jj_begin)
     1050        jje = min(jj_end_new(i), old_dist%jj_end)
     1051
    10631052        IF (jje >= jjb) THEN
    1064           CALL Register_SendField(FieldS,old_dist%ijnb_u,ll,jjb-old_dist%jjb_u+1,jje-jjb+1,i,a_request)
     1053          CALL Register_SendField(FieldS, old_dist%ijnb_u, ll, jjb - old_dist%jjb_u + 1, jje - jjb + 1, i, a_request)
    10651054        ENDIF
    1066        
    1067         jjb=max(jj_begin_new(MPI_Rank),old_dist%jj_begin_Para(i))
    1068         jje=min(jj_end_new(MPI_Rank),old_dist%jj_end_Para(i))
    1069        
     1055
     1056        jjb = max(jj_begin_new(MPI_Rank), old_dist%jj_begin_Para(i))
     1057        jje = min(jj_end_new(MPI_Rank), old_dist%jj_end_Para(i))
     1058
    10701059        IF (jje >= jjb) THEN
    1071           CALL Register_RecvField(FieldR,new_dist%ijnb_u,ll,jjb-new_dist%jjb_u+1,jje-jjb+1,i,a_request)
     1060          CALL Register_RecvField(FieldR, new_dist%ijnb_u, ll, jjb - new_dist%jjb_u + 1, jje - jjb + 1, i, a_request)
    10721061        ENDIF
    10731062      ELSE
    1074         jjb=max(jj_begin_new(i),old_dist%jj_begin)
    1075         jje=min(jj_end_new(i),old_dist%jj_end)
    1076         ijb=(jjb-1)*iip1+1
    1077         ije=jje*iip1
    1078 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    1079         DO l=1,ll
    1080           FieldR(ijb:ije,l)=FieldS(ijb:ije,l)             
     1063        jjb = max(jj_begin_new(i), old_dist%jj_begin)
     1064        jje = min(jj_end_new(i), old_dist%jj_end)
     1065        ijb = (jjb - 1) * iip1 + 1
     1066        ije = jje * iip1
     1067        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1068        DO l = 1, ll
     1069          FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
    10811070        ENDDO
    1082 !$OMP END DO NOWAIT
     1071        !$OMP END DO NOWAIT
    10831072      ENDIF
    10841073    ENDDO
    1085    
     1074
    10861075  END SUBROUTINE Register_SwapField_gen_u
    10871076
    10881077
    1089 
    1090   SUBROUTINE Register_SwapField_gen_v(FieldS,FieldR,ll,old_dist,new_dist,Up,Down,a_request)
    1091   USE parallel_lmdz
    1092   USE dimensions_mod
    1093     IMPLICIT NONE
    1094    
    1095     INTEGER :: ll,Up,Down
    1096     TYPE(distrib)  :: old_dist
    1097     TYPE(distrib)  :: new_dist
    1098     REAL, DIMENSION(old_dist%ijb_v:old_dist%ije_v,ll) :: FieldS
    1099     REAL, DIMENSION(new_dist%ijb_v:new_dist%ije_v,ll) :: FieldR
     1078  SUBROUTINE Register_SwapField_gen_v(FieldS, FieldR, ll, old_dist, new_dist, Up, Down, a_request)
     1079    USE parallel_lmdz
     1080    USE lmdz_dimensions
     1081    USE lmdz_paramet
     1082    IMPLICIT NONE
     1083
     1084    INTEGER :: ll, Up, Down
     1085    TYPE(distrib) :: old_dist
     1086    TYPE(distrib) :: new_dist
     1087    REAL, DIMENSION(old_dist%ijb_v:old_dist%ije_v, ll) :: FieldS
     1088    REAL, DIMENSION(new_dist%ijb_v:new_dist%ije_v, ll) :: FieldR
    11001089    TYPE(request) :: a_request
    1101     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New   
    1102     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    1103    
    1104     INTEGER ::i,l,jje,jjb,ijb,ije
    1105    
    1106     DO i=0,MPI_Size-1
    1107       jj_begin_New(i)=max(1,new_dist%jj_begin_para(i)-Up)
    1108       jj_end_New(i)=min(jjp1,new_dist%jj_end_para(i)+Down)
     1090    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
     1091    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
     1092
     1093    INTEGER :: i, l, jje, jjb, ijb, ije
     1094
     1095    DO i = 0, MPI_Size - 1
     1096      jj_begin_New(i) = max(1, new_dist%jj_begin_para(i) - Up)
     1097      jj_end_New(i) = min(jjp1, new_dist%jj_end_para(i) + Down)
    11091098    ENDDO
    1110    
    1111     DO i=0,MPI_Size-1
     1099
     1100    DO i = 0, MPI_Size - 1
    11121101      IF (i /= MPI_Rank) THEN
    1113         jjb=max(jj_begin_new(i),old_dist%jj_begin)
    1114         jje=min(jj_end_new(i),old_dist%jj_end)
    1115 
    1116         IF (jje==jjp1) jje=jjm       
     1102        jjb = max(jj_begin_new(i), old_dist%jj_begin)
     1103        jje = min(jj_end_new(i), old_dist%jj_end)
     1104
     1105        IF (jje==jjp1) jje = jjm
    11171106
    11181107        IF (jje >= jjb) THEN
    1119           CALL Register_SendField(FieldS,old_dist%ijnb_v,ll,jjb-old_dist%jjb_v+1,jje-jjb+1,i,a_request)
     1108          CALL Register_SendField(FieldS, old_dist%ijnb_v, ll, jjb - old_dist%jjb_v + 1, jje - jjb + 1, i, a_request)
    11201109        ENDIF
    1121        
    1122         jjb=max(jj_begin_new(MPI_Rank),old_dist%jj_begin_Para(i))
    1123         jje=min(jj_end_new(MPI_Rank),old_dist%jj_end_Para(i))
    1124 
    1125         IF (jje==jjp1) jje=jjm
    1126        
     1110
     1111        jjb = max(jj_begin_new(MPI_Rank), old_dist%jj_begin_Para(i))
     1112        jje = min(jj_end_new(MPI_Rank), old_dist%jj_end_Para(i))
     1113
     1114        IF (jje==jjp1) jje = jjm
     1115
    11271116        IF (jje >= jjb) THEN
    1128           CALL Register_RecvField(FieldR,new_dist%ijnb_v,ll,jjb-new_dist%jjb_v+1,jje-jjb+1,i,a_request)
     1117          CALL Register_RecvField(FieldR, new_dist%ijnb_v, ll, jjb - new_dist%jjb_v + 1, jje - jjb + 1, i, a_request)
    11291118        ENDIF
    11301119      ELSE
    1131         jjb=max(jj_begin_new(i),old_dist%jj_begin)
    1132         jje=min(jj_end_new(i),old_dist%jj_end)
    1133         IF (jje==jjp1) jje=jjm
    1134         ijb=(jjb-1)*iip1+1
    1135         ije=jje*iip1
    1136 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    1137         DO l=1,ll
    1138           FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
    1139         ENDDO             
    1140 !$OMP END DO NOWAIT
     1120        jjb = max(jj_begin_new(i), old_dist%jj_begin)
     1121        jje = min(jj_end_new(i), old_dist%jj_end)
     1122        IF (jje==jjp1) jje = jjm
     1123        ijb = (jjb - 1) * iip1 + 1
     1124        ije = jje * iip1
     1125        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1126        DO l = 1, ll
     1127          FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
     1128        ENDDO
     1129        !$OMP END DO NOWAIT
    11411130      ENDIF
    11421131    ENDDO
    1143    
     1132
    11441133  END SUBROUTINE Register_SwapField_gen_v
    11451134
    11461135
    1147  
    1148 
    1149  
    1150   SUBROUTINE Register_Hallo(Field,ij,ll,RUp,Rdown,SUp,SDown,a_request)
    1151   USE dimensions_mod
    1152   USE lmdz_mpi
    1153       IMPLICIT NONE
    1154 
    1155       INTEGER :: ij,ll
    1156       REAL, DIMENSION(ij,ll) :: Field
    1157       INTEGER :: Sup,Sdown,rup,rdown
    1158       type(request) :: a_request
    1159       type(Hallo),pointer :: PtrHallo
    1160       LOGICAL :: SendUp,SendDown
    1161       LOGICAL :: RecvUp,RecvDown
    1162    
    1163  
    1164       SendUp=.TRUE.
    1165       SendDown=.TRUE.
    1166       RecvUp=.TRUE.
    1167       RecvDown=.TRUE.
    1168        
    1169       IF (pole_nord) THEN
    1170         SendUp=.FALSE.
    1171         RecvUp=.FALSE.
    1172       ENDIF
    1173  
    1174       IF (pole_sud) THEN
    1175         SendDown=.FALSE.
    1176         RecvDown=.FALSE.
    1177       ENDIF
    1178      
    1179       IF (Sup==0) THEN
    1180         SendUp=.FALSE.
    1181        endif
    1182      
    1183       IF (Sdown==0) THEN
    1184         SendDown=.FALSE.
     1136  SUBROUTINE Register_Hallo(Field, ij, ll, RUp, Rdown, SUp, SDown, a_request)
     1137    USE lmdz_dimensions
     1138    USE lmdz_paramet
     1139    USE lmdz_mpi
     1140    IMPLICIT NONE
     1141
     1142    INTEGER :: ij, ll
     1143    REAL, DIMENSION(ij, ll) :: Field
     1144    INTEGER :: Sup, Sdown, rup, rdown
     1145    type(request) :: a_request
     1146    type(Hallo), pointer :: PtrHallo
     1147    LOGICAL :: SendUp, SendDown
     1148    LOGICAL :: RecvUp, RecvDown
     1149
     1150    SendUp = .TRUE.
     1151    SendDown = .TRUE.
     1152    RecvUp = .TRUE.
     1153    RecvDown = .TRUE.
     1154
     1155    IF (pole_nord) THEN
     1156      SendUp = .FALSE.
     1157      RecvUp = .FALSE.
     1158    ENDIF
     1159
     1160    IF (pole_sud) THEN
     1161      SendDown = .FALSE.
     1162      RecvDown = .FALSE.
     1163    ENDIF
     1164
     1165    IF (Sup==0) THEN
     1166      SendUp = .FALSE.
     1167    endif
     1168
     1169    IF (Sdown==0) THEN
     1170      SendDown = .FALSE.
     1171    endif
     1172
     1173    IF (Rup==0) THEN
     1174      RecvUp = .FALSE.
     1175    endif
     1176
     1177    IF (Rdown==0) THEN
     1178      RecvDown = .FALSE.
     1179    endif
     1180
     1181    IF (SendUp) THEN
     1182      CALL Register_SendField(Field, ij, ll, jj_begin, SUp, MPI_Rank - 1, a_request)
     1183    ENDIF
     1184
     1185    IF (SendDown) THEN
     1186      CALL Register_SendField(Field, ij, ll, jj_end - SDown + 1, SDown, MPI_Rank + 1, a_request)
     1187    ENDIF
     1188
     1189    IF (RecvUp) THEN
     1190      CALL Register_RecvField(Field, ij, ll, jj_begin - Rup, RUp, MPI_Rank - 1, a_request)
     1191    ENDIF
     1192
     1193    IF (RecvDown) THEN
     1194      CALL Register_RecvField(Field, ij, ll, jj_end + 1, RDown, MPI_Rank + 1, a_request)
     1195    ENDIF
     1196
     1197  END SUBROUTINE  Register_Hallo
     1198
     1199
     1200  SUBROUTINE Register_Hallo_u(Field, ll, RUp, Rdown, SUp, SDown, a_request)
     1201    USE lmdz_dimensions
     1202    USE lmdz_paramet
     1203    USE lmdz_mpi
     1204    IMPLICIT NONE
     1205    INTEGER :: ll
     1206    REAL, DIMENSION(ijb_u:ije_u, ll) :: Field
     1207    INTEGER :: Sup, Sdown, rup, rdown
     1208    type(request) :: a_request
     1209    type(Hallo), pointer :: PtrHallo
     1210    LOGICAL :: SendUp, SendDown
     1211    LOGICAL :: RecvUp, RecvDown
     1212
     1213    SendUp = .TRUE.
     1214    SendDown = .TRUE.
     1215    RecvUp = .TRUE.
     1216    RecvDown = .TRUE.
     1217
     1218    IF (pole_nord) THEN
     1219      SendUp = .FALSE.
     1220      RecvUp = .FALSE.
     1221    ENDIF
     1222
     1223    IF (pole_sud) THEN
     1224      SendDown = .FALSE.
     1225      RecvDown = .FALSE.
     1226    ENDIF
     1227
     1228    IF (Sup==0) THEN
     1229      SendUp = .FALSE.
     1230    endif
     1231
     1232    IF (Sdown==0) THEN
     1233      SendDown = .FALSE.
     1234    endif
     1235
     1236    IF (Rup==0) THEN
     1237      RecvUp = .FALSE.
     1238    endif
     1239
     1240    IF (Rdown==0) THEN
     1241      RecvDown = .FALSE.
     1242    endif
     1243
     1244    IF (SendUp) THEN
     1245      CALL Register_SendField(Field, ijnb_u, ll, jj_begin - jjb_u + 1, SUp, MPI_Rank - 1, a_request)
     1246    ENDIF
     1247
     1248    IF (SendDown) THEN
     1249      CALL Register_SendField(Field, ijnb_u, ll, jj_end - SDown + 1 - jjb_u + 1, SDown, MPI_Rank + 1, a_request)
     1250    ENDIF
     1251
     1252    IF (RecvUp) THEN
     1253      CALL Register_RecvField(Field, ijnb_u, ll, jj_begin - Rup - jjb_u + 1, RUp, MPI_Rank - 1, a_request)
     1254    ENDIF
     1255
     1256    IF (RecvDown) THEN
     1257      CALL Register_RecvField(Field, ijnb_u, ll, jj_end + 1 - jjb_u + 1, RDown, MPI_Rank + 1, a_request)
     1258    ENDIF
     1259
     1260  END SUBROUTINE  Register_Hallo_u
     1261
     1262  SUBROUTINE Register_Hallo_v(Field, ll, RUp, Rdown, SUp, SDown, a_request)
     1263    USE lmdz_dimensions
     1264    USE lmdz_paramet
     1265    USE lmdz_mpi
     1266    IMPLICIT NONE
     1267    INTEGER :: ll
     1268    REAL, DIMENSION(ijb_v:ije_v, ll) :: Field
     1269    INTEGER :: Sup, Sdown, rup, rdown
     1270    type(request) :: a_request
     1271    type(Hallo), pointer :: PtrHallo
     1272    LOGICAL :: SendUp, SendDown
     1273    LOGICAL :: RecvUp, RecvDown
     1274
     1275    SendUp = .TRUE.
     1276    SendDown = .TRUE.
     1277    RecvUp = .TRUE.
     1278    RecvDown = .TRUE.
     1279
     1280    IF (pole_nord) THEN
     1281      SendUp = .FALSE.
     1282      RecvUp = .FALSE.
     1283    ENDIF
     1284
     1285    IF (pole_sud) THEN
     1286      SendDown = .FALSE.
     1287      RecvDown = .FALSE.
     1288    ENDIF
     1289
     1290    IF (Sup==0) THEN
     1291      SendUp = .FALSE.
     1292    endif
     1293
     1294    IF (Sdown==0) THEN
     1295      SendDown = .FALSE.
     1296    endif
     1297
     1298    IF (Rup==0) THEN
     1299      RecvUp = .FALSE.
     1300    endif
     1301
     1302    IF (Rdown==0) THEN
     1303      RecvDown = .FALSE.
     1304    endif
     1305
     1306    IF (SendUp) THEN
     1307      CALL Register_SendField(Field, ijnb_v, ll, jj_begin - jjb_v + 1, SUp, MPI_Rank - 1, a_request)
     1308    ENDIF
     1309
     1310    IF (SendDown) THEN
     1311      CALL Register_SendField(Field, ijnb_v, ll, jj_end - SDown + 1 - jjb_v + 1, SDown, MPI_Rank + 1, a_request)
     1312    ENDIF
     1313
     1314    IF (RecvUp) THEN
     1315      CALL Register_RecvField(Field, ijnb_v, ll, jj_begin - Rup - jjb_v + 1, RUp, MPI_Rank - 1, a_request)
     1316    ENDIF
     1317
     1318    IF (RecvDown) THEN
     1319      CALL Register_RecvField(Field, ijnb_v, ll, jj_end + 1 - jjb_v + 1, RDown, MPI_Rank + 1, a_request)
     1320    ENDIF
     1321
     1322  END SUBROUTINE  Register_Hallo_v
     1323
     1324  SUBROUTINE SendRequest(a_Request)
     1325    USE lmdz_dimensions
     1326    USE lmdz_paramet
     1327    USE lmdz_mpi
     1328    IMPLICIT NONE
     1329
     1330    type(request), target :: a_request
     1331    type(request_SR), pointer :: Req
     1332    type(Hallo), pointer :: PtrHallo
     1333    INTEGER :: SizeBuffer
     1334    INTEGER :: i, rank, l, ij, Pos, ierr
     1335    INTEGER :: offset
     1336    REAL, DIMENSION(:, :), pointer :: Field
     1337    INTEGER :: Nb
     1338
     1339    DO rank = 0, MPI_SIZE - 1
     1340
     1341      Req => a_Request%RequestSend(rank)
     1342
     1343      SizeBuffer = 0
     1344      DO i = 1, Req%NbRequest
     1345        PtrHallo => Req%Hallo(i)
     1346        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1347        DO l = 1, PtrHallo%NbLevel
     1348          SizeBuffer = SizeBuffer + PtrHallo%size * iip1
     1349        ENDDO
     1350        !$OMP ENDDO NOWAIT
     1351      enddo
     1352
     1353      Req%BufferSize = SizeBuffer
     1354      IF (Req%NbRequest>0) THEN
     1355        CALL allocate_buffer(SizeBuffer, Req%Index, Req%pos)
     1356
     1357        Pos = Req%Pos
     1358        DO i = 1, Req%NbRequest
     1359          PtrHallo => Req%Hallo(i)
     1360          offset = (PtrHallo%offset - 1) * iip1 + 1
     1361          Nb = iip1 * PtrHallo%size - 1
     1362          Field => PtrHallo%Field
     1363
     1364          !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1365          DO l = 1, PtrHallo%NbLevel
     1366            !cdir NODEP
     1367            DO ij = 0, Nb
     1368              Buffer(Pos + ij) = Field(Offset + ij, l)
     1369            enddo
     1370
     1371            Pos = Pos + Nb + 1
     1372          enddo
     1373          !$OMP END DO NOWAIT
     1374        enddo
     1375
     1376        IF (SizeBuffer>0) THEN
     1377          !$OMP CRITICAL (MPI)
     1378
     1379          CALL MPI_ISEND(Buffer(req%Pos), SizeBuffer, MPI_REAL_LMDZ, rank, a_request%tag + 1000 * omp_rank, &
     1380                  COMM_LMDZ, Req%MSG_Request, ierr)
     1381          IF (.NOT.using_mpi) THEN
     1382            PRINT *, 'Erreur, echange MPI en mode sequentiel !!!'
     1383            CALL abort_gcm("mod_hallo", "stopped", 1)
     1384          ENDIF
     1385          !         PRINT *,"-------------------------------------------------------------------"
     1386          !         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
     1387          !         PRINT *,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000*omp_rank
     1388          !         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
     1389          !         PRINT *,"-------------------------------------------------------------------"
     1390          !$OMP END CRITICAL (MPI)
     1391        endif
    11851392      endif
    1186 
    1187       IF (Rup==0) THEN
    1188         RecvUp=.FALSE.
     1393    enddo
     1394
     1395    DO rank = 0, MPI_SIZE - 1
     1396
     1397      Req => a_Request%RequestRecv(rank)
     1398      SizeBuffer = 0
     1399
     1400      DO i = 1, Req%NbRequest
     1401        PtrHallo => Req%Hallo(i)
     1402
     1403        !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1404        DO l = 1, PtrHallo%NbLevel
     1405          SizeBuffer = SizeBuffer + PtrHallo%size * iip1
     1406        ENDDO
     1407        !$OMP ENDDO NOWAIT
     1408      enddo
     1409
     1410      Req%BufferSize = SizeBuffer
     1411
     1412      IF (Req%NbRequest>0) THEN
     1413        CALL allocate_buffer(SizeBuffer, Req%Index, Req%Pos)
     1414
     1415        IF (SizeBuffer>0) THEN
     1416          !$OMP CRITICAL (MPI)
     1417
     1418          CALL MPI_IRECV(Buffer(Req%Pos), SizeBuffer, MPI_REAL_LMDZ, rank, a_request%tag + 1000 * omp_rank, &
     1419                  COMM_LMDZ, Req%MSG_Request, ierr)
     1420
     1421          IF (.NOT.using_mpi) THEN
     1422            PRINT *, 'Erreur, echange MPI en mode sequentiel !!!'
     1423            CALL abort_gcm("mod_hallo", "stopped", 1)
     1424          ENDIF
     1425
     1426          !         PRINT *,"-------------------------------------------------------------------"
     1427          !         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
     1428          !         PRINT *,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000*omp_rank
     1429          !         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
     1430          !         PRINT *,"-------------------------------------------------------------------"
     1431
     1432          !$OMP END CRITICAL (MPI)
     1433        endif
    11891434      endif
    1190      
    1191       IF (Rdown==0) THEN
    1192         RecvDown=.FALSE.
     1435
     1436    enddo
     1437
     1438  END SUBROUTINE  SendRequest
     1439
     1440  SUBROUTINE WaitRequest(a_Request)
     1441    USE lmdz_dimensions
     1442    USE lmdz_paramet
     1443    USE lmdz_mpi
     1444    IMPLICIT NONE
     1445
     1446    type(request), target :: a_request
     1447    type(request_SR), pointer :: Req
     1448    type(Hallo), pointer :: PtrHallo
     1449    INTEGER, DIMENSION(2 * mpi_size) :: TabRequest
     1450    INTEGER, DIMENSION(MPI_STATUS_SIZE, 2 * mpi_size) :: TabStatus
     1451    INTEGER :: NbRequest
     1452    INTEGER :: i, rank, pos, ij, l, ierr
     1453    INTEGER :: offset
     1454    INTEGER :: Nb
     1455
     1456    NbRequest = 0
     1457    DO rank = 0, MPI_SIZE - 1
     1458      Req => a_request%RequestSend(rank)
     1459      IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
     1460        NbRequest = NbRequest + 1
     1461        TabRequest(NbRequest) = Req%MSG_Request
    11931462      endif
    1194      
    1195       IF (SendUp) THEN
    1196         CALL Register_SendField(Field,ij,ll,jj_begin,SUp,MPI_Rank-1,a_request)
    1197       ENDIF
    1198  
    1199       IF (SendDown) THEN
    1200         CALL Register_SendField(Field,ij,ll,jj_end-SDown+1,SDown,MPI_Rank+1,a_request)
    1201       ENDIF
    1202    
    1203  
    1204       IF (RecvUp) THEN
    1205         CALL Register_RecvField(Field,ij,ll,jj_begin-Rup,RUp,MPI_Rank-1,a_request)
    1206       ENDIF
    1207  
    1208       IF (RecvDown) THEN
    1209         CALL Register_RecvField(Field,ij,ll,jj_end+1,RDown,MPI_Rank+1,a_request)
    1210       ENDIF
    1211  
    1212     END SUBROUTINE  Register_Hallo
    1213 
    1214 
    1215   SUBROUTINE Register_Hallo_u(Field,ll,RUp,Rdown,SUp,SDown,a_request)
    1216   USE dimensions_mod
    1217   USE lmdz_mpi
    1218       IMPLICIT NONE
    1219       INTEGER :: ll
    1220       REAL, DIMENSION(ijb_u:ije_u,ll) :: Field
    1221       INTEGER :: Sup,Sdown,rup,rdown
    1222       type(request) :: a_request
    1223       type(Hallo),pointer :: PtrHallo
    1224       LOGICAL :: SendUp,SendDown
    1225       LOGICAL :: RecvUp,RecvDown
    1226    
    1227  
    1228       SendUp=.TRUE.
    1229       SendDown=.TRUE.
    1230       RecvUp=.TRUE.
    1231       RecvDown=.TRUE.
    1232        
    1233       IF (pole_nord) THEN
    1234         SendUp=.FALSE.
    1235         RecvUp=.FALSE.
    1236       ENDIF
    1237  
    1238       IF (pole_sud) THEN
    1239         SendDown=.FALSE.
    1240         RecvDown=.FALSE.
    1241       ENDIF
    1242      
    1243       IF (Sup==0) THEN
    1244         SendUp=.FALSE.
    1245        endif
    1246      
    1247       IF (Sdown==0) THEN
    1248         SendDown=.FALSE.
     1463    enddo
     1464
     1465    DO rank = 0, MPI_SIZE - 1
     1466      Req => a_request%RequestRecv(rank)
     1467      IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
     1468        NbRequest = NbRequest + 1
     1469        TabRequest(NbRequest) = Req%MSG_Request
    12491470      endif
    1250 
    1251       IF (Rup==0) THEN
    1252         RecvUp=.FALSE.
     1471    enddo
     1472
     1473    IF (NbRequest>0) THEN
     1474      !$OMP CRITICAL (MPI)
     1475      !        PRINT *,"-------------------------------------------------------------------"
     1476      !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
     1477      !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
     1478      CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
     1479      !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
     1480      !        PRINT *,"-------------------------------------------------------------------"
     1481      !$OMP END CRITICAL (MPI)
     1482    endif
     1483    DO rank = 0, MPI_Size - 1
     1484      Req => a_request%RequestRecv(rank)
     1485      IF (Req%NbRequest>0) THEN
     1486        Pos = Req%Pos
     1487        DO i = 1, Req%NbRequest
     1488          PtrHallo => Req%Hallo(i)
     1489          offset = (PtrHallo%offset - 1) * iip1 + 1
     1490          Nb = iip1 * PtrHallo%size - 1
     1491
     1492          !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1493          DO l = 1, PtrHallo%NbLevel
     1494            !cdir NODEP
     1495            DO ij = 0, Nb
     1496              PtrHallo%Field(offset + ij, l) = Buffer(Pos + ij)
     1497            enddo
     1498
     1499            Pos = Pos + Nb + 1
     1500          enddo
     1501          !$OMP ENDDO NOWAIT
     1502        enddo
    12531503      endif
    1254      
    1255       IF (Rdown==0) THEN
    1256         RecvDown=.FALSE.
     1504    enddo
     1505
     1506    DO rank = 0, MPI_SIZE - 1
     1507      Req => a_request%RequestSend(rank)
     1508      IF (Req%NbRequest>0) THEN
     1509        CALL deallocate_buffer(Req%Index)
     1510        Req%NbRequest = 0
    12571511      endif
    1258      
    1259       IF (SendUp) THEN
    1260         CALL Register_SendField(Field,ijnb_u,ll,jj_begin-jjb_u+1,SUp,MPI_Rank-1,a_request)
    1261       ENDIF
    1262  
    1263       IF (SendDown) THEN
    1264         CALL Register_SendField(Field,ijnb_u,ll,jj_end-SDown+1-jjb_u+1,SDown,MPI_Rank+1,a_request)
    1265       ENDIF
    1266    
    1267  
    1268       IF (RecvUp) THEN
    1269         CALL Register_RecvField(Field,ijnb_u,ll,jj_begin-Rup-jjb_u+1,RUp,MPI_Rank-1,a_request)
    1270       ENDIF
    1271  
    1272       IF (RecvDown) THEN
    1273         CALL Register_RecvField(Field,ijnb_u,ll,jj_end+1-jjb_u+1,RDown,MPI_Rank+1,a_request)
    1274       ENDIF
    1275  
    1276     END SUBROUTINE  Register_Hallo_u
    1277 
    1278   SUBROUTINE Register_Hallo_v(Field,ll,RUp,Rdown,SUp,SDown,a_request)
    1279   USE dimensions_mod
    1280   USE lmdz_mpi
    1281       IMPLICIT NONE
    1282       INTEGER :: ll
    1283       REAL, DIMENSION(ijb_v:ije_v,ll) :: Field
    1284       INTEGER :: Sup,Sdown,rup,rdown
    1285       type(request) :: a_request
    1286       type(Hallo),pointer :: PtrHallo
    1287       LOGICAL :: SendUp,SendDown
    1288       LOGICAL :: RecvUp,RecvDown
    1289    
    1290  
    1291       SendUp=.TRUE.
    1292       SendDown=.TRUE.
    1293       RecvUp=.TRUE.
    1294       RecvDown=.TRUE.
    1295        
    1296       IF (pole_nord) THEN
    1297         SendUp=.FALSE.
    1298         RecvUp=.FALSE.
    1299       ENDIF
    1300  
    1301       IF (pole_sud) THEN
    1302         SendDown=.FALSE.
    1303         RecvDown=.FALSE.
    1304       ENDIF
    1305      
    1306       IF (Sup==0) THEN
    1307         SendUp=.FALSE.
    1308        endif
    1309      
    1310       IF (Sdown==0) THEN
    1311         SendDown=.FALSE.
     1512    enddo
     1513
     1514    DO rank = 0, MPI_SIZE - 1
     1515      Req => a_request%RequestRecv(rank)
     1516      IF (Req%NbRequest>0) THEN
     1517        CALL deallocate_buffer(Req%Index)
     1518        Req%NbRequest = 0
    13121519      endif
    1313 
    1314       IF (Rup==0) THEN
    1315         RecvUp=.FALSE.
     1520    enddo
     1521
     1522    a_request%tag = 1
     1523  END SUBROUTINE  WaitRequest
     1524
     1525  SUBROUTINE WaitSendRequest(a_Request)
     1526    USE lmdz_mpi
     1527    USE lmdz_dimensions
     1528    USE lmdz_paramet
     1529    IMPLICIT NONE
     1530
     1531    type(request), target :: a_request
     1532    type(request_SR), pointer :: Req
     1533    type(Hallo), pointer :: PtrHallo
     1534    INTEGER, DIMENSION(mpi_size) :: TabRequest
     1535    INTEGER, DIMENSION(MPI_STATUS_SIZE, mpi_size) :: TabStatus
     1536    INTEGER :: NbRequest
     1537    INTEGER :: i, rank, pos, ij, l, ierr
     1538    INTEGER :: offset
     1539
     1540    NbRequest = 0
     1541    DO rank = 0, MPI_SIZE - 1
     1542      Req => a_request%RequestSend(rank)
     1543      IF (Req%NbRequest>0) THEN
     1544        NbRequest = NbRequest + 1
     1545        TabRequest(NbRequest) = Req%MSG_Request
    13161546      endif
    1317      
    1318       IF (Rdown==0) THEN
    1319         RecvDown=.FALSE.
     1547    enddo
     1548
     1549    IF (NbRequest>0 .AND. Req%BufferSize > 0) THEN
     1550      !$OMP CRITICAL (MPI)
     1551      !        PRINT *,"-------------------------------------------------------------------"
     1552      !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
     1553      !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
     1554      CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
     1555      !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
     1556      !        PRINT *,"-------------------------------------------------------------------"
     1557
     1558      !$OMP END CRITICAL (MPI)
     1559    endif
     1560
     1561    DO rank = 0, MPI_SIZE - 1
     1562      Req => a_request%RequestSend(rank)
     1563      IF (Req%NbRequest>0) THEN
     1564        CALL deallocate_buffer(Req%Index)
     1565        Req%NbRequest = 0
    13201566      endif
    1321      
    1322       IF (SendUp) THEN
    1323         CALL Register_SendField(Field,ijnb_v,ll,jj_begin-jjb_v+1,SUp,MPI_Rank-1,a_request)
    1324       ENDIF
    1325  
    1326       IF (SendDown) THEN
    1327         CALL Register_SendField(Field,ijnb_v,ll,jj_end-SDown+1-jjb_v+1,SDown,MPI_Rank+1,a_request)
    1328       ENDIF
    1329    
    1330  
    1331       IF (RecvUp) THEN
    1332         CALL Register_RecvField(Field,ijnb_v,ll,jj_begin-Rup-jjb_v+1,RUp,MPI_Rank-1,a_request)
    1333       ENDIF
    1334  
    1335       IF (RecvDown) THEN
    1336         CALL Register_RecvField(Field,ijnb_v,ll,jj_end+1-jjb_v+1,RDown,MPI_Rank+1,a_request)
    1337       ENDIF
    1338  
    1339     END SUBROUTINE  Register_Hallo_v
    1340    
    1341     SUBROUTINE SendRequest(a_Request)
    1342     USE dimensions_mod
     1567    enddo
     1568
     1569    a_request%tag = 1
     1570  END SUBROUTINE  WaitSendRequest
     1571
     1572  SUBROUTINE WaitRecvRequest(a_Request)
     1573    USE lmdz_dimensions
     1574    USE lmdz_paramet
    13431575    USE lmdz_mpi
    1344       IMPLICIT NONE
    1345 
    1346       type(request),target :: a_request
    1347       type(request_SR),pointer :: Req
    1348       type(Hallo),pointer :: PtrHallo
    1349       INTEGER :: SizeBuffer
    1350       INTEGER :: i,rank,l,ij,Pos,ierr
    1351       INTEGER :: offset
    1352       REAL,DIMENSION(:,:),pointer :: Field
    1353       INTEGER :: Nb
    1354        
    1355       DO rank=0,MPI_SIZE-1
    1356      
    1357         Req=>a_Request%RequestSend(rank)
    1358        
    1359         SizeBuffer=0
    1360         DO i=1,Req%NbRequest
    1361           PtrHallo=>Req%Hallo(i)
    1362 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1363           DO l=1,PtrHallo%NbLevel
    1364             SizeBuffer=SizeBuffer+PtrHallo%size*iip1
    1365           ENDDO
    1366 !$OMP ENDDO NOWAIT         
     1576    IMPLICIT NONE
     1577    type(request), target :: a_request
     1578    type(request_SR), pointer :: Req
     1579    type(Hallo), pointer :: PtrHallo
     1580    INTEGER, DIMENSION(mpi_size) :: TabRequest
     1581    INTEGER, DIMENSION(MPI_STATUS_SIZE, mpi_size) :: TabStatus
     1582    INTEGER :: NbRequest
     1583    INTEGER :: i, rank, pos, ij, l, ierr
     1584    INTEGER :: offset, Nb
     1585
     1586    NbRequest = 0
     1587
     1588    DO rank = 0, MPI_SIZE - 1
     1589      Req => a_request%RequestRecv(rank)
     1590      IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
     1591        NbRequest = NbRequest + 1
     1592        TabRequest(NbRequest) = Req%MSG_Request
     1593      endif
     1594    enddo
     1595
     1596    IF (NbRequest>0) THEN
     1597      !$OMP CRITICAL (MPI)
     1598      !        PRINT *,"-------------------------------------------------------------------"
     1599      !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
     1600      !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
     1601      CALL MPI_WAITALL(NbRequest, TabRequest, TabStatus, ierr)
     1602      !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
     1603      !        PRINT *,"-------------------------------------------------------------------"
     1604      !$OMP END CRITICAL (MPI)
     1605    endif
     1606
     1607    DO rank = 0, MPI_Size - 1
     1608      Req => a_request%RequestRecv(rank)
     1609      IF (Req%NbRequest>0) THEN
     1610        Pos = Req%Pos
     1611        DO i = 1, Req%NbRequest
     1612          PtrHallo => Req%Hallo(i)
     1613          offset = (PtrHallo%offset - 1) * iip1 + 1
     1614          Nb = iip1 * PtrHallo%size - 1
     1615          !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1616          DO l = 1, PtrHallo%NbLevel
     1617            !cdir NODEP
     1618            DO ij = 0, Nb
     1619              PtrHallo%Field(offset + ij, l) = Buffer(Pos + ij)
     1620            enddo
     1621            Pos = Pos + Nb + 1
     1622          enddo
     1623          !$OMP END DO NOWAIT
    13671624        enddo
    1368      
    1369          Req%BufferSize=SizeBuffer
    1370          IF (Req%NbRequest>0) THEN
    1371           CALL allocate_buffer(SizeBuffer,Req%Index,Req%pos)
    1372 
    1373           Pos=Req%Pos
    1374           DO i=1,Req%NbRequest
    1375             PtrHallo=>Req%Hallo(i)
    1376             offset=(PtrHallo%offset-1)*iip1+1
    1377             Nb=iip1*PtrHallo%size-1
    1378             Field=>PtrHallo%Field
    1379 
    1380 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    1381             DO l=1,PtrHallo%NbLevel
    1382 !cdir NODEP
    1383               DO ij=0,Nb
    1384             Buffer(Pos+ij)=Field(Offset+ij,l)
    1385           enddo
    1386              
    1387               Pos=Pos+Nb+1
    1388             enddo
    1389 !$OMP END DO NOWAIT           
    1390           enddo
    1391    
    1392          IF (SizeBuffer>0) THEN
    1393 !$OMP CRITICAL (MPI)
    1394          
    1395          CALL MPI_ISEND(Buffer(req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank,     &
    1396                          COMM_LMDZ,Req%MSG_Request,ierr)
    1397          IF (.NOT.using_mpi) THEN
    1398            PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
    1399            CALL abort_gcm("mod_hallo","stopped",1)
    1400          ENDIF
    1401 !         PRINT *,"-------------------------------------------------------------------"
    1402 !         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
    1403 !         PRINT *,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000*omp_rank
    1404 !         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
    1405 !         PRINT *,"-------------------------------------------------------------------"
    1406 !$OMP END CRITICAL (MPI)
    1407         endif
    1408        endif
     1625      endif
    14091626    enddo
    1410    
    1411            
    1412       DO rank=0,MPI_SIZE-1
    1413          
    1414           Req=>a_Request%RequestRecv(rank)
    1415           SizeBuffer=0
    1416          
    1417       DO i=1,Req%NbRequest
    1418             PtrHallo=>Req%Hallo(i)
    1419 
    1420 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1421             DO l=1,PtrHallo%NbLevel
    1422               SizeBuffer=SizeBuffer+PtrHallo%size*iip1
    1423             ENDDO
    1424 !$OMP ENDDO NOWAIT         
    1425           enddo
    1426          
    1427           Req%BufferSize=SizeBuffer
    1428          
    1429           IF (Req%NbRequest>0) THEN
    1430           CALL allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
    1431    
    1432           IF (SizeBuffer>0) THEN
    1433 !$OMP CRITICAL (MPI)
    1434 
    1435              CALL MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL_LMDZ,rank,a_request%tag+1000*omp_rank,     &
    1436                            COMM_LMDZ,Req%MSG_Request,ierr)
    1437 
    1438              IF (.NOT.using_mpi) THEN
    1439                PRINT *,'Erreur, echange MPI en mode sequentiel !!!'
    1440                CALL abort_gcm("mod_hallo","stopped",1)
    1441              ENDIF
    1442 
    1443 !         PRINT *,"-------------------------------------------------------------------"
    1444 !         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
    1445 !         PRINT *,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000*omp_rank
    1446 !         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
    1447 !         PRINT *,"-------------------------------------------------------------------"
    1448 
    1449 !$OMP END CRITICAL (MPI)
    1450           endif
    1451         endif
    1452      
     1627
     1628    DO rank = 0, MPI_SIZE - 1
     1629      Req => a_request%RequestRecv(rank)
     1630      IF (Req%NbRequest>0) THEN
     1631        CALL deallocate_buffer(Req%Index)
     1632        Req%NbRequest = 0
     1633      endif
     1634    enddo
     1635
     1636    a_request%tag = 1
     1637  END SUBROUTINE  WaitRecvRequest
     1638
     1639
     1640  SUBROUTINE CopyField(FieldS, FieldR, ij, ll, jj_Nb_New)
     1641    USE lmdz_dimensions
     1642    USE lmdz_paramet
     1643
     1644    IMPLICIT NONE
     1645
     1646    INTEGER :: ij, ll, l
     1647    REAL, DIMENSION(ij, ll) :: FieldS
     1648    REAL, DIMENSION(ij, ll) :: FieldR
     1649    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
     1650    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
     1651
     1652    INTEGER :: i, jje, jjb, ijb, ije
     1653
     1654    jj_begin_New(0) = 1
     1655    jj_End_New(0) = jj_Nb_New(0)
     1656    DO i = 1, MPI_Size - 1
     1657      jj_begin_New(i) = jj_end_New(i - 1) + 1
     1658      jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
     1659    enddo
     1660
     1661    jjb = max(jj_begin, jj_begin_new(MPI_Rank))
     1662    jje = min(jj_end, jj_end_new(MPI_Rank))
     1663    IF (ij==ip1jm) jje = min(jje, jjm)
     1664
     1665    IF (jje >= jjb) THEN
     1666      ijb = (jjb - 1) * iip1 + 1
     1667      ije = jje * iip1
     1668
     1669      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1670      DO l = 1, ll
     1671        FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
    14531672      enddo
    1454                        
    1455    END SUBROUTINE  SendRequest
    1456    
    1457    SUBROUTINE WaitRequest(a_Request)
    1458    USE dimensions_mod
    1459    USE lmdz_mpi
    1460    IMPLICIT NONE
    1461      
    1462       type(request),target :: a_request
    1463       type(request_SR),pointer :: Req
    1464       type(Hallo),pointer :: PtrHallo
    1465       INTEGER, DIMENSION(2*mpi_size) :: TabRequest
    1466       INTEGER, DIMENSION(MPI_STATUS_SIZE,2*mpi_size) :: TabStatus
    1467       INTEGER :: NbRequest
    1468       INTEGER :: i,rank,pos,ij,l,ierr
    1469       INTEGER :: offset
    1470       INTEGER :: Nb
    1471      
    1472      
    1473       NbRequest=0
    1474       DO rank=0,MPI_SIZE-1
    1475         Req=>a_request%RequestSend(rank)
    1476         IF (Req%NbRequest>0 .AND. Req%BufferSize > 0) THEN
    1477           NbRequest=NbRequest+1
    1478           TabRequest(NbRequest)=Req%MSG_Request
    1479         endif
     1673      !$OMP ENDDO NOWAIT
     1674    endif
     1675
     1676  END SUBROUTINE  CopyField
     1677
     1678  SUBROUTINE CopyFieldHallo(FieldS, FieldR, ij, ll, jj_Nb_New, Up, Down)
     1679    USE lmdz_dimensions
     1680    USE lmdz_paramet
     1681
     1682    IMPLICIT NONE
     1683
     1684    INTEGER :: ij, ll, Up, Down
     1685    REAL, DIMENSION(ij, ll) :: FieldS
     1686    REAL, DIMENSION(ij, ll) :: FieldR
     1687    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Nb_New
     1688    INTEGER, DIMENSION(0:MPI_Size - 1) :: jj_Begin_New, jj_End_New
     1689
     1690    INTEGER :: i, jje, jjb, ijb, ije, l
     1691
     1692    jj_begin_New(0) = 1
     1693    jj_End_New(0) = jj_Nb_New(0)
     1694    DO i = 1, MPI_Size - 1
     1695      jj_begin_New(i) = jj_end_New(i - 1) + 1
     1696      jj_end_New(i) = jj_begin_new(i) + jj_Nb_New(i) - 1
     1697    enddo
     1698
     1699    jjb = max(jj_begin, jj_begin_new(MPI_Rank) - Up)
     1700    jje = min(jj_end, jj_end_new(MPI_Rank) + Down)
     1701    IF (ij==ip1jm) jje = min(jje, jjm)
     1702
     1703    IF (jje >= jjb) THEN
     1704      ijb = (jjb - 1) * iip1 + 1
     1705      ije = jje * iip1
     1706
     1707      !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1708      DO l = 1, ll
     1709        FieldR(ijb:ije, l) = FieldS(ijb:ije, l)
    14801710      enddo
    1481      
    1482       DO rank=0,MPI_SIZE-1
    1483         Req=>a_request%RequestRecv(rank)
    1484         IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
    1485           NbRequest=NbRequest+1
    1486           TabRequest(NbRequest)=Req%MSG_Request
    1487         endif
    1488       enddo
    1489      
    1490       IF (NbRequest>0) THEN
    1491 !$OMP CRITICAL (MPI)
    1492 !        PRINT *,"-------------------------------------------------------------------"
    1493 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
    1494 !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
    1495         CALL MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
    1496 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
    1497 !        PRINT *,"-------------------------------------------------------------------"
    1498 !$OMP END CRITICAL (MPI)
    1499       endif
    1500       DO rank=0,MPI_Size-1
    1501         Req=>a_request%RequestRecv(rank)
    1502         IF (Req%NbRequest>0) THEN
    1503           Pos=Req%Pos
    1504           DO i=1,Req%NbRequest
    1505             PtrHallo=>Req%Hallo(i)
    1506             offset=(PtrHallo%offset-1)*iip1+1
    1507         Nb=iip1*PtrHallo%size-1
    1508 
    1509 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    1510         DO l=1,PtrHallo%NbLevel
    1511 !cdir NODEP
    1512               DO ij=0,Nb
    1513             PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
    1514           enddo
    1515 
    1516               Pos=Pos+Nb+1
    1517         enddo
    1518 !$OMP ENDDO NOWAIT
    1519           enddo
    1520         endif
    1521       enddo
    1522      
    1523       DO rank=0,MPI_SIZE-1
    1524         Req=>a_request%RequestSend(rank)
    1525         IF (Req%NbRequest>0) THEN
    1526           CALL deallocate_buffer(Req%Index)
    1527           Req%NbRequest=0
    1528         endif
    1529       enddo
    1530              
    1531       DO rank=0,MPI_SIZE-1
    1532         Req=>a_request%RequestRecv(rank)
    1533         IF (Req%NbRequest>0) THEN
    1534           CALL deallocate_buffer(Req%Index)
    1535           Req%NbRequest=0
    1536         endif
    1537       enddo
    1538      
    1539       a_request%tag=1
    1540     END SUBROUTINE  WaitRequest
    1541      
    1542    SUBROUTINE WaitSendRequest(a_Request)
    1543    USE lmdz_mpi
    1544    USE dimensions_mod
    1545    IMPLICIT NONE
    1546    
    1547       type(request),target :: a_request
    1548       type(request_SR),pointer :: Req
    1549       type(Hallo),pointer :: PtrHallo
    1550       INTEGER, DIMENSION(mpi_size) :: TabRequest
    1551       INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
    1552       INTEGER :: NbRequest
    1553       INTEGER :: i,rank,pos,ij,l,ierr
    1554       INTEGER :: offset
    1555      
    1556      
    1557       NbRequest=0
    1558       DO rank=0,MPI_SIZE-1
    1559         Req=>a_request%RequestSend(rank)
    1560         IF (Req%NbRequest>0) THEN
    1561           NbRequest=NbRequest+1
    1562           TabRequest(NbRequest)=Req%MSG_Request
    1563         endif
    1564       enddo
    1565      
    1566 
    1567       IF (NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
    1568 !$OMP CRITICAL (MPI)     
    1569 !        PRINT *,"-------------------------------------------------------------------"
    1570 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
    1571 !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
    1572          CALL MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
    1573 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
    1574 !        PRINT *,"-------------------------------------------------------------------"
    1575 
    1576 !$OMP END CRITICAL (MPI)
    1577       endif     
    1578      
    1579       DO rank=0,MPI_SIZE-1
    1580         Req=>a_request%RequestSend(rank)
    1581         IF (Req%NbRequest>0) THEN
    1582           CALL deallocate_buffer(Req%Index)
    1583           Req%NbRequest=0
    1584         endif
    1585       enddo
    1586              
    1587       a_request%tag=1
    1588     END SUBROUTINE  WaitSendRequest
    1589    
    1590    SUBROUTINE WaitRecvRequest(a_Request)
    1591    USE dimensions_mod
    1592    USE lmdz_mpi
    1593    IMPLICIT NONE
    1594       type(request),target :: a_request
    1595       type(request_SR),pointer :: Req
    1596       type(Hallo),pointer :: PtrHallo
    1597       INTEGER, DIMENSION(mpi_size) :: TabRequest
    1598       INTEGER, DIMENSION(MPI_STATUS_SIZE,mpi_size) :: TabStatus
    1599       INTEGER :: NbRequest
    1600       INTEGER :: i,rank,pos,ij,l,ierr
    1601       INTEGER :: offset,Nb
    1602      
    1603      
    1604       NbRequest=0
    1605      
    1606       DO rank=0,MPI_SIZE-1
    1607         Req=>a_request%RequestRecv(rank)
    1608         IF (Req%NbRequest>0 .AND. Req%BufferSize > 0 ) THEN
    1609           NbRequest=NbRequest+1
    1610           TabRequest(NbRequest)=Req%MSG_Request
    1611         endif
    1612       enddo
    1613      
    1614      
    1615       IF (NbRequest>0) THEN
    1616 !$OMP CRITICAL (MPI)     
    1617 !        PRINT *,"-------------------------------------------------------------------"
    1618 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
    1619 !        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
    1620          CALL MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
    1621 !        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
    1622 !        PRINT *,"-------------------------------------------------------------------"
    1623 !$OMP END CRITICAL (MPI)     
    1624       endif
    1625      
    1626       DO rank=0,MPI_Size-1
    1627         Req=>a_request%RequestRecv(rank)
    1628         IF (Req%NbRequest>0) THEN
    1629           Pos=Req%Pos
    1630           DO i=1,Req%NbRequest
    1631             PtrHallo=>Req%Hallo(i)
    1632             offset=(PtrHallo%offset-1)*iip1+1
    1633         Nb=iip1*PtrHallo%size-1
    1634 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
    1635         DO l=1,PtrHallo%NbLevel
    1636 !cdir NODEP
    1637               DO ij=0,Nb
    1638             PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
    1639           enddo
    1640                  Pos=Pos+Nb+1
    1641             enddo
    1642 !$OMP END DO NOWAIT
    1643           enddo
    1644         endif
    1645       enddo
    1646      
    1647            
    1648       DO rank=0,MPI_SIZE-1
    1649         Req=>a_request%RequestRecv(rank)
    1650         IF (Req%NbRequest>0) THEN
    1651           CALL deallocate_buffer(Req%Index)
    1652           Req%NbRequest=0
    1653         endif
    1654       enddo
    1655      
    1656       a_request%tag=1
    1657     END SUBROUTINE  WaitRecvRequest
    1658    
    1659    
    1660    
    1661     SUBROUTINE CopyField(FieldS,FieldR,ij,ll,jj_Nb_New)
    1662     USE dimensions_mod
    1663  
    1664       IMPLICIT NONE
    1665    
    1666     INTEGER :: ij,ll,l
    1667     REAL, DIMENSION(ij,ll) :: FieldS
    1668     REAL, DIMENSION(ij,ll) :: FieldR
    1669     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
    1670     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    1671    
    1672     INTEGER ::i,jje,jjb,ijb,ije
    1673    
    1674     jj_begin_New(0)=1
    1675     jj_End_New(0)=jj_Nb_New(0)
    1676     DO i=1,MPI_Size-1
    1677       jj_begin_New(i)=jj_end_New(i-1)+1
    1678       jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
    1679     enddo
    1680    
    1681     jjb=max(jj_begin,jj_begin_new(MPI_Rank))
    1682     jje=min(jj_end,jj_end_new(MPI_Rank))
    1683     IF (ij==ip1jm) jje=min(jje,jjm)
    1684 
    1685     IF (jje >= jjb) THEN
    1686       ijb=(jjb-1)*iip1+1
    1687       ije=jje*iip1
    1688 
    1689 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1690       DO l=1,ll
    1691         FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
    1692       enddo
    1693 !$OMP ENDDO NOWAIT
     1711      !$OMP ENDDO NOWAIT
     1712
    16941713    endif
    1695 
    1696 
    1697   END SUBROUTINE  CopyField
    1698 
    1699   SUBROUTINE CopyFieldHallo(FieldS,FieldR,ij,ll,jj_Nb_New,Up,Down)
    1700   USE dimensions_mod
    1701  
    1702       IMPLICIT NONE
    1703    
    1704     INTEGER :: ij,ll,Up,Down
    1705     REAL, DIMENSION(ij,ll) :: FieldS
    1706     REAL, DIMENSION(ij,ll) :: FieldR
    1707     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Nb_New
    1708     INTEGER,DIMENSION(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
    1709 
    1710     INTEGER ::i,jje,jjb,ijb,ije,l
    1711 
    1712      
    1713     jj_begin_New(0)=1
    1714     jj_End_New(0)=jj_Nb_New(0)
    1715     DO i=1,MPI_Size-1
    1716       jj_begin_New(i)=jj_end_New(i-1)+1
    1717       jj_end_New(i)=jj_begin_new(i)+jj_Nb_New(i)-1
    1718     enddo
    1719 
    1720        
    1721     jjb=max(jj_begin,jj_begin_new(MPI_Rank)-Up)
    1722     jje=min(jj_end,jj_end_new(MPI_Rank)+Down)
    1723     IF (ij==ip1jm) jje=min(jje,jjm)
    1724    
    1725    
    1726     IF (jje >= jjb) THEN
    1727       ijb=(jjb-1)*iip1+1
    1728       ije=jje*iip1
    1729 
    1730 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1731       DO l=1,ll
    1732         FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
    1733       enddo
    1734 !$OMP ENDDO NOWAIT
    1735 
    1736     endif
    1737    END SUBROUTINE  CopyFieldHallo
    1738 
    1739    SUBROUTINE Gather_field_u(field_loc,field_glo,ll)
    1740    USE dimensions_mod
    1741    IMPLICIT NONE
    1742      INTEGER :: ll
    1743      REAL :: field_loc(ijb_u:ije_u,ll)
    1744      REAL :: field_glo(ip1jmp1,ll)
    1745      type(request) :: request_gather
    1746      INTEGER       :: l
    1747 
    1748 
    1749 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1750      DO l=1,ll
    1751        field_glo(ij_begin:ij_end,l)=field_loc(ij_begin:ij_end,l)
    1752      ENDDO
    1753      
    1754      CALL register_SwapField(field_glo,field_glo,ip1jmp1,ll,distrib_gather%jj_nb_para,request_gather)
    1755      CALL SendRequest(request_gather)
    1756 !$OMP BARRIER
    1757      CALL WaitRequest(request_gather)
    1758 !$OMP BARRIER
    1759 
    1760     END SUBROUTINE  Gather_field_u
    1761        
    1762    SUBROUTINE Gather_field_v(field_loc,field_glo,ll)
    1763    USE dimensions_mod
    1764    IMPLICIT NONE
    1765      INTEGER :: ll
    1766      REAL :: field_loc(ijb_v:ije_v,ll)
    1767      REAL :: field_glo(ip1jm,ll)
    1768      type(request) :: request_gather
    1769      INTEGER :: ijb,ije
    1770      INTEGER       :: l
    1771      
    1772    
    1773      ijb=ij_begin
    1774      ije=ij_end
    1775      IF (pole_sud) ije=ij_end-iip1
    1776        
    1777 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1778      DO l=1,ll
    1779        field_glo(ijb:ije,l)=field_loc(ijb:ije,l)
    1780      ENDDO
    1781      
    1782      CALL register_SwapField(field_glo,field_glo,ip1jm,ll,distrib_gather%jj_nb_para,request_gather)
    1783      CALL SendRequest(request_gather)
    1784 !$OMP BARRIER
    1785      CALL WaitRequest(request_gather)
    1786 !$OMP BARRIER
    1787 
    1788     END SUBROUTINE  Gather_field_v
    1789      
    1790    SUBROUTINE Scatter_field_u(field_glo,field_loc,ll)
    1791    USE dimensions_mod
    1792    IMPLICIT NONE
    1793      INTEGER :: ll
    1794      REAL :: field_glo(ip1jmp1,ll)
    1795      REAL :: field_loc(ijb_u:ije_u,ll)
    1796      type(request) :: request_gather
    1797      TYPE(distrib) :: distrib_swap
    1798      INTEGER       :: l
    1799      
    1800 !$OMP BARRIER
    1801 !$OMP MASTER     
    1802      CALL get_current_distrib(distrib_swap)
    1803      CALL set_Distrib(distrib_gather)
    1804 !$OMP END MASTER
    1805 !$OMP BARRIER
    1806  
    1807      CALL register_SwapField(field_glo,field_glo,ip1jmp1,ll,distrib_swap%jj_nb_para,request_gather)
    1808      CALL SendRequest(request_gather)
    1809 !$OMP BARRIER
    1810      CALL WaitRequest(request_gather)
    1811 !$OMP BARRIER
    1812 !$OMP MASTER     
    1813      CALL set_Distrib(distrib_swap)
    1814 !$OMP END MASTER
    1815 !$OMP BARRIER
    1816 
    1817 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1818        DO l=1,ll
    1819          field_loc(ij_begin:ij_end,l)=field_glo(ij_begin:ij_end,l)
    1820        ENDDO
    1821 
    1822     END SUBROUTINE  Scatter_field_u
    1823 
    1824    SUBROUTINE Scatter_field_v(field_glo,field_loc,ll)
    1825    USE dimensions_mod
    1826    IMPLICIT NONE
    1827      INTEGER :: ll
    1828      REAL :: field_glo(ip1jmp1,ll)
    1829      REAL :: field_loc(ijb_v:ije_v,ll)
    1830      type(request) :: request_gather
    1831      TYPE(distrib) :: distrib_swap
    1832      INTEGER       :: ijb,ije,l
    1833      
    1834 
    1835 !$OMP BARRIER
    1836 !$OMP MASTER     
    1837      CALL get_current_distrib(distrib_swap)
    1838      CALL set_Distrib(distrib_gather)
    1839 !$OMP END MASTER
    1840 !$OMP BARRIER
    1841      CALL register_SwapField(field_glo,field_glo,ip1jm,ll,distrib_swap%jj_nb_para,request_gather)
    1842      CALL SendRequest(request_gather)
    1843 !$OMP BARRIER
    1844      CALL WaitRequest(request_gather)
    1845 !$OMP BARRIER
    1846 !$OMP MASTER
    1847      CALL set_Distrib(distrib_swap)
    1848 !$OMP END MASTER
    1849 !$OMP BARRIER
    1850      ijb=ij_begin
    1851      ije=ij_end
    1852      IF (pole_sud) ije=ij_end-iip1
    1853      
    1854 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    1855        DO l=1,ll
    1856          field_loc(ijb:ije,l)=field_glo(ijb:ije,l)
    1857        ENDDO
    1858 
    1859     END SUBROUTINE  Scatter_field_v
    1860              
     1714  END SUBROUTINE  CopyFieldHallo
     1715
     1716  SUBROUTINE Gather_field_u(field_loc, field_glo, ll)
     1717    USE lmdz_dimensions
     1718    USE lmdz_paramet
     1719    IMPLICIT NONE
     1720    INTEGER :: ll
     1721    REAL :: field_loc(ijb_u:ije_u, ll)
     1722    REAL :: field_glo(ip1jmp1, ll)
     1723    type(request) :: request_gather
     1724    INTEGER :: l
     1725
     1726
     1727    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1728    DO l = 1, ll
     1729      field_glo(ij_begin:ij_end, l) = field_loc(ij_begin:ij_end, l)
     1730    ENDDO
     1731
     1732    CALL register_SwapField(field_glo, field_glo, ip1jmp1, ll, distrib_gather%jj_nb_para, request_gather)
     1733    CALL SendRequest(request_gather)
     1734    !$OMP BARRIER
     1735    CALL WaitRequest(request_gather)
     1736    !$OMP BARRIER
     1737
     1738  END SUBROUTINE  Gather_field_u
     1739
     1740  SUBROUTINE Gather_field_v(field_loc, field_glo, ll)
     1741    USE lmdz_dimensions
     1742    USE lmdz_paramet
     1743    IMPLICIT NONE
     1744    INTEGER :: ll
     1745    REAL :: field_loc(ijb_v:ije_v, ll)
     1746    REAL :: field_glo(ip1jm, ll)
     1747    type(request) :: request_gather
     1748    INTEGER :: ijb, ije
     1749    INTEGER :: l
     1750
     1751    ijb = ij_begin
     1752    ije = ij_end
     1753    IF (pole_sud) ije = ij_end - iip1
     1754
     1755    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1756    DO l = 1, ll
     1757      field_glo(ijb:ije, l) = field_loc(ijb:ije, l)
     1758    ENDDO
     1759
     1760    CALL register_SwapField(field_glo, field_glo, ip1jm, ll, distrib_gather%jj_nb_para, request_gather)
     1761    CALL SendRequest(request_gather)
     1762    !$OMP BARRIER
     1763    CALL WaitRequest(request_gather)
     1764    !$OMP BARRIER
     1765
     1766  END SUBROUTINE  Gather_field_v
     1767
     1768  SUBROUTINE Scatter_field_u(field_glo, field_loc, ll)
     1769    USE lmdz_dimensions
     1770    USE lmdz_paramet
     1771    IMPLICIT NONE
     1772    INTEGER :: ll
     1773    REAL :: field_glo(ip1jmp1, ll)
     1774    REAL :: field_loc(ijb_u:ije_u, ll)
     1775    type(request) :: request_gather
     1776    TYPE(distrib) :: distrib_swap
     1777    INTEGER :: l
     1778
     1779    !$OMP BARRIER
     1780    !$OMP MASTER
     1781    CALL get_current_distrib(distrib_swap)
     1782    CALL set_Distrib(distrib_gather)
     1783    !$OMP END MASTER
     1784    !$OMP BARRIER
     1785
     1786    CALL register_SwapField(field_glo, field_glo, ip1jmp1, ll, distrib_swap%jj_nb_para, request_gather)
     1787    CALL SendRequest(request_gather)
     1788    !$OMP BARRIER
     1789    CALL WaitRequest(request_gather)
     1790    !$OMP BARRIER
     1791    !$OMP MASTER
     1792    CALL set_Distrib(distrib_swap)
     1793    !$OMP END MASTER
     1794    !$OMP BARRIER
     1795
     1796    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1797    DO l = 1, ll
     1798      field_loc(ij_begin:ij_end, l) = field_glo(ij_begin:ij_end, l)
     1799    ENDDO
     1800
     1801  END SUBROUTINE  Scatter_field_u
     1802
     1803  SUBROUTINE Scatter_field_v(field_glo, field_loc, ll)
     1804    USE lmdz_dimensions
     1805    USE lmdz_paramet
     1806    IMPLICIT NONE
     1807    INTEGER :: ll
     1808    REAL :: field_glo(ip1jmp1, ll)
     1809    REAL :: field_loc(ijb_v:ije_v, ll)
     1810    type(request) :: request_gather
     1811    TYPE(distrib) :: distrib_swap
     1812    INTEGER :: ijb, ije, l
     1813
     1814
     1815    !$OMP BARRIER
     1816    !$OMP MASTER
     1817    CALL get_current_distrib(distrib_swap)
     1818    CALL set_Distrib(distrib_gather)
     1819    !$OMP END MASTER
     1820    !$OMP BARRIER
     1821    CALL register_SwapField(field_glo, field_glo, ip1jm, ll, distrib_swap%jj_nb_para, request_gather)
     1822    CALL SendRequest(request_gather)
     1823    !$OMP BARRIER
     1824    CALL WaitRequest(request_gather)
     1825    !$OMP BARRIER
     1826    !$OMP MASTER
     1827    CALL set_Distrib(distrib_swap)
     1828    !$OMP END MASTER
     1829    !$OMP BARRIER
     1830    ijb = ij_begin
     1831    ije = ij_end
     1832    IF (pole_sud) ije = ij_end - iip1
     1833
     1834    !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1835    DO l = 1, ll
     1836      field_loc(ijb:ije, l) = field_glo(ijb:ije, l)
     1837    ENDDO
     1838
     1839  END SUBROUTINE  Scatter_field_v
     1840
    18611841END MODULE mod_Hallo
    18621842   

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

    r5158 r5159  
    4040     USE lmdz_comgeom
    4141
    42      IMPLICIT NONE
    43 
    44      INCLUDE 'dimensions.h'
    45      INCLUDE "paramet.h"
     42USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     43  USE lmdz_paramet
     44     IMPLICIT NONE
     45
     46
     47
    4648
    4749     TYPE(xios_duration) :: tstep_xios
    … …  
    132134
    133135     USE parallel_lmdz
    134      IMPLICIT NONE
    135      INCLUDE 'dimensions.h'
    136      INCLUDE 'paramet.h'
     136USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     137  USE lmdz_paramet
     138     IMPLICIT NONE
     139
     140
    137141     CHARACTER(LEN=*)   :: name
    138142     REAL, DIMENSION(ij_begin:ij_end) :: Field
    … …  
    153157
    154158     USE parallel_lmdz
    155      IMPLICIT NONE
    156      INCLUDE 'dimensions.h'
    157      INCLUDE 'paramet.h'
     159USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     160  USE lmdz_paramet
     161     IMPLICIT NONE
     162
     163
    158164     CHARACTER(LEN=*)   :: name
    159165     REAL, DIMENSION(ij_begin:ij_end,llm) :: Field
    … …  
    186192
    187193     USE parallel_lmdz
    188      IMPLICIT NONE
    189      INCLUDE 'dimensions.h'
    190      INCLUDE 'paramet.h'
     194USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     195  USE lmdz_paramet
     196     IMPLICIT NONE
     197
     198
    191199     CHARACTER(LEN=*)   :: name
    192200     REAL, DIMENSION(ij_begin:ij_end) :: Field
    … …  
    216224
    217225     USE parallel_lmdz
    218      IMPLICIT NONE
    219      INCLUDE 'dimensions.h'
    220      INCLUDE 'paramet.h'
     226USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     227  USE lmdz_paramet
     228     IMPLICIT NONE
     229
     230
    221231     CHARACTER(LEN=*)   :: name
    222232     REAL, DIMENSION(ij_begin:ij_end,llm) :: Field

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

    r5136 r5159  
    11SUBROUTINE nxgrad_gam_loc( klevel, rot, x, y )
    2   !
     2
    33  !  P. Le Van
    4   !
     4
    55  !   ********************************************************************
    66  !  calcul du gradient tourne de pi/2 du rotationnel du vect.v
    … …  
    88  !   rot          est un argument  d'entree pour le s-prog
    99  !   x  et y    sont des arguments de sortie pour le s-prog
    10   !
     10
    1111  USE parallel_lmdz
    1212  USE lmdz_comgeom
    1313
     14USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15  USE lmdz_paramet
    1416  IMPLICIT NONE
    1517  !
    16   INCLUDE "dimensions.h"
    17   INCLUDE "paramet.h"
     18
     19
    1820  INTEGER :: klevel
    1921  REAL :: rot( ijb_v:ije_v,klevel )
    … …  
    2325  external ismin,ismax
    2426  INTEGER :: ijb,ije
    25   !
     27
    2628!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2729  DO l = 1,klevel
    28   !
     30
    2931  ijb=ij_begin
    3032  ije=ij_end
    … …  
    3436  y( ij,l ) = (rot( ij,l ) - rot( ij-1,l )) * cvscuvgam( ij )
    3537  END DO
    36   !
     38
    3739  !    ..... correction pour  y ( 1,j,l )  ......
    38   !
     40
    3941  !    ....    y(1,j,l)= y(iip1,j,l) ....
    4042  !DIR$ IVDEP
    … …  
    4244  y( ij,l ) = y( ij +iim,l )
    4345  END DO
    44   !
     46
    4547  ijb=ij_begin
    4648  ije=ij_end+iip1
    … …  
    6365    ENDDO
    6466  ENDIF
    65   !
     67
    6668  END DO
    6769!$OMP END DO NOWAIT

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

    r5136 r5159  
    11SUBROUTINE nxgrad_loc(klevel, rot, x, y )
    2   !
     2
    33  ! P. Le Van
    4   !
     4
    55  !   ********************************************************************
    66  !  calcul du gradient tourne de pi/2 du rotationnel du vect.v
    … …  
    88  !   rot          est un argument  d'entree pour le s-prog
    99  !   x  et y    sont des arguments de sortie pour le s-prog
    10   !
     10
    1111  USE parallel_lmdz
    1212  USE lmdz_comgeom
    1313
     14USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15  USE lmdz_paramet
    1416  IMPLICIT NONE
    1517  !
    16   INCLUDE "dimensions.h"
    17   INCLUDE "paramet.h"
     18
     19
    1820  INTEGER :: klevel
    1921  REAL :: rot( ijb_v:ije_v,klevel ),x( ijb_u:ije_u,klevel )
    … …  
    2123  INTEGER :: l,ij
    2224  INTEGER :: ijb,ije
    23   !
    24   !
     25
     26
    2527!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    2628  DO l = 1,klevel
    27   !
     29
    2830  ijb=ij_begin
    2931  ije=ij_end
    … …  
    3335  y( ij,l ) = (  rot( ij,l ) - rot( ij-1,l )  ) * cvsurcuv( ij )
    3436  END DO
    35   !
     37
    3638  !    ..... correction pour  y ( 1,j,l )  ......
    37   !
     39
    3840  !    ....    y(1,j,l)= y(iip1,j,l) ....
    3941  !DIR$ IVDEP
    … …  
    4143  y( ij,l ) = y( ij +iim,l )
    4244  END DO
    43   !
     45
    4446  ijb=ij_begin
    4547  ije=ij_end+iip1
    … …  
    6365    ENDDO
    6466  ENDIF
    65   !
     67
    6668  END DO
    6769!$OMP END DO NOWAIT

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

    r5134 r5159  
    11 SUBROUTINE nxgraro2_loc(klevel,xcov,ycov,lr,grx_out,gry_out)
    2   !
     2
    33  !  P.Le Van .
    44  !   ***********************************************************
    55  !                             lr
    66  !  calcul de  ( nxgrad (rot) )   du vect. v  ....
    7   !
     7
    88  !   xcov et ycov  etant les compos. covariantes de  v
    99  !   ***********************************************************
    1010  ! xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
    1111  !  grx   et  gry     sont des arguments de sortie pour le s-prog
    12   !
    13   !
     12
     13
    1414  USE write_Field_p
    1515  USE parallel_lmdz
    … …  
    2020  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
    2121
     22USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     23  USE lmdz_paramet
    2224  IMPLICIT NONE
    2325  !
    24   INCLUDE "dimensions.h"
    25   INCLUDE "paramet.h"
    26   !
     26
     27
     28
    2729  !    ......  variables en arguments  .......
    28   !
     30
    2931  INTEGER :: klevel
    3032  REAL :: xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel )
    3133  REAL :: grx_out( ijb_u:ije_u,klevel ),gry_out(ijb_v:ije_v,klevel)
    32   !
     34
    3335  !    ......   variables locales     ........
    34   !
     36
    3537  REAL :: signe, nugradrs
    3638  INTEGER :: l,ij,iter,lr
    … …  
    3840!$OMP THREADPRIVATE(Request_dissip)
    3941  !    ........................................................
    40   !
     42
    4143  INTEGER :: ijb,ije,jjb,jje
    4244
    43   !
    44   !
     45
     46
    4547  signe    = (-1.)**lr
    4648  nugradrs = signe * crot
    47   !
     49
    4850  !  CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
    4951  !  CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
    … …  
    7577!$OMP END DO NOWAIT
    7678
    77   !
     79
    7880  CALL     rotatf_loc ( klevel, grx, gry, rot )
    7981   ! CALL write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
    … …  
    8890  CALL laplacien_rot_loc ( klevel, rot, rot,grx,gry      )
    8991    ! CALL write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/)))
    90   !
     92
    9193  !    .....   Iteration de l'operateur laplacien_rotgam  .....
    92   !
     94
    9395  DO  iter = 1, lr -2
    9496!$OMP BARRIER
    … …  
    104106    ! CALL write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/)))
    105107
    106   !
    107   !
     108
     109
    108110  jjb=jj_begin
    109111  jje=jj_end
    … …  
    121123  CALL nxgrad_loc ( klevel, rot, grx, gry )
    122124
    123   !
     125
    124126  ijb=ij_begin
    125127  ije=ij_end

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

    r1907 r5159  
    1111  USE allocate_field_mod
    1212  USE parallel_lmdz
    13   USE dimensions_mod
     13  USE lmdz_dimensions
     14  USE lmdz_paramet
    1415  IMPLICIT NONE
    1516    TYPE(distrib),POINTER :: d

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

    r5158 r5159  
    8282    USE lmdz_mpi
    8383    USE lmdz_iniprint, ONLY: lunout, prt_level
    84     IMPLICIT NONE
    85     INCLUDE "dimensions.h"
    86     INCLUDE "paramet.h"
     84    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     85  USE lmdz_paramet
     86    IMPLICIT NONE
     87
     88
    8789
    8890    INTEGER :: ierr
    … …  
    238240
    239241  SUBROUTINE create_distrib(jj_nb_new, d)
    240     IMPLICIT NONE
    241     INCLUDE "dimensions.h"
    242     INCLUDE "paramet.h"
     242    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     243  USE lmdz_paramet
     244    IMPLICIT NONE
     245
     246
    243247
    244248    INTEGER, INTENT(IN) :: jj_Nb_New(0:MPI_Size - 1)
    … …  
    289293
    290294  SUBROUTINE Set_Distrib(d)
    291     IMPLICIT NONE
    292 
    293     INCLUDE "dimensions.h"
    294     INCLUDE "paramet.h"
     295    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     296  USE lmdz_paramet
     297    IMPLICIT NONE
     298
     299
    295300    TYPE(distrib), INTENT(IN) :: d
    296301
    … …  
    324329
    325330  SUBROUTINE copy_distrib(dist, new_dist)
    326     IMPLICIT NONE
    327 
    328     INCLUDE "dimensions.h"
    329     INCLUDE "paramet.h"
     331    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     332  USE lmdz_paramet
     333    IMPLICIT NONE
     334
     335
    330336    TYPE(distrib), INTENT(INOUT) :: dist
    331337    TYPE(distrib), INTENT(IN) :: new_dist
    … …  
    360366
    361367  SUBROUTINE get_current_distrib(d)
    362     IMPLICIT NONE
    363 
    364     INCLUDE "dimensions.h"
    365     INCLUDE "paramet.h"
     368    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     369  USE lmdz_paramet
     370    IMPLICIT NONE
     371
     372
    366373    TYPE(distrib), INTENT(OUT) :: d
    367374
    … …  
    372379  SUBROUTINE Finalize_parallel
    373380    USE lmdz_mpi
    374     ! ug Pour les sorties XIOS
    375     USE lmdz_wxios
     381    USE lmdz_wxios  ! ug Pour les sorties XIOS
     382    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     383    USE lmdz_paramet
    376384
    377385
    … …  
    391399    CHARACTER(LEN = 6), parameter :: type_ocean = "dummy"
    392400#endif
    393 
    394     INCLUDE "dimensions.h"
    395     INCLUDE "paramet.h"
    396401
    397402    INTEGER :: ierr
    … …  
    431436
    432437  SUBROUTINE Pack_Data(Field, ij, ll, row, Buffer)
    433     IMPLICIT NONE
    434 
    435     INCLUDE "dimensions.h"
    436     INCLUDE "paramet.h"
     438    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     439  USE lmdz_paramet
     440    IMPLICIT NONE
     441
     442
    437443
    438444    INTEGER, INTENT(IN) :: ij, ll, row
    … …  
    454460
    455461  SUBROUTINE Unpack_Data(Field, ij, ll, row, Buffer)
    456     IMPLICIT NONE
    457 
    458     INCLUDE "dimensions.h"
    459     INCLUDE "paramet.h"
     462    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     463  USE lmdz_paramet
     464    IMPLICIT NONE
     465
     466
    460467
    461468    INTEGER, INTENT(IN) :: ij, ll, row
    … …  
    493500    USE lmdz_mpi
    494501    USE lmdz_vampir
    495     IMPLICIT NONE
    496     INCLUDE "dimensions.h"
    497     INCLUDE "paramet.h"
     502    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     503  USE lmdz_paramet
     504    IMPLICIT NONE
     505
     506
    498507    INTEGER :: ij, ll
    499508    REAL, DIMENSION(ij, ll) :: Field
    … …  
    607616    USE lmdz_mpi
    608617    USE lmdz_iniprint, ONLY: lunout, prt_level
    609     IMPLICIT NONE
    610     INCLUDE "dimensions.h"
    611     INCLUDE "paramet.h"
     618    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     619  USE lmdz_paramet
     620    IMPLICIT NONE
     621
     622
    612623    INTEGER :: ij, ll, rank
    613624    REAL, DIMENSION(ij, ll) :: Field
    … …  
    685696  SUBROUTINE AllGather_Field(Field, ij, ll)
    686697    USE lmdz_mpi
    687     IMPLICIT NONE
    688     INCLUDE "dimensions.h"
    689     INCLUDE "paramet.h"
     698    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     699  USE lmdz_paramet
     700    IMPLICIT NONE
     701
     702
    690703    INTEGER :: ij, ll
    691704    REAL, DIMENSION(ij, ll) :: Field
    … …  
    703716  SUBROUTINE Broadcast_Field(Field, ij, ll, rank)
    704717    USE lmdz_mpi
    705     IMPLICIT NONE
    706     INCLUDE "dimensions.h"
    707     INCLUDE "paramet.h"
     718    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     719  USE lmdz_paramet
     720    IMPLICIT NONE
     721
     722
    708723    INTEGER :: ij, ll
    709724    REAL, DIMENSION(ij, ll) :: Field
    … …  
    720735  END SUBROUTINE  Broadcast_Field
    721736
    722 
    723   !  Subroutine verif_hallo(Field,ij,ll,up,down)
    724   !    USE lmdz_mpi
    725   !    IMPLICIT NONE
    726   !      INCLUDE "dimensions.h"
    727   !      INCLUDE "paramet.h"
    728 
    729   !      INTEGER :: ij,ll
    730   !      REAL, DIMENSION(ij,ll) :: Field
    731   !      INTEGER :: up,down
    732 
    733   !      REAL,DIMENSION(ij,ll): NewField
    734 
    735   !      NewField=0
    736 
    737   !      ijb=ij_begin
    738   !      ije=ij_end
    739   !      if (pole_nord)
    740   !      NewField(ij_be
    741 
    742 end MODULE parallel_lmdz
     737END MODULE parallel_lmdz

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

    r5117 r5159  
    1111  ! couches , avec  p(ij,llm +1) = 0.  et p(ij,1) = ps(ij)  .
    1212  !  ************************************************************************
    13   !
     13
     14USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     15  USE lmdz_paramet
    1416  IMPLICIT NONE
    1517  !
    16   INCLUDE "dimensions.h"
    17   INCLUDE "paramet.h"
    18   !
     18
     19
     20
    1921  INTEGER,INTENT(IN) :: ngrid ! not used
    2022  INTEGER :: l,ij

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

    r5158 r5159  
    1010
    1111
     12  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     13  USE lmdz_paramet
    1214  IMPLICIT NONE
    13   !
     15
    1416  !  -- Objet : Traiter les valeurs trop petites (meme negatives)
    1517  !         pour l'eau vapeur et l'eau liquide
    1618  !
    17   INCLUDE "dimensions.h"
    18   INCLUDE "paramet.h"
    19   !
     19
     20
     21
    2022  INTEGER :: nqtot ! CRisi: on remplace nq par nqtot
    2123  REAL :: q(ijb_u:ije_u, llm, nqtot), deltap(ijb_u:ije_u, llm)
    22   !
     24
    2325  LOGICAL, SAVE :: first = .TRUE.
    2426  INTEGER, SAVE :: iq_vap, iq_liq        ! indices pour l'eau vapeur/liquide
    … …  
    2628  REAL, PARAMETER :: seuil_vap = 1.0e-10 ! seuil pour l'eau vapeur
    2729  REAL, PARAMETER :: seuil_liq = 1.0e-11 ! seuil pour l'eau liquide
    28   !
     30
    2931  !  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
    3032  !        parametres seuil_vap, seuil_liq soient pareilles a celles
    3133  !        qui  sont utilisees dans la routine    ADDFI       )
    3234  ! .................................................................
    33   !
     35
    3436  !DC iq_val and iq_liq are usable for q only, NOT for q_follow
    3537  !   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
    … …  
    4042  REAL :: zx_defau_diag(ijb_u:ije_u, llm, 2)
    4143  REAL :: q_follow(ijb_u:ije_u, llm, 2)
    42   !
     44
    4345  INTEGER :: imprim
    4446  SAVE imprim
    … …  
    5961    first = .FALSE.
    6062  END IF
    61   !
     63
    6264  ! Quand l'eau liquide est trop petite (ou negative), on prend
    6365  ! l'eau vapeur de la meme couche et la convertit en eau liquide
    … …  
    9698  END DO
    9799
    98   !
     100
    99101  ! Quand l'eau vapeur est trop faible (ou negative), on complete
    100102  ! le defaut en prennant de l'eau vapeur de la couche au-dessous.
    101   !
     103
    102104  !WRITE(lunout,*) 'qminimum 81'
    103105  DO k = llm, 2, -1
    … …  
    119121  ENDDO
    120122
    121   !
     123
    122124  ! Quand il s'agit de la premiere couche au-dessus du sol, on
    123125  ! doit imprimer un message d'avertissement (saturation possible).
    124   !
     126
    125127  !WRITE(lunout,*) 'qminimum 106'
    126128  nb_pump = 0

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

    r5136 r5159  
    11SUBROUTINE rotat_nfil_loc(klevel, x, y, rot )
    2   !
     2
    33  !    Auteur :   P.Le Van
    44  !**************************************************************
    … …  
    99  !   klevel, x  et y   sont des arguments d'entree pour le s-prog
    1010  !        rot          est  un argument  de sortie pour le s-prog
    11   !
     11
    1212  USE parallel_lmdz
    1313  USE lmdz_comgeom
    1414
     15USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    1618  !
    17   INCLUDE "dimensions.h"
    18   INCLUDE "paramet.h"
    19   !
     19
     20
     21
    2022  !   .....  variables en arguments  ......
    21   !
     23
    2224  INTEGER :: klevel
    2325  REAL :: rot( ijb_v:ije_v,klevel )
    2426  REAL :: x( ijb_u:ije_u,klevel ), y( ijb_v:ije_v,klevel )
    25   !
     27
    2628  !  ...   variables  locales  ...
    27   !
     29
    2830  INTEGER :: l, ij
    2931  INTEGER :: ijb,ije
    30   !
    31   !
     32
     33
    3234  ijb=ij_begin
    3335  ije=ij_end
    … …  
    3537!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3638  DO  l = 1,klevel
    37   !
     39
    3840    DO   ij = ijb, ije - 1
    3941     rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   + &
    4042           x(ij +iip1, l )  -  x( ij,l )
    4143    ENDDO
    42   !
     44
    4345  !    .... correction pour rot( iip1,j,l)  ....
    4446  !    ....   rot(iip1,j,l)= rot(1,j,l) ...
    … …  
    4749     rot( ij,l ) = rot( ij -iim,l )
    4850    ENDDO
    49   !
     51
    5052  END DO
    5153!$OMP END DO NOWAIT

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

    r5136 r5159  
    11SUBROUTINE rotat_p(klevel, x, y, rot )
    2   !
     2
    33  ! Auteur : P.Le Van
    44  !**************************************************************
    … …  
    99  !   klevel, x  et y   sont des arguments d'entree pour le s-prog
    1010  !        rot          est  un argument  de sortie pour le s-prog
    11   !
     11
    1212  USE parallel_lmdz
    1313  USE lmdz_comgeom
    1414
     15USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    1618  !
    17   INCLUDE "dimensions.h"
    18   INCLUDE "paramet.h"
    19   !
     19
     20
     21
    2022  !   .....  variables en arguments  ......
    21   !
     23
    2224  INTEGER :: klevel
    2325  REAL :: rot( ip1jm,klevel )
    2426  REAL :: x( ip1jmp1,klevel ), y( ip1jm,klevel )
    25   !
     27
    2628  !  ...   variables  locales  ...
    27   !
     29
    2830  INTEGER :: l, ij
    2931  INTEGER :: ijb,ije
    30   !
    31   !
     32
     33
    3234  ijb=ij_begin
    3335  ije=ij_end
    … …  
    3638!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3739  DO  l = 1,klevel
    38   !
     40
    3941    DO   ij = ijb, ije - 1
    4042     rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   + &
    4143           x(ij +iip1, l )  -  x( ij,l )
    4244    ENDDO
    43   !
     45
    4446  !    .... correction pour rot( iip1,j,l)  ....
    4547  !    ....   rot(iip1,j,l)= rot(1,j,l) ...
    … …  
    4850     rot( ij,l ) = rot( ij -iim,l )
    4951    ENDDO
    50   !
     52
    5153  END DO
    5254!$OMP END DO NOWAIT
    … …  
    5961    ENDDO
    6062!$OMP END DO NOWAIT
    61   !
     63
    6264  !
    6365

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

    r5136 r5159  
    11SUBROUTINE rotatf_loc(klevel, x, y, rot )
    2   !
     2
    33  ! Auteur : P.Le Van
    44  !**************************************************************
    … …  
    99  !   klevel, x  et y   sont des arguments d'entree pour le s-prog
    1010  !        rot          est  un argument  de sortie pour le s-prog
    11   !
     11
    1212  USE parallel_lmdz
    1313  USE lmdz_filtreg_p
    1414  USE lmdz_comgeom
    1515
     16USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     17  USE lmdz_paramet
    1618  IMPLICIT NONE
    1719  !
    18   INCLUDE "dimensions.h"
    19   INCLUDE "paramet.h"
    20   !
     20
     21
     22
    2123  !   .....  variables en arguments  ......
    22   !
     24
    2325  INTEGER :: klevel
    2426  REAL :: rot( ijb_v:ije_v,klevel )
    2527  REAL :: x( ijb_u:ije_u,klevel ), y( ijb_v:ije_v,klevel )
    26   !
     28
    2729  !  ...   variables  locales  ...
    28   !
     30
    2931  INTEGER :: l, ij
    3032  INTEGER :: ijb,ije,jjb,jje
    31   !
    32   !
     33
     34
    3335  ijb=ij_begin
    3436  ije=ij_end
    … …  
    3739!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    3840  DO  l = 1,klevel
    39   !
     41
    4042    DO   ij = ijb, ije - 1
    4143     rot( ij,l )  =    y( ij+1 , l )  -  y( ij,l )   + &
    4244           x(ij +iip1, l )  -  x( ij,l )
    4345    ENDDO
    44   !
     46
    4547  !    .... correction pour rot( iip1,j,l)  ....
    4648  !    ....   rot(iip1,j,l)= rot(1,j,l) ...
    … …  
    4951     rot( ij,l ) = rot( ij -iim,l )
    5052    ENDDO
    51   !
     53
    5254  END DO
    5355!$OMP END DO NOWAIT
    … …  
    6567    ENDDO
    6668!$OMP END DO NOWAIT
    67   !
     69
    6870  !
    6971

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

    r5158 r5159  
    44
    55  !=======================================================================
    6   !
     6
    77  !   Author:    Thomas Dubos      original: 26/01/2010
    88  !   -------
    9   !
     9
    1010  !   Subject:
    1111  !   ------
    1212  !   Realise le cas-test 6 de Williamson et al. (1991) : onde de Rossby-Haurwitz
    13   !
     13
    1414  !   Method:
    1515  !   --------
    16   !
     16
    1717  !   Interface:
    1818  !   ----------
    19   !
     19
    2020  !  Input:
    2121  !  ------
    22   !
     22
    2323  !  Output:
    2424  !  -------
    25   !
     25
    2626  !=======================================================================
    2727  USE parallel_lmdz
    … …  
    3131  USE lmdz_comgeom
    3232
     33  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     34  USE lmdz_paramet
    3335  IMPLICIT NONE
    3436  !-----------------------------------------------------------------------
    … …  
    3638  !   ---------------
    3739
    38   INCLUDE "dimensions.h"
    39   INCLUDE "paramet.h"
     40
     41
    4042
    4143  !   Arguments:

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

    r5158 r5159  
    2626  SUBROUTINE init_timer
    2727    USE parallel_lmdz
    28     IMPLICIT NONE
    29     INCLUDE "dimensions.h"
    30     INCLUDE "paramet.h"
     28USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     29  USE lmdz_paramet
     30    IMPLICIT NONE
     31
     32
    3133   
    3234    max_size=jjm+1

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

    r5158 r5159  
    1010  USE lmdz_comgeom2
    1111
     12USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     13  USE lmdz_paramet
    1214  IMPLICIT NONE
    1315  !
    14   INCLUDE "dimensions.h"
    15   INCLUDE "paramet.h"
     16
     17
    1618
    1719
    … …  
    2123
    2224  !=======================================================================
    23   !
     25
    2426  !   Auteur:  F. LOTT
    2527  !   -------
    26   !
     28
    2729  !   Objet:
    2830  !   ------
    29   !
     31
    3032  !   Dissipation linéaire (ex top_bound de la physique)
    31   !
     33
    3234  !=======================================================================
    3335

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

    r5136 r5159  
    99  USE lmdz_comgeom
    1010
     11USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     12  USE lmdz_paramet
    1113  IMPLICIT NONE
    12   INCLUDE "dimensions.h"
    13   INCLUDE "paramet.h"
     14
     15
    1416!===============================================================================
    1517! Arguments:

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

    r5134 r5159  
    88  USE comvert_mod, ONLY: bp
    99 
     10USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     11  USE lmdz_paramet
    1012  IMPLICIT NONE
    11   INCLUDE "dimensions.h"
    12   INCLUDE "paramet.h"
     13
     14
    1315!===============================================================================
    1416! Arguments:

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

    r5158 r5159  
    44
    55  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
    6   !
     6
    77  !    ********************************************************************
    88  ! Shema  d'advection " pseudo amont " .
    99  !    ********************************************************************
    1010  ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
    11   !
    12   !
     11
     12
    1313  !   --------------------------------------------------------------------
    1414  USE parallel_lmdz
    … …  
    1616          min_qParent, min_qMass, min_ratio ! MVals et CRisi
    1717  USE lmdz_iniprint, ONLY: lunout, prt_level
     18USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     19  USE lmdz_paramet
    1820  IMPLICIT NONE
    1921  !
    20   INCLUDE "dimensions.h"
    21   INCLUDE "paramet.h"
    22   !
    23   !
     22
     23
     24
     25
    2426  !   Arguments:
    2527  !   ----------
    … …  
    2931  REAL :: w(ijb_u:ije_u, llm)
    3032  INTEGER :: iq ! CRisi
    31   !
     33
    3234  !  Local
    3335  !   ---------
    34   !
     36
    3537  INTEGER :: ij, l, j, i, iju, ijq, indu(ijnb_u), niju
    3638  INTEGER :: n0, iadvplus(ijb_u:ije_u, llm), nl(llm)
    37   !
     39
    3840  REAL :: new_m, zu_m, zdum(ijb_u:ije_u, llm)
    3941  REAL :: sigu(ijb_u:ije_u), dxq(ijb_u:ije_u, llm), dxqu(ijb_u:ije_u)
    … …  
    367369
    368370SUBROUTINE vly_loc(q, pente_max, masse, masse_adv_v, iq)
    369   !
     371
    370372  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
    371   !
     373
    372374  !    ********************************************************************
    373375  ! Shema  d'advection " pseudo amont " .
    … …  
    375377  ! q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
    376378  ! dq            sont des arguments de sortie pour le s-pg ....
    377   !
    378   !
     379
     380
    379381  !   --------------------------------------------------------------------
    380382  USE parallel_lmdz
    … …  
    385387  USE lmdz_comgeom
    386388
     389USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     390  USE lmdz_paramet
    387391  IMPLICIT NONE
    388392  !
    389   INCLUDE "dimensions.h"
    390   INCLUDE "paramet.h"
    391   !
    392   !
     393
     394
     395
     396
    393397  !   Arguments:
    394398  !   ----------
    … …  
    397401  REAL :: q(ijb_u:ije_u, llm, nqtot), dq(ijb_u:ije_u, llm)
    398402  INTEGER :: iq ! CRisi
    399   !
     403
    400404  !  Local
    401405  !   ---------
    402   !
     406
    403407  INTEGER :: i, ij, l
    404   !
     408
    405409  REAL :: airej2, airejjm, airescb(iim), airesch(iim)
    406410  REAL :: dyq(ijb_u:ije_u, llm), dyqv(ijb_v:ije_v), zdvm(ijb_u:ije_u, llm)
    … …  
    456460  ENDIF
    457461
    458   !
     462
    459463  ! PRINT*,'CALCUL EN LATITUDE'
    460464
    461465  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    462466  DO l = 1, llm
    463     !
     467
    464468    !   --------------------------------
    465469    !  CALCUL EN LATITUDE
    … …  
    596600    ! appn=min(pente_max/appn,1.)
    597601    ! apps=min(pente_max/apps,1.)
    598     !
    599     !
     602
     603
    600604    !   cas ou on a un extremum au pole
    601     !
     605
    602606    ! IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
    603607    !    &   appn=0.
    … …  
    605609    !    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
    606610    !    &   apps=0.
    607     !
     611
    608612    !   limitation des pentes aux poles
    609613    ! DO ij=1,iip1
    … …  
    611615    !    dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
    612616    ! ENDDO
    613     !
     617
    614618    !   test
    615619    !  DO ij=1,iip1
    … …  
    620624    !     dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
    621625    !  ENDDO
    622     !
     626
    623627    ! changement 10 07 96
    624628    ! IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
    … …  
    632636    !    ENDDO
    633637    ! ENDIF
    634     !
     638
    635639    ! IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
    636640    !    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
    … …  
    797801
    798802SUBROUTINE vlz_loc(q, pente_max, masse, w, ijb_x, ije_x, iq)
    799   !
     803
    800804  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
    801   !
     805
    802806  !    ********************************************************************
    803807  ! Shema  d'advection " pseudo amont " .
    … …  
    805809  !    q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
    806810  ! dq            sont des arguments de sortie pour le s-pg ....
    807   !
    808   !
     811
     812
    809813  !   --------------------------------------------------------------------
    810814  USE parallel_lmdz
    … …  
    815819
    816820
     821USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     822  USE lmdz_paramet
    817823  IMPLICIT NONE
    818824  !
    819   INCLUDE "dimensions.h"
    820   INCLUDE "paramet.h"
    821   !
    822   !
     825
     826
     827
     828
    823829  !   Arguments:
    824830  !   ----------
    … …  
    827833  REAL :: w(ijb_u:ije_u, llm + 1, nqtot)
    828834  INTEGER :: iq
    829   !
     835
    830836  !  Local
    831837  !   ---------
    832   !
     838
    833839  INTEGER :: i, ij, l, j, ii
    834840
    … …  
    837843  INTEGER, SAVE :: countcfl
    838844  !$OMP THREADPRIVATE(countcfl)
    839   !
     845
    840846  REAL :: newmasse
    841847

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

    r5158 r5159  
    44        pdt, p, pk, teta)
    55
    6   !
     6
    77  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget, F.Codron
    8   !
     8
    99  !    ********************************************************************
    1010  !      Schema  d'advection " pseudo amont " .
    … …  
    1313  !    ********************************************************************
    1414  ! q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
    15   !
     15
    1616  ! pente_max facteur de limitation des pentes: 2 en general
    1717  !                                            0 pour un schema amont
    1818  ! pbaru,pbarv,w flux de masse en u ,v ,w
    1919  ! pdt pas de temps
    20   !
     20
    2121  ! teta temperature potentielle, p pression aux interfaces,
    2222  ! pk exner au milieu des couches necessaire pour calculer Qsat
    … …  
    3333
    3434
     35USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     36  USE lmdz_paramet
    3537  IMPLICIT NONE
    3638
    3739  !
    38   INCLUDE "dimensions.h"
    39   INCLUDE "paramet.h"
    40 
    41   !
     40
     41
     42
     43
    4244  !   Arguments:
    4345  !   ----------
    … …  
    4850  REAL :: p(ijb_u:ije_u, llmp1), teta(ijb_u:ije_u, llm)
    4951  REAL :: pk(ijb_u:ije_u, llm)
    50   !
     52
    5153  !  Local
    5254  !   ---------
    53   !
     55
    5456  INTEGER :: ij, l
    55   !
     57
    5658  REAL :: zzpbar, zzw
    5759

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

    r5101 r5159  
    1616  USE infotrac
    1717  USE vlz_mod,ONLY: vlz_allocate
     18USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     19  USE lmdz_paramet
    1820  IMPLICIT NONE
    19   INCLUDE "dimensions.h"
    20   INCLUDE "paramet.h"
     21
     22
    2123  TYPE(distrib),POINTER :: d
    2224   

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

    r5158 r5159  
    22
    33SUBROUTINE vlxqs_loc(q, pente_max, masse, u_m, qsat, ijb_x, ije_x, iq)
    4   !
     4
    55  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
    6   !
     6
    77  !    ********************************************************************
    88  ! Shema  d''advection " pseudo amont " .
    99  !    ********************************************************************
    10   !
     10
    1111  !   --------------------------------------------------------------------
    1212  USE parallel_lmdz
    1313  USE infotrac, ONLY: nqtot, tracers, & ! CRisi                 &
    1414          min_qParent, min_qMass, min_ratio ! MVals et CRisi7
     15USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    1618  !
    17   INCLUDE "dimensions.h"
    18   INCLUDE "paramet.h"
    19   !
    20   !
     19
     20
     21
     22
    2123  !   Arguments:
    2224  !   ----------
    … …  
    2628  REAL :: qsat(ijb_u:ije_u, llm)
    2729  INTEGER :: iq ! CRisi
    28   !
     30
    2931  !  Local
    3032  !   ---------
    31   !
     33
    3234  INTEGER :: ij, l, j, i, iju, ijq, indu(ijnb_u), niju
    3335  INTEGER :: n0, iadvplus(ijb_u:ije_u, llm), nl(llm)
    34   !
     36
    3537  REAL :: new_m, zu_m, zdum(ijb_u:ije_u, llm)
    3638  REAL :: dxq(ijb_u:ije_u, llm), dxqu(ijb_u:ije_u)
    … …  
    374376END SUBROUTINE vlxqs_loc
    375377SUBROUTINE vlyqs_loc(q, pente_max, masse, masse_adv_v, qsat, iq)
    376   !
     378
    377379  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
    378   !
     380
    379381  !    ********************************************************************
    380382  ! Shema  d'advection " pseudo amont " .
    … …  
    382384  ! q,masse_adv_v,w sont des arguments d'entree  pour le s-pg ....
    383385  ! qsat                est   un argument de sortie pour le s-pg ....
    384   !
    385   !
     386
     387
    386388  !   --------------------------------------------------------------------
    387389  USE parallel_lmdz
    … …  
    393395  USE lmdz_comgeom
    394396
     397USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     398  USE lmdz_paramet
    395399  IMPLICIT NONE
    396400  !
    397   INCLUDE "dimensions.h"
    398   INCLUDE "paramet.h"
    399   !
    400   !
     401
     402
     403
     404
    401405  !   Arguments:
    402406  !   ----------
    … …  
    406410  REAL :: qsat(ijb_u:ije_u, llm)
    407411  INTEGER :: iq ! CRisi
    408   !
     412
    409413  !  Local
    410414  !   ---------
    411   !
     415
    412416  INTEGER :: i, ij, l
    413   !
     417
    414418  REAL :: airej2, airejjm, airescb(iim), airesch(iim)
    415419  REAL :: dyq(ijb_u:ije_u, llm), dyqv(ijb_v:ije_v)
    … …  
    429433  !$OMP THREADPRIVATE(sinlon,coslon,sinlondlon,coslondlon)
    430434  !$OMP THREADPRIVATE(airej2,airejjm)
    431   !
    432   !
     435
     436
    433437  REAL :: Ratio(ijb_u:ije_u, llm, nqtot) ! CRisi
    434438  INTEGER :: ifils, iq2 ! CRisi
    … …  
    471475  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    472476  DO l = 1, llm
    473     !
     477
    474478    !   --------------------------------
    475479    !  CALCUL EN LATITUDE
    … …  
    602606    ! appn=min(pente_max/appn,1.)
    603607    ! apps=min(pente_max/apps,1.)
    604     !
    605     !
     608
     609
    606610    !   cas ou on a un extremum au pole
    607     !
     611
    608612    ! IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
    609613    !    &   appn=0.
    … …  
    611615    !    &   dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)
    612616    !    &   apps=0.
    613     !
     617
    614618    !   limitation des pentes aux poles
    615619    ! DO ij=1,iip1
    … …  
    617621    !    dyq(ip1jm+ij)=apps*dyq(ip1jm+ij)
    618622    ! ENDDO
    619     !
     623
    620624    !   test
    621625    !  DO ij=1,iip1
    … …  
    626630    !     dyq(ij)=dyq(ij)*cos(rlatu((ij-1)/iip1+1))
    627631    !  ENDDO
    628     !
     632
    629633    ! changement 10 07 96
    630634    ! IF(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)).le.0.)
    … …  
    638642    !    ENDDO
    639643    ! ENDIF
    640     !
     644
    641645    ! IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)*
    642646    !    & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1).le.0.)

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

    r4050 r5159  
    1515  USE parallel_lmdz
    1616  USE infotrac
    17   USE dimensions_mod
     17  USE lmdz_dimensions
     18  USE lmdz_paramet
    1819  IMPLICIT NONE
    1920  TYPE(distrib),POINTER :: d

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

    r5158 r5159  
    113113    enddo
    114114    WRITE(unit(if), '(a7)') 'ENDVARS'
    115     !
     115
    116116    1000   format(a5, 3x, i4, i3, 1x, a39)
    117117

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

    r5134 r5159  
    3737    USE lmdz_write_field
    3838    USE mod_hallo
     39USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     40  USE lmdz_paramet
    3941    IMPLICIT NONE
    40     INCLUDE 'dimensions.h'
    41     INCLUDE 'paramet.h'
     42
     43
    4244     
    4345    CHARACTER(LEN=*)   :: name
    … …  
    102104    USE lmdz_write_field
    103105    USE mod_hallo
     106USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     107  USE lmdz_paramet
    104108    IMPLICIT NONE
    105     INCLUDE 'dimensions.h'
    106     INCLUDE 'paramet.h'
     109
     110
    107111     
    108112    CHARACTER(LEN=*)   :: name

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

    r5158 r5159  
    1616  USE lmdz_comgeom
    1717
     18  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     19  USE lmdz_paramet
    1820  IMPLICIT NONE
    1921
    … …  
    3638
    3739  !   Declarations
    38   INCLUDE "dimensions.h"
    39   INCLUDE "paramet.h"
     40
     41
    4042
    4143  !   Arguments

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

    r5158 r5159  
    1616  USE lmdz_comgeom
    1717
     18  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     19  USE lmdz_paramet
    1820  IMPLICIT NONE
    1921
    20   !
     22
    2123  !   Ecriture du fichier histoire au format IOIPSL
    22   !
     24
    2325  !   Appels succesifs des routines: histwrite
    24   !
     26
    2527  !   Entree:
    2628  !  histid: ID du fichier histoire
    … …  
    3436  !  ps   :pression au sol
    3537  !  phis : geopotentiel au sol
    36   !
    37   !
     38
     39
    3840  !   Sortie:
    3941  !  fileid: ID du fichier netcdf cree
    40   !
     42
    4143  !   L. Fairhead, LMD, 03/99
    42   !
     44
    4345  ! =====================================================================
    44   !
     46
    4547  !   Declarations
    46   INCLUDE "dimensions.h"
    47   INCLUDE "paramet.h"
    48 
    49   !
     48
     49
     50
     51
    5052  !   Arguments
    5153  !
    … …  
    6264  ! This routine needs IOIPSL
    6365  !   Variables locales
    64   !
     66
    6567  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
    6668  INTEGER :: iq, ii, ll
    … …  
    7375  !$OMP THREADPRIVATE(first)
    7476
    75   !
     77
    7678  !  Initialisations
    77   !
     79
    7880  IF (adjust) return
    7981
    … …  
    101103  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
    102104
    103   !
     105
    104106  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
    105   !
     107
    106108  !  Vents U
    107109  !
    … …  
    117119  !$OMP END MASTER
    118120
    119   !
     121
    120122  !  Vents V
    121   !
     123
    122124  ije = ij_end
    123125  IF (pole_sud) jjn = jj_nb - 1
    … …  
    130132
    131133
    132   !
     134
    133135  !  Temperature potentielle moyennee
    134   !
     136
    135137  ijb = ij_begin
    136138  ije = ij_end
    … …  
    141143  !$OMP END MASTER
    142144
    143   !
     145
    144146  !  Temperature moyennee
    145147  !
    … …  
    159161
    160162
    161   !
     163
    162164  !  Geopotentiel
    163   !
     165
    164166  !$OMP MASTER
    165167  CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije, :), &
    … …  
    168170
    169171
    170   !
     172
    171173  !  Traceurs
    172   !
     174
    173175  !!$OMP MASTER
    174176  !    DO iq=1,nqtot
    … …  
    179181
    180182
    181   !
     183
    182184  !  Masse
    183   !
     185
    184186  !$OMP MASTER
    185187  CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije, :), &
    … …  
    188190
    189191
    190   !
     192
    191193  !  Pression au sol
    192   !
     194
    193195  !$OMP MASTER
    194196
    … …  
    197199  !$OMP END MASTER
    198200
    199   !
     201
    200202  !  Geopotentiel au sol
    201   !
     203
    202204  !$OMP MASTER
    203205  ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
    … …  
    205207  !$OMP END MASTER
    206208
    207   !
     209
    208210  !  Fin
    209   !
     211
    210212  !$OMP MASTER
    211213  IF (ok_sync) THEN

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

    r5158 r5159  
    1313  USE lmdz_comgeom
    1414
     15  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     16  USE lmdz_paramet
    1517  IMPLICIT NONE
    1618
    17   !
     19
    1820  !   Ecriture du fichier histoire au format IOIPSL
    19   !
     21
    2022  !   Appels succesifs des routines: histwrite
    21   !
     23
    2224  !   Entree:
    2325  !  histid: ID du fichier histoire
    … …  
    3133  !  ps   :pression au sol
    3234  !  phis : geopotentiel au sol
    33   !
    34   !
     35
     36
    3537  !   Sortie:
    3638  !  fileid: ID du fichier netcdf cree
    37   !
     39
    3840  !   L. Fairhead, LMD, 03/99
    39   !
     41
    4042  ! =====================================================================
    41   !
     43
    4244  !   Declarations
    43   INCLUDE "dimensions.h"
    44   INCLUDE "paramet.h"
    45 
    46   !
     45
     46
     47
     48
    4749  !   Arguments
    4850  !
    … …  
    5961  ! This routine needs IOIPSL
    6062  !   Variables locales
    61   !
     63
    6264  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
    6365  INTEGER :: iq, ii, ll
    … …  
    7072  !$OMP THREADPRIVATE(first)
    7173
    72   !
     74
    7375  !  Initialisations
    74   !
     76
    7577  IF (adjust) return
    7678
    … …  
    98100  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
    99101
    100   !
     102
    101103  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
    102   !
     104
    103105  !  Vents U
    104106  !
    … …  
    114116  !$OMP END MASTER
    115117
    116   !
     118
    117119  !  Vents V
    118   !
     120
    119121  ije = ij_end
    120122  IF (pole_sud) jjn = jj_nb - 1
    … …  
    127129
    128130
    129   !
     131
    130132  !  Temperature potentielle
    131   !
     133
    132134  ijb = ij_begin
    133135  ije = ij_end
    … …  
    138140  !$OMP END MASTER
    139141
    140   !
     142
    141143  !  Temperature
    142144  !
    … …  
    156158
    157159
    158   !
     160
    159161  !  Geopotentiel
    160   !
     162
    161163  !$OMP MASTER
    162164  CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije, :), &
    … …  
    165167
    166168
    167   !
     169
    168170  !  Traceurs
    169   !
     171
    170172  !!$OMP MASTER
    171173  !    DO iq=1,nqtot
    … …  
    176178
    177179
    178   !
     180
    179181  !  Masse
    180   !
     182
    181183  !$OMP MASTER
    182184  CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije, :), &
    … …  
    185187
    186188
    187   !
     189
    188190  !  Pression au sol
    189   !
     191
    190192  !$OMP MASTER
    191193  CALL histwrite(histid, 'ps', itau_w, ps(ijb:ije), &
    … …  
    193195  !$OMP END MASTER
    194196
    195   !
     197
    196198  !  Geopotentiel au sol
    197   !
     199
    198200  !$OMP MASTER
    199201  ! CALL histwrite(histid, 'phis', itau_w, phis(ijb:ije),
    … …  
    201203  !$OMP END MASTER
    202204
    203   !
     205
    204206  !  Fin
    205   !
     207
    206208  !$OMP MASTER
    207209  IF (ok_sync) THEN
Note: See TracChangeset for help on using the changeset viewer.