Changeset 5114


Ignore:
Timestamp:
Jul 24, 2024, 1:27:51 PM (7 weeks ago)
Author:
abarral
Message:

Rename modules in misc from *_mod > lmdz_*
Turn description.h into lmdz_description.f90

Location:
LMDZ6/branches/Amaury_dev/libf
Files:
26 edited
2 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90

    r5103 r5114  
    1414  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
    1515  USE strings_mod, ONLY: int2str
     16  USE lmdz_description, ONLY: descript
    1617
    1718  IMPLICIT NONE
    … …  
    2122  include "comdissip.h"
    2223  include "comgeom2.h"
    23   include "description.h"
    2424  include "iniprint.h"
    2525

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90

    r5113 r5114  
    2020  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    2121  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
     22  USE lmdz_description, ONLY: descript
    2223
    2324  IMPLICIT NONE
    … …  
    2526  include "paramet.h"
    2627  include "comgeom2.h"
    27   include "description.h"
    2828  include "iniprint.h"
    2929!===============================================================================

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem.F90

    r5103 r5114  
    1818  USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn, itaufin, start_time
    1919  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
     20  USE lmdz_description, ONLY: descript
    2021 
    2122  IMPLICIT NONE
    … …  
    2324  include "paramet.h"
    2425  include "comgeom2.h"
    25   include "description.h"
    2626  include "iniprint.h"
    2727!===============================================================================
    … …  
    165165                          err, modname, fil, msg
    166166  USE temps_mod, ONLY: itau_dyn, itaufin
     167  USE lmdz_description, ONLY: descript
    167168 
    168169  IMPLICIT NONE
    169170  include "dimensions.h"
    170171  include "paramet.h"
    171   include "description.h"
    172172  include "comgeom.h"
    173173  include "iniprint.h"

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

    r5106 r5114  
    1919
    2020  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
     21  USE lmdz_description, ONLY: descript
    2122
    2223!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    6465  include "comdissnew.h"
    6566  include "comgeom.h"
    66   include "description.h"
    6767  include "iniprint.h"
    6868  include "tracstoke.h"

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90

    r5113 r5114  
    2525  USE strings_mod, ONLY: msg
    2626  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
     27  USE lmdz_description, ONLY: descript
    2728
    2829  IMPLICIT NONE
    … …  
    6364  include "comdissnew.h"
    6465  include "comgeom.h"
    65   include "description.h"
    6666  include "iniprint.h"
    6767  include "academic.h"

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90

    r5105 r5114  
    66
    77  USE comconst_mod, ONLY: dtvr
     8  USE lmdz_description, ONLY: descript
    89  IMPLICIT NONE
    910
    … …  
    1213  include "comdissip.h"
    1314  include "comgeom2.h"
    14   include "description.h"
    1515
    1616  !----------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fyhyp_m.F90

    r2598 r5114  
    1616    ! Il vaut mieux avoir : grossismy * dzoom < pi / 2
    1717
    18     use coefpoly_m, only: coefpoly
     18    use lmdz_coefpoly, only: coefpoly
    1919    use nrtype, only: k8
    2020    use serre_mod, only: clat, grossismy, dzoomy, tauy

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initdynav.F90

    r5113 r5114  
    1010  USE comvert_mod, ONLY: presnivs
    1111  USE temps_mod, ONLY: itau_dyn
     12  USE lmdz_description, ONLY: descript
    1213 
    1314  IMPLICIT NONE
    … …  
    3738  include "paramet.h"
    3839  include "comgeom.h"
    39   include "description.h"
    4040  include "iniprint.h"
    4141

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90

    r5113 r5114  
    1 
    21! $Id$
    32
    43SUBROUTINE initfluxsto &
    5         (infile,tstep,t_ops,t_wrt, &
    6         fileid,filevid,filedid)
    7 
    8    USE IOIPSL
     4        (infile, tstep, t_ops, t_wrt, &
     5        fileid, filevid, filedid)
     6
     7  USE IOIPSL
    98  USE comconst_mod, ONLY: pi
    109  USE comvert_mod, ONLY: nivsigs
    1110  USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn
     11  USE lmdz_description, ONLY: descript
    1212
    1313  IMPLICIT NONE
    … …  
    4343  include "paramet.h"
    4444  include "comgeom.h"
    45   include "description.h"
    4645  include "iniprint.h"
    4746
    4847  !   Arguments
    4948  !
    50   character(len=*) :: infile
     49  character(len = *) :: infile
    5150  real :: tstep, t_ops, t_wrt
    52   integer :: fileid, filevid,filedid
     51  integer :: fileid, filevid, filedid
    5352
    5453  ! This routine needs IOIPSL to work
    … …  
    5857  integer :: tau0
    5958  real :: zjulian
    60   character(len=3) :: str
    61   character(len=10) :: ctrac
     59  character(len = 3) :: str
     60  character(len = 10) :: ctrac
    6261  integer :: iq
    63   real :: rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
    64   integer :: uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
    65   integer :: ii,jj
     62  real :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1)
     63  integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
     64  integer :: ii, jj
    6665  integer :: zan, idayref
    6766  logical :: ok_sync
    … …  
    7069  !
    7170  pi = 4. * atan (1.)
    72   str='q  '
     71  str = 'q  '
    7372  ctrac = 'traceur   '
    7473  ok_sync = .TRUE.
    … …  
    8281  tau0 = itau_dyn
    8382
    84     do jj = 1, jjp1
     83  do jj = 1, jjp1
    8584    do ii = 1, iip1
    86       rlong(ii,jj) = rlonu(ii) * 180. / pi
    87       rlat(ii,jj) = rlatu(jj) * 180. / pi
     85      rlong(ii, jj) = rlonu(ii) * 180. / pi
     86      rlat(ii, jj) = rlatu(jj) * 180. / pi
    8887    enddo
    8988  enddo
    9089
    91   CALL histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:), &
    92         1, iip1, 1, jjp1, &
    93         tau0, zjulian, tstep, uhoriid, fileid)
     90  CALL histbeg(infile, iip1, rlong(:, 1), jjp1, rlat(1, :), &
     91          1, iip1, 1, jjp1, &
     92          tau0, zjulian, tstep, uhoriid, fileid)
    9493  !
    9594  !  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
    … …  
    9796  !  un meme fichier)
    9897
    99 
    10098  do jj = 1, jjm
    10199    do ii = 1, iip1
    102       rlong(ii,jj) = rlonv(ii) * 180. / pi
    103       rlat(ii,jj) = rlatv(jj) * 180. / pi
     100      rlong(ii, jj) = rlonv(ii) * 180. / pi
     101      rlat(ii, jj) = rlatv(jj) * 180. / pi
    104102    enddo
    105103  enddo
    106104
    107   CALL histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:), &
    108         1, iip1, 1, jjm, &
    109         tau0, zjulian, tstep, vhoriid, filevid)
    110 
    111     rl(1,1) = 1.
     105  CALL histbeg('fluxstokev.nc', iip1, rlong(:, 1), jjm, rlat(1, :), &
     106          1, iip1, 1, jjm, &
     107          tau0, zjulian, tstep, vhoriid, filevid)
     108
     109  rl(1, 1) = 1.
    112110  CALL histbeg('defstoke.nc', 1, rl, 1, rl, &
    113         1, 1, 1, 1, &
    114         tau0, zjulian, tstep, dhoriid, filedid)
     111          1, 1, 1, 1, &
     112          tau0, zjulian, tstep, dhoriid, filedid)
    115113
    116114  !
    … …  
    119117  do jj = 1, jjp1
    120118    do ii = 1, iip1
    121       rlong(ii,jj) = rlonv(ii) * 180. / pi
    122       rlat(ii,jj) = rlatu(jj) * 180. / pi
     119      rlong(ii, jj) = rlonv(ii) * 180. / pi
     120      rlat(ii, jj) = rlatu(jj) * 180. / pi
    123121    enddo
    124122  enddo
    125123
    126124  CALL histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
    127         'Grille points scalaires', thoriid)
     125          'Grille points scalaires', thoriid)
    128126
    129127  !
    … …  
    131129  !
    132130  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', &
    133         'sigma_level', &
    134         llm, nivsigs, zvertiid)
     131          'sigma_level', &
     132          llm, nivsigs, zvertiid)
    135133  ! Pour le fichier V
    136134  CALL histvert(filevid, 'sig_s', 'Niveaux sigma', &
    137         'sigma_level', &
    138         llm, nivsigs, zvertiid)
     135          'sigma_level', &
     136          llm, nivsigs, zvertiid)
    139137  ! pour le fichier def
    140138  nivd(1) = 1
    141139  CALL histvert(filedid, 'sig_s', 'Niveaux sigma', &
    142         'sigma_level', &
    143         1, nivd, dvertiid)
     140          'sigma_level', &
     141          1, nivd, dvertiid)
    144142
    145143  !
    146144  !  Appels a histdef pour la definition des variables a sauvegarder
    147145
    148     CALL histdef(fileid, "phis", "Surface geop. height", "-", &
    149           iip1,jjp1,thoriid, 1,1,1, -99, 32, &
    150           "once", t_ops, t_wrt)
    151 
    152      CALL histdef(fileid, "aire", "Grid area", "-", &
    153            iip1,jjp1,thoriid, 1,1,1, -99, 32, &
    154            "once", t_ops, t_wrt)
    155 
    156     CALL histdef(filedid, "dtvr", "tps dyn", "s", &
    157           1,1,dhoriid, 1,1,1, -99, 32, &
    158           "once", t_ops, t_wrt)
    159 
    160      CALL histdef(filedid, "istdyn", "tps stock", "s", &
    161            1,1,dhoriid, 1,1,1, -99, 32, &
    162            "once", t_ops, t_wrt)
    163 
    164      CALL histdef(filedid, "istphy", "tps stock phy", "s", &
    165            1,1,dhoriid, 1,1,1, -99, 32, &
    166            "once", t_ops, t_wrt)
     146  CALL histdef(fileid, "phis", "Surface geop. height", "-", &
     147          iip1, jjp1, thoriid, 1, 1, 1, -99, 32, &
     148          "once", t_ops, t_wrt)
     149
     150  CALL histdef(fileid, "aire", "Grid area", "-", &
     151          iip1, jjp1, thoriid, 1, 1, 1, -99, 32, &
     152          "once", t_ops, t_wrt)
     153
     154  CALL histdef(filedid, "dtvr", "tps dyn", "s", &
     155          1, 1, dhoriid, 1, 1, 1, -99, 32, &
     156          "once", t_ops, t_wrt)
     157
     158  CALL histdef(filedid, "istdyn", "tps stock", "s", &
     159          1, 1, dhoriid, 1, 1, 1, -99, 32, &
     160          "once", t_ops, t_wrt)
     161
     162  CALL histdef(filedid, "istphy", "tps stock phy", "s", &
     163          1, 1, dhoriid, 1, 1, 1, -99, 32, &
     164          "once", t_ops, t_wrt)
    167165
    168166
    … …  
    171169  !
    172170  CALL histdef(fileid, 'masse', 'Masse', 'kg', &
    173         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    174         32, 'inst(X)', t_ops, t_wrt)
     171          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     172          32, 'inst(X)', t_ops, t_wrt)
    175173  !
    176174  !  Pbaru
    177175  !
    178176  CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', &
    179         iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
    180         32, 'inst(X)', t_ops, t_wrt)
     177          iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
     178          32, 'inst(X)', t_ops, t_wrt)
    181179
    182180  !
    … …  
    184182  !
    185183  CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', &
    186         iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
    187         32, 'inst(X)', t_ops, t_wrt)
     184          iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
     185          32, 'inst(X)', t_ops, t_wrt)
    188186  !
    189187  !  w
    190188  !
    191189  CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', &
    192         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    193         32, 'inst(X)', t_ops, t_wrt)
     190          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     191          32, 'inst(X)', t_ops, t_wrt)
    194192
    195193  !
    … …  
    197195  !
    198196  CALL histdef(fileid, 'teta', 'temperature potentielle', '-', &
    199         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    200         32, 'inst(X)', t_ops, t_wrt)
     197          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     198          32, 'inst(X)', t_ops, t_wrt)
    201199  !
    202200
    … …  
    205203  !
    206204  CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', &
    207         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    208         32, 'inst(X)', t_ops, t_wrt)
     205          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     206          32, 'inst(X)', t_ops, t_wrt)
    209207  !
    210208  !  Fin

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90

    r5113 r5114  
    33SUBROUTINE inithist(day0, anne0, tstep, t_ops, t_wrt)
    44
    5    USE IOIPSL
     5  USE IOIPSL
    66  USE infotrac, ONLY: nqtot
    7   use com_io_dyn_mod, ONLY: histid, histvid, histuid, &
     7  USE com_io_dyn_mod, ONLY: histid, histvid, histuid, &
    88          dynhist_file, dynhistv_file, dynhistu_file
    99  USE comconst_mod, ONLY: pi
    1010  USE comvert_mod, ONLY: presnivs
    1111  USE temps_mod, ONLY: itau_dyn
     12  USE lmdz_description, ONLY: descript
    1213
    1314  IMPLICIT NONE
    … …  
    4142  include "paramet.h"
    4243  include "comgeom.h"
    43   include "description.h"
    4444  include "iniprint.h"
    4545
    … …  
    5555  real :: zjulian
    5656  integer :: iq
    57   real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
     57  real :: rlong(iip1, jjp1), rlat(iip1, jjp1)
    5858  integer :: uhoriid, vhoriid, thoriid, zvertiid
    59   integer :: ii,jj
     59  integer :: ii, jj
    6060  integer :: zan, dayref
    6161  !
    … …  
    7878  do jj = 1, jjp1
    7979    do ii = 1, iip1
    80       rlong(ii,jj) = rlonu(ii) * 180. / pi
    81       rlat(ii,jj) = rlatu(jj) * 180. / pi
     80      rlong(ii, jj) = rlonu(ii) * 180. / pi
     81      rlat(ii, jj) = rlatu(jj) * 180. / pi
    8282    enddo
    8383  enddo
    8484
    85   CALL histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
    86         1, iip1, 1, jjp1, &
    87         tau0, zjulian, tstep, uhoriid, histuid)
     85  CALL histbeg(dynhistu_file, iip1, rlong(:, 1), jjp1, rlat(1, :), &
     86          1, iip1, 1, jjp1, &
     87          tau0, zjulian, tstep, uhoriid, histuid)
    8888
    8989  ! Grille V
    9090  do jj = 1, jjm
    9191    do ii = 1, iip1
    92       rlong(ii,jj) = rlonv(ii) * 180. / pi
    93       rlat(ii,jj) = rlatv(jj) * 180. / pi
     92      rlong(ii, jj) = rlonv(ii) * 180. / pi
     93      rlat(ii, jj) = rlatv(jj) * 180. / pi
    9494    enddo
    9595  enddo
    9696
    97   CALL histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:), &
    98         1, iip1, 1, jjm, &
    99         tau0, zjulian, tstep, vhoriid, histvid)
     97  CALL histbeg(dynhistv_file, iip1, rlong(:, 1), jjm, rlat(1, :), &
     98          1, iip1, 1, jjm, &
     99          tau0, zjulian, tstep, vhoriid, histvid)
    100100
    101101  !Grille Scalaire
    102102  do jj = 1, jjp1
    103103    do ii = 1, iip1
    104       rlong(ii,jj) = rlonv(ii) * 180. / pi
    105       rlat(ii,jj) = rlatu(jj) * 180. / pi
     104      rlong(ii, jj) = rlonv(ii) * 180. / pi
     105      rlat(ii, jj) = rlatu(jj) * 180. / pi
    106106    enddo
    107107  enddo
    108108
    109   CALL histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
    110         1, iip1, 1, jjp1, &
    111         tau0, zjulian, tstep, thoriid, histid)
     109  CALL histbeg(dynhist_file, iip1, rlong(:, 1), jjp1, rlat(1, :), &
     110          1, iip1, 1, jjp1, &
     111          tau0, zjulian, tstep, thoriid, histid)
    112112  ! -------------------------------------------------------------
    113113  !  Appel a histvert pour la grille verticale
    114114  ! -------------------------------------------------------------
    115   CALL histvert(histid, 'presnivs', 'Niveaux pression','mb', &
    116         llm, presnivs/100., zvertiid,'down')
    117   CALL histvert(histvid, 'presnivs', 'Niveaux pression','mb', &
    118         llm, presnivs/100., zvertiid,'down')
    119   CALL histvert(histuid, 'presnivs', 'Niveaux pression','mb', &
    120         llm, presnivs/100., zvertiid,'down')
     115  CALL histvert(histid, 'presnivs', 'Niveaux pression', 'mb', &
     116          llm, presnivs / 100., zvertiid, 'down')
     117  CALL histvert(histvid, 'presnivs', 'Niveaux pression', 'mb', &
     118          llm, presnivs / 100., zvertiid, 'down')
     119  CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', &
     120          llm, presnivs / 100., zvertiid, 'down')
    121121  !
    122122  ! -------------------------------------------------------------
    … …  
    127127  !
    128128  CALL histdef(histuid, 'u', 'vent u', 'm/s', &
    129         iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
    130         32, 'inst(X)', t_ops, t_wrt)
     129          iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
     130          32, 'inst(X)', t_ops, t_wrt)
    131131  !
    132132  !  Vents V
    133133  !
    134134  CALL histdef(histvid, 'v', 'vent v', 'm/s', &
    135         iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
    136         32, 'inst(X)', t_ops, t_wrt)
     135          iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
     136          32, 'inst(X)', t_ops, t_wrt)
    137137
    138138  !
    … …  
    140140  !
    141141  CALL histdef(histid, 'teta', 'temperature potentielle', '-', &
    142         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    143         32, 'inst(X)', t_ops, t_wrt)
     142          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     143          32, 'inst(X)', t_ops, t_wrt)
    144144  !
    145145  !  Geopotentiel
    146146  !
    147147  CALL histdef(histid, 'phi', 'geopotentiel', '-', &
    148         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    149         32, 'inst(X)', t_ops, t_wrt)
     148          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     149          32, 'inst(X)', t_ops, t_wrt)
    150150  !
    151151  !  Traceurs
    … …  
    162162  !
    163163  CALL histdef(histid, 'masse', 'masse', 'kg', &
    164         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
    165         32, 'inst(X)', t_ops, t_wrt)
     164          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     165          32, 'inst(X)', t_ops, t_wrt)
    166166  !
    167167  !  Pression au sol
    168168  !
    169169  CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', &
    170         iip1, jjp1, thoriid, 1, 1, 1, -99, &
    171         32, 'inst(X)', t_ops, t_wrt)
     170          iip1, jjp1, thoriid, 1, 1, 1, -99, &
     171          32, 'inst(X)', t_ops, t_wrt)
    172172  !
    173173  !  Geopotentiel au sol

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpre.f90

    r5113 r5114  
    1 
    21! $Id$
    32
    4  SUBROUTINE interpre(q,qppm,w,fluxwppm,masse, &
    5          apppm,bpppm,massebx,masseby,pbaru,pbarv, &
    6          unatppm,vnatppm,psppm)
     3SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, &
     4        apppm, bpppm, massebx, masseby, pbaru, pbarv, &
     5        unatppm, vnatppm, psppm)
    76
    87  USE comconst_mod, ONLY: g
    98  USE comvert_mod, ONLY: ap, bp
     9  USE lmdz_description, ONLY: descript
    1010
    11    IMPLICIT NONE
     11  IMPLICIT NONE
    1212
    1313  include "dimensions.h"
    … …  
    1515  include "comdissip.h"
    1616  include "comgeom2.h"
    17   include "description.h"
    1817
    1918  !---------------------------------------------------
    2019  ! Arguments
    21   real :: apppm(llm+1),bpppm(llm+1)
    22   real :: q(iip1,jjp1,llm),qppm(iim,jjp1,llm)
     20  real :: apppm(llm + 1), bpppm(llm + 1)
     21  real :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
    2322  !---------------------------------------------------
    24   real :: masse(iip1,jjp1,llm)
    25   real :: massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
    26   real :: w(iip1,jjp1,llm)
    27   real :: fluxwppm(iim,jjp1,llm)
    28   real :: pbaru(iip1,jjp1,llm )
    29   real :: pbarv(iip1,jjm,llm)
    30   real :: unatppm(iim,jjp1,llm)
    31   real :: vnatppm(iim,jjp1,llm)
    32   real :: psppm(iim,jjp1)
     23  real :: masse(iip1, jjp1, llm)
     24  real :: massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
     25  real :: w(iip1, jjp1, llm)
     26  real :: fluxwppm(iim, jjp1, llm)
     27  real :: pbaru(iip1, jjp1, llm)
     28  real :: pbarv(iip1, jjm, llm)
     29  real :: unatppm(iim, jjp1, llm)
     30  real :: vnatppm(iim, jjp1, llm)
     31  real :: psppm(iim, jjp1)
    3332  !---------------------------------------------------
    3433  ! Local
    35   real :: vnat(iip1,jjp1,llm)
    36   real :: unat(iip1,jjp1,llm)
    37   real :: fluxw(iip1,jjp1,llm)
    38   real :: smass(iip1,jjp1)
     34  real :: vnat(iip1, jjp1, llm)
     35  real :: unat(iip1, jjp1, llm)
     36  real :: fluxw(iip1, jjp1, llm)
     37  real :: smass(iip1, jjp1)
    3938  !----------------------------------------------------
    40   integer :: l,ij,i,j
     39  integer :: l, ij, i, j
    4140
    42     ! CALCUL DE LA PRESSION DE SURFACE
    43     ! Les coefficients ap et bp sont passés en common
    44     ! Calcul de la pression au sol en mb optimisée pour
    45     ! la vectorialisation
     41  ! CALCUL DE LA PRESSION DE SURFACE
     42  ! Les coefficients ap et bp sont passés en common
     43  ! Calcul de la pression au sol en mb optimisée pour
     44  ! la vectorialisation
    4645
    47      do j=1,jjp1
    48          do i=1,iip1
    49             smass(i,j)=0.
    50          enddo
    51      enddo
     46  do j = 1, jjp1
     47    do i = 1, iip1
     48      smass(i, j) = 0.
     49    enddo
     50  enddo
    5251
    53      do l=1,llm
    54          do j=1,jjp1
    55              do i=1,iip1
    56                 smass(i,j)=smass(i,j)+masse(i,j,l)
    57              enddo
    58          enddo
    59      enddo
     52  do l = 1, llm
     53    do j = 1, jjp1
     54      do i = 1, iip1
     55        smass(i, j) = smass(i, j) + masse(i, j, l)
     56      enddo
     57    enddo
     58  enddo
    6059
    61      do j=1,jjp1
    62          do i=1,iim
    63              psppm(i,j)=smass(i,j)/aire(i,j)*g*0.01
    64          END DO
    65      END DO
     60  do j = 1, jjp1
     61    do i = 1, iim
     62      psppm(i, j) = smass(i, j) / aire(i, j) * g * 0.01
     63    END DO
     64  END DO
    6665
    6766  ! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
    … …  
    6968  ! de vitesse et pas les flux, on doit donc passer de l'un à l'autre
    7069  ! Dans le même temps, on fait le changement d'orientation du vent en v
    71   do l=1,llm
    72       do j=1,jjm
    73           do i=1,iip1
    74               vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)
    75           enddo
     70  do l = 1, llm
     71    do j = 1, jjm
     72      do i = 1, iip1
     73        vnat(i, j, l) = -pbarv(i, j, l) / masseby(i, j, l) * cv(i, j)
    7674      enddo
    77       do  i=1,iim
    78       vnat(i,jjp1,l)=0.
     75    enddo
     76    do  i = 1, iim
     77      vnat(i, jjp1, l) = 0.
     78    enddo
     79    do j = 1, jjp1
     80      do i = 1, iip1
     81        unat(i, j, l) = pbaru(i, j, l) / massebx(i, j, l) * cu(i, j)
    7982      enddo
    80       do j=1,jjp1
    81           do i=1,iip1
    82               unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j)
    83           enddo
    84       enddo
     83    enddo
    8584  enddo
    8685
    8786  ! CALCUL DU FLUX MASSIQUE VERTICAL
    8887  ! Flux en l=1 (sol) nul
    89   fluxw=0.
    90   do l=1,llm
    91        do j=1,jjp1
    92           do i=1,iip1
    93            fluxw(i,j,l)=w(i,j,l)*g*0.01/aire(i,j)
    94             ! PRINT*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
    95   ! c                      'w(i,j,l)=',w(i,j,l)
    96           enddo
    97        enddo
     88  fluxw = 0.
     89  do l = 1, llm
     90    do j = 1, jjp1
     91      do i = 1, iip1
     92        fluxw(i, j, l) = w(i, j, l) * g * 0.01 / aire(i, j)
     93        ! PRINT*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
     94        ! c                      'w(i,j,l)=',w(i,j,l)
     95      enddo
     96    enddo
    9897  enddo
    9998
    … …  
    103102  ! On passe donc des niveaux du LMDZ à ceux de Lin
    104103
    105   do l=1,llm+1
    106       apppm(l)=ap(llm+2-l)
    107       bpppm(l)=bp(llm+2-l)
     104  do l = 1, llm + 1
     105    apppm(l) = ap(llm + 2 - l)
     106    bpppm(l) = bp(llm + 2 - l)
    108107  enddo
    109108
    110   do l=1,llm
    111       do j=1,jjp1
    112          do i=1,iim
    113              unatppm(i,j,l)=unat(i,j,llm-l+1)
    114              vnatppm(i,j,l)=vnat(i,j,llm-l+1)
    115              fluxwppm(i,j,l)=fluxw(i,j,llm-l+1)
    116              qppm(i,j,l)=q(i,j,llm-l+1)
    117          enddo
     109  do l = 1, llm
     110    do j = 1, jjp1
     111      do i = 1, iim
     112        unatppm(i, j, l) = unat(i, j, llm - l + 1)
     113        vnatppm(i, j, l) = vnat(i, j, llm - l + 1)
     114        fluxwppm(i, j, l) = fluxw(i, j, llm - l + 1)
     115        qppm(i, j, l) = q(i, j, llm - l + 1)
    118116      enddo
     117    enddo
    119118  enddo
    120119

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90

    r5113 r5114  
    99  SUBROUTINE invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
    1010
    11     use coefpoly_m, only: coefpoly
     11    use lmdz_coefpoly, only: coefpoly
    1212    use nrtype, only: pi, pi_d, twopi_d, k8
    1313    use serre_mod, only: clon

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/traceurpole.f90

    r5113 r5114  
    1 
    21! $Id$
    32
    4     SUBROUTINE traceurpole(q,masse)
    5 
    6       IMPLICIT NONE
     3SUBROUTINE traceurpole(q, masse)
     4  USE lmdz_description, ONLY: descript
     5  IMPLICIT NONE
    76
    87  include "dimensions.h"
    … …  
    109  include "comdissip.h"
    1110  include "comgeom2.h"
    12   include "description.h"
    1311
    1412
    1513  !   Arguments
    16    integer :: iq
    17    real :: masse(iip1,jjp1,llm)
    18    real :: q(iip1,jjp1,llm)
     14  integer :: iq
     15  real :: masse(iip1, jjp1, llm)
     16  real :: q(iip1, jjp1, llm)
    1917
    2018
    2119  !   Locals
    22   integer :: i,j,l
     20  integer :: i, j, l
    2321  real :: sommemassen(llm)
    2422  real :: sommemqn(llm)
    2523  real :: sommemasses(llm)
    2624  real :: sommemqs(llm)
    27   real :: qpolen(llm),qpoles(llm)
     25  real :: qpolen(llm), qpoles(llm)
    2826
    2927
    3028  ! On impose une seule valeur au pôle Sud j=jjm+1=jjp1
    31   sommemasses=0
    32   sommemqs=0
    33       do l=1,llm
    34          do i=1,iip1
    35              sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
    36              sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
    37          enddo
    38       qpoles(l)=sommemqs(l)/sommemasses(l)
    39       enddo
     29  sommemasses = 0
     30  sommemqs = 0
     31  do l = 1, llm
     32    do i = 1, iip1
     33      sommemasses(l) = sommemasses(l) + masse(i, jjp1, l)
     34      sommemqs(l) = sommemqs(l) + masse(i, jjp1, l) * q(i, jjp1, l)
     35    enddo
     36    qpoles(l) = sommemqs(l) / sommemasses(l)
     37  enddo
    4038
    4139  ! On impose une seule valeur du traceur au pôle Nord j=1
    42   sommemassen=0
    43   sommemqn=0
    44      do l=1,llm
    45        do i=1,iip1
    46            sommemassen(l)=sommemassen(l)+masse(i,1,l)
    47            sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
    48        enddo
    49        qpolen(l)=sommemqn(l)/sommemassen(l)
    50      enddo
     40  sommemassen = 0
     41  sommemqn = 0
     42  do l = 1, llm
     43    do i = 1, iip1
     44      sommemassen(l) = sommemassen(l) + masse(i, 1, l)
     45      sommemqn(l) = sommemqn(l) + masse(i, 1, l) * q(i, 1, l)
     46    enddo
     47    qpolen(l) = sommemqn(l) / sommemassen(l)
     48  enddo
    5149
    5250  ! On force le traceur à prendre cette valeur aux pôles
    53     do l=1,llm
    54         do i=1,iip1
    55            q(i,1,l)=qpolen(l)
    56            q(i,jjp1,l)=qpoles(l)
    57          enddo
     51  do l = 1, llm
     52    do i = 1, iip1
     53      q(i, 1, l) = qpolen(l)
     54      q(i, jjp1, l) = qpoles(l)
    5855    enddo
    59 
     56  enddo
    6057
    6158  return

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90

    r5113 r5114  
    88  USE comconst_mod, ONLY: cpp
    99  USE temps_mod, ONLY: itau_dyn
     10  USE lmdz_description, ONLY: descript
    1011
    1112  IMPLICIT NONE
    … …  
    3233  include "paramet.h"
    3334  include "comgeom.h"
    34   include "description.h"
    3535  include "iniprint.h"
    3636
    … …  
    4242  REAL phis(ip1jmp1)                 
    4343  REAL q(ip1jmp1, llm, nqtot)
    44   integer time
     44  INTEGER time
    4545
    4646  ! This routine needs IOIPSL to work

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90

    r5113 r5114  
    1 
    21! $Id$
    32
    4 SUBROUTINE writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
     3SUBROUTINE writehist(time, vcov, ucov, teta, phi, q, masse, ps, phis)
    54
    65  USE ioipsl
    76  USE infotrac, ONLY: nqtot
    8   use com_io_dyn_mod, ONLY: histid,histvid,histuid
     7  USE com_io_dyn_mod, ONLY: histid, histvid, histuid
    98  USE temps_mod, ONLY: itau_dyn
     9  USE lmdz_description, ONLY: descript
    1010
    1111  IMPLICIT NONE
    … …  
    3636  include "paramet.h"
    3737  include "comgeom.h"
    38   include "description.h"
    3938  include "iniprint.h"
    4039
    … …  
    4342  !
    4443
    45   REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    46   REAL :: teta(ip1jmp1,llm),phi(ip1jmp1,llm)
    47   REAL :: ps(ip1jmp1),masse(ip1jmp1,llm)
     44  REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm)
     45  REAL :: teta(ip1jmp1, llm), phi(ip1jmp1, llm)
     46  REAL :: ps(ip1jmp1), masse(ip1jmp1, llm)
    4847  REAL :: phis(ip1jmp1)
    49   REAL :: q(ip1jmp1,llm,nqtot)
     48  REAL :: q(ip1jmp1, llm, nqtot)
    5049  integer :: time
    5150
    … …  
    5554  !
    5655  integer :: iq, ii, ll
    57   integer :: ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
     56  integer :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
    5857  logical :: ok_sync
    5958  integer :: itau_w
    60   REAL :: vnat(ip1jm,llm),unat(ip1jmp1,llm)
     59  REAL :: vnat(ip1jm, llm), unat(ip1jmp1, llm)
    6160
    6261  !
    … …  
    6665  ndexv = 0
    6766  ndex2d = 0
    68   ok_sync =.TRUE.
     67  ok_sync = .TRUE.
    6968  itau_w = itau_dyn + time
    7069  !  Passage aux composantes naturelles du vent
    … …  
    7675  !
    7776  CALL histwrite(histuid, 'u', itau_w, unat, &
    78         iip1*jjp1*llm, ndexu)
     77          iip1 * jjp1 * llm, ndexu)
    7978  !
    8079  !  Vents V
    8180  !
    8281  CALL histwrite(histvid, 'v', itau_w, vnat, &
    83         iip1*jjm*llm, ndexv)
     82          iip1 * jjm * llm, ndexv)
    8483
    8584  !
    … …  
    8786  !
    8887  CALL histwrite(histid, 'teta', itau_w, teta, &
    89         iip1*jjp1*llm, ndexu)
     88          iip1 * jjp1 * llm, ndexu)
    9089  !
    9190  !  Geopotentiel
    9291  !
    9392  CALL histwrite(histid, 'phi', itau_w, phi, &
    94         iip1*jjp1*llm, ndexu)
     93          iip1 * jjp1 * llm, ndexu)
    9594  !
    9695  !  Traceurs
    … …  
    103102  !  Masse
    104103  !
    105   CALL histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
     104  CALL histwrite(histid, 'masse', itau_w, masse, iip1 * jjp1 * llm, ndexu)
    106105  !
    107106  !  Pression au sol
    108107  !
    109   CALL histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
     108  CALL histwrite(histid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d)
    110109  !
    111110  !  Geopotentiel au sol

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

    r5103 r5114  
    1919  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
    2020  USE strings_mod, ONLY: int2str
     21  USE lmdz_description, ONLY: descript
    2122
    2223  IMPLICIT NONE
    … …  
    2627  include "comdissip.h"
    2728  include "comgeom2.h"
    28   include "description.h"
    29   !   include "iniprint.h"
    3029
    3130  !---------------------------------------------------------------------------

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

    r5113 r5114  
    2121  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    2222  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA
     23  USE lmdz_description, ONLY: descript
    2324
    2425  IMPLICIT NONE
    … …  
    2627  include "paramet.h"
    2728  include "comgeom.h"
    28   include "description.h"
    2929  include "iniprint.h"
    3030!===============================================================================

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

    r5103 r5114  
    2121  USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn, itaufin, start_time
    2222  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
     23  USE lmdz_description, ONLY: descript
    2324
    2425  IMPLICIT NONE
    … …  
    2627  include "paramet.h"
    2728  include "comgeom.h"
    28   include "description.h"
    2929  include "iniprint.h"
    3030!===============================================================================
    … …  
    174174                          err, modname, fil, msg
    175175  USE temps_mod, ONLY: itau_dyn, itaufin
     176  USE lmdz_description, ONLY: descript
    176177 
    177178  IMPLICIT NONE
    178179  include "dimensions.h"
    179180  include "paramet.h"
    180   include "description.h"
    181181  include "comgeom.h"
    182182  include "iniprint.h"

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

    r5106 r5114  
    2525  USE mod_xios_dyn3dmem, ONLY: xios_dyn3dmem_init
    2626  USE lmdz_filtreg, ONLY: inifilr
     27  USE lmdz_description, ONLY: descript
    2728
    2829  IMPLICIT NONE
    … …  
    6162  include "comdissnew.h"
    6263  include "comgeom.h"
    63   include "description.h"
    6464  include "iniprint.h"
    6565  include "tracstoke.h"

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

    r5113 r5114  
    1515   USE comvert_mod, ONLY: presnivs
    1616   USE temps_mod, ONLY: itau_dyn
     17   USE lmdz_description, ONLY: descript
    1718
    1819   IMPLICIT NONE
    … …  
    4647  include "paramet.h"
    4748  include "comgeom.h"
    48   include "description.h"
    4949  include "iniprint.h"
    5050

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

    r5113 r5114  
    1 
    21! $Id$
    32
    4 SUBROUTINE initfluxsto_p &
    5         (infile,tstep,t_ops,t_wrt, &
    6         fileid,filevid,filedid)
    7 
    8   ! This routine needs IOIPSL
    9    USE IOIPSL
    10    USE parallel_lmdz
    11    use Write_field
    12    use misc_mod
    13    USE comconst_mod, ONLY: pi
    14    USE comvert_mod, ONLY: nivsigs
    15    USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn
     3SUBROUTINE initfluxsto_p(infile, tstep, t_ops, t_wrt, fileid, filevid, filedid)
     4  USE IOIPSL
     5  USE parallel_lmdz
     6  use Write_field
     7  use misc_mod
     8  USE comconst_mod, ONLY: pi
     9  USE comvert_mod, ONLY: nivsigs
     10  USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn
     11  USE lmdz_description, ONLY: descript
    1612
    1713  IMPLICIT NONE
    … …  
    4743  include "paramet.h"
    4844  include "comgeom.h"
    49   include "description.h"
    5045  include "iniprint.h"
    5146
    5247  !   Arguments
    5348  !
    54   character(len=*) :: infile
     49  character(len = *) :: infile
    5550  real :: tstep, t_ops, t_wrt
    56   integer :: fileid, filevid,filedid
     51  integer :: fileid, filevid, filedid
    5752
    5853  ! This routine needs IOIPSL
    … …  
    6257  integer :: tau0
    6358  real :: zjulian
    64   character(len=3) :: str
    65   character(len=10) :: ctrac
     59  character(len = 3) :: str
     60  character(len = 10) :: ctrac
    6661  integer :: iq
    67   real :: rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
    68   integer :: uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
    69   integer :: ii,jj
     62  real :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1)
     63  integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
     64  integer :: ii, jj
    7065  integer :: zan, idayref
    7166  logical :: ok_sync
    72   integer :: jjb,jje,jjn
     67  integer :: jjb, jje, jjn
    7368
    7469  ! definition du domaine d'ecriture pour le rebuild
    7570
    76   INTEGER,DIMENSION(2) :: ddid
    77   INTEGER,DIMENSION(2) :: dsg
    78   INTEGER,DIMENSION(2) :: dsl
    79   INTEGER,DIMENSION(2) :: dpf
    80   INTEGER,DIMENSION(2) :: dpl
    81   INTEGER,DIMENSION(2) :: dhs
    82   INTEGER,DIMENSION(2) :: dhe
     71  INTEGER, DIMENSION(2) :: ddid
     72  INTEGER, DIMENSION(2) :: dsg
     73  INTEGER, DIMENSION(2) :: dsl
     74  INTEGER, DIMENSION(2) :: dpf
     75  INTEGER, DIMENSION(2) :: dpl
     76  INTEGER, DIMENSION(2) :: dhs
     77  INTEGER, DIMENSION(2) :: dhe
    8378
    8479  INTEGER :: dynu_domain_id
    … …  
    8984  !
    9085  pi = 4. * atan (1.)
    91   str='q  '
     86  str = 'q  '
    9287  ctrac = 'traceur   '
    9388  ok_sync = .TRUE.
    … …  
    10196  tau0 = itau_dyn
    10297
    103     do jj = 1, jjp1
     98  do jj = 1, jjp1
    10499    do ii = 1, iip1
    105       rlong(ii,jj) = rlonu(ii) * 180. / pi
    106       rlat(ii,jj) = rlatu(jj) * 180. / pi
     100      rlong(ii, jj) = rlonu(ii) * 180. / pi
     101      rlat(ii, jj) = rlatu(jj) * 180. / pi
    107102    enddo
    108103  enddo
    109104
    110   jjb=jj_begin
    111   jje=jj_end
    112   jjn=jj_nb
    113 
    114   ddid=(/ 1,2 /)
    115   dsg=(/ iip1,jjp1 /)
    116   dsl=(/ iip1,jjn /)
    117   dpf=(/ 1,jjb /)
    118   dpl=(/ iip1,jje /)
    119   dhs=(/ 0,0 /)
    120   dhe=(/ 0,0 /)
    121 
    122   CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    123         'box',dynu_domain_id)
    124 
    125   CALL histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje), &
    126         1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, &
    127         fileid,dynu_domain_id)
     105  jjb = jj_begin
     106  jje = jj_end
     107  jjn = jj_nb
     108
     109  ddid = (/ 1, 2 /)
     110  dsg = (/ iip1, jjp1 /)
     111  dsl = (/ iip1, jjn /)
     112  dpf = (/ 1, jjb /)
     113  dpl = (/ iip1, jje /)
     114  dhs = (/ 0, 0 /)
     115  dhe = (/ 0, 0 /)
     116
     117  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
     118          'box', dynu_domain_id)
     119
     120  CALL histbeg(trim(infile), iip1, rlong(:, 1), jjn, rlat(1, jjb:jje), &
     121          1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, &
     122          fileid, dynu_domain_id)
    128123  !
    129124  !  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
    … …  
    131126  !  un meme fichier)
    132127
    133 
    134128  do jj = 1, jjm
    135129    do ii = 1, iip1
    136       rlong(ii,jj) = rlonv(ii) * 180. / pi
    137       rlat(ii,jj) = rlatv(jj) * 180. / pi
     130      rlong(ii, jj) = rlonv(ii) * 180. / pi
     131      rlat(ii, jj) = rlatv(jj) * 180. / pi
    138132    enddo
    139133  enddo
    140134
    141   jjb=jj_begin
    142   jje=jj_end
    143   jjn=jj_nb
    144   if (pole_sud) jje=jj_end-1
    145   if (pole_sud) jjn=jj_nb-1
    146 
    147   ddid=(/ 1,2 /)
    148   dsg=(/ iip1,jjm /)
    149   dsl=(/ iip1,jjn /)
    150   dpf=(/ 1,jjb /)
    151   dpl=(/ iip1,jje /)
    152   dhs=(/ 0,0 /)
    153   dhe=(/ 0,0 /)
    154 
    155   CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    156         'box',dynv_domain_id)
    157 
    158   CALL histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje), &
    159         1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid, &
    160         filevid,dynv_domain_id)
    161 
    162   rl(1,1) = 1.
     135  jjb = jj_begin
     136  jje = jj_end
     137  jjn = jj_nb
     138  if (pole_sud) jje = jj_end - 1
     139  if (pole_sud) jjn = jj_nb - 1
     140
     141  ddid = (/ 1, 2 /)
     142  dsg = (/ iip1, jjm /)
     143  dsl = (/ iip1, jjn /)
     144  dpf = (/ 1, jjb /)
     145  dpl = (/ iip1, jje /)
     146  dhs = (/ 0, 0 /)
     147  dhe = (/ 0, 0 /)
     148
     149  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
     150          'box', dynv_domain_id)
     151
     152  CALL histbeg('fluxstokev', iip1, rlong(:, 1), jjn, rlat(1, jjb:jje), &
     153          1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid, &
     154          filevid, dynv_domain_id)
     155
     156  rl(1, 1) = 1.
    163157
    164158  if (mpi_rank==0) then
    165159
    166160    CALL histbeg('defstoke.nc', 1, rl, 1, rl, &
    167           1, 1, 1, 1, &
    168           tau0, zjulian, tstep, dhoriid, filedid)
     161            1, 1, 1, 1, &
     162            tau0, zjulian, tstep, dhoriid, filedid)
    169163
    170164  endif
    … …  
    174168  do jj = 1, jjp1
    175169    do ii = 1, iip1
    176       rlong(ii,jj) = rlonv(ii) * 180. / pi
    177       rlat(ii,jj) = rlatu(jj) * 180. / pi
     170      rlong(ii, jj) = rlonv(ii) * 180. / pi
     171      rlat(ii, jj) = rlatu(jj) * 180. / pi
    178172    enddo
    179173  enddo
    180174
    181   jjb=jj_begin
    182   jje=jj_end
    183   jjn=jj_nb
    184 
    185   CALL histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje), &
    186         'scalar','Grille points scalaires', thoriid)
     175  jjb = jj_begin
     176  jje = jj_end
     177  jjn = jj_nb
     178
     179  CALL histhori(fileid, iip1, rlong(:, jjb:jje), jjn, rlat(:, jjb:jje), &
     180          'scalar', 'Grille points scalaires', thoriid)
    187181
    188182  !
    … …  
    190184  !
    191185  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', &
    192         'sigma_level', &
    193         llm, nivsigs, zvertiid)
     186          'sigma_level', &
     187          llm, nivsigs, zvertiid)
    194188  ! Pour le fichier V
    195189  CALL histvert(filevid, 'sig_s', 'Niveaux sigma', &
    196         'sigma_level', &
    197         llm, nivsigs, zvertiid)
     190          'sigma_level', &
     191          llm, nivsigs, zvertiid)
    198192  ! pour le fichier def
    199193  if (mpi_rank==0) then
    200      nivd(1) = 1
    201      CALL histvert(filedid, 'sig_s', 'Niveaux sigma', &
    202            'sigma_level', &
    203            1, nivd, dvertiid)
     194    nivd(1) = 1
     195    CALL histvert(filedid, 'sig_s', 'Niveaux sigma', &
     196            'sigma_level', &
     197            1, nivd, dvertiid)
    204198  endif
    205199  !
    206200  !  Appels a histdef pour la definition des variables a sauvegarder
    207201
    208     CALL histdef(fileid, "phis", "Surface geop. height", "-", &
    209           iip1,jjn,thoriid, 1,1,1, -99, 32, &
     202  CALL histdef(fileid, "phis", "Surface geop. height", "-", &
     203          iip1, jjn, thoriid, 1, 1, 1, -99, 32, &
    210204          "once", t_ops, t_wrt)
    211205
    212      CALL histdef(fileid, "aire", "Grid area", "-", &
    213            iip1,jjn,thoriid, 1,1,1, -99, 32, &
    214            "once", t_ops, t_wrt)
    215 
    216     if (mpi_rank==0) then
     206  CALL histdef(fileid, "aire", "Grid area", "-", &
     207          iip1, jjn, thoriid, 1, 1, 1, -99, 32, &
     208          "once", t_ops, t_wrt)
     209
     210  if (mpi_rank==0) then
    217211
    218212    CALL histdef(filedid, "dtvr", "tps dyn", "s", &
    219           1,1,dhoriid, 1,1,1, -99, 32, &
    220           "once", t_ops, t_wrt)
    221 
    222      CALL histdef(filedid, "istdyn", "tps stock", "s", &
    223            1,1,dhoriid, 1,1,1, -99, 32, &
    224            "once", t_ops, t_wrt)
    225 
    226      CALL histdef(filedid, "istphy", "tps stock phy", "s", &
    227            1,1,dhoriid, 1,1,1, -99, 32, &
    228            "once", t_ops, t_wrt)
    229 
    230     endif
     213            1, 1, dhoriid, 1, 1, 1, -99, 32, &
     214            "once", t_ops, t_wrt)
     215
     216    CALL histdef(filedid, "istdyn", "tps stock", "s", &
     217            1, 1, dhoriid, 1, 1, 1, -99, 32, &
     218            "once", t_ops, t_wrt)
     219
     220    CALL histdef(filedid, "istphy", "tps stock phy", "s", &
     221            1, 1, dhoriid, 1, 1, 1, -99, 32, &
     222            "once", t_ops, t_wrt)
     223
     224  endif
    231225  !
    232226  ! Masse
    233227  !
    234228  CALL histdef(fileid, 'masse', 'Masse', 'kg', &
    235         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    236         32, 'inst(X)', t_ops, t_wrt)
     229          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     230          32, 'inst(X)', t_ops, t_wrt)
    237231  !
    238232  !  Pbaru
    239233  !
    240234  CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', &
    241         iip1, jjn, uhoriid, llm, 1, llm, zvertiid, &
    242         32, 'inst(X)', t_ops, t_wrt)
     235          iip1, jjn, uhoriid, llm, 1, llm, zvertiid, &
     236          32, 'inst(X)', t_ops, t_wrt)
    243237
    244238  !
    245239  !  Pbarv
    246240  !
    247   if (pole_sud) jjn=jj_nb-1
     241  if (pole_sud) jjn = jj_nb - 1
    248242
    249243  CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', &
    250         iip1, jjn, vhoriid, llm, 1, llm, zvertiid, &
    251         32, 'inst(X)', t_ops, t_wrt)
     244          iip1, jjn, vhoriid, llm, 1, llm, zvertiid, &
     245          32, 'inst(X)', t_ops, t_wrt)
    252246  !
    253247  !  w
    254248  !
    255   if (pole_sud) jjn=jj_nb
     249  if (pole_sud) jjn = jj_nb
    256250  CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', &
    257         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    258         32, 'inst(X)', t_ops, t_wrt)
     251          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     252          32, 'inst(X)', t_ops, t_wrt)
    259253
    260254  !
    … …  
    262256  !
    263257  CALL histdef(fileid, 'teta', 'temperature potentielle', '-', &
    264         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    265         32, 'inst(X)', t_ops, t_wrt)
     258          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     259          32, 'inst(X)', t_ops, t_wrt)
    266260  !
    267261
    … …  
    270264  !
    271265  CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', &
    272         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    273         32, 'inst(X)', t_ops, t_wrt)
     266          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     267          32, 'inst(X)', t_ops, t_wrt)
    274268  !
    275269  !  Fin
    … …  
    284278  endif
    285279
    286 
    287280end subroutine initfluxsto_p

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

    r5113 r5114  
    44
    55  ! This routine needs IOIPSL
    6    USE IOIPSL
     6  USE IOIPSL
    77  USE parallel_lmdz
    8   use Write_field
    9   use misc_mod
    10   use com_io_dyn_mod, ONLY: histid, histvid, histuid, &
     8  USE Write_field
     9  USE misc_mod
     10  USE com_io_dyn_mod, ONLY: histid, histvid, histuid, &
    1111          dynhist_file, dynhistv_file, dynhistu_file
    1212  USE comconst_mod, ONLY: pi
    1313  USE comvert_mod, ONLY: presnivs
    1414  USE temps_mod, ONLY: itau_dyn
     15  USE lmdz_description, ONLY: descript
    1516
    1617  IMPLICIT NONE
    … …  
    4344  include "paramet.h"
    4445  include "comgeom.h"
    45   include "description.h"
    4646  include "iniprint.h"
    4747
    … …  
    5757  real :: zjulian
    5858  integer :: iq
    59   real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
     59  real :: rlong(iip1, jjp1), rlat(iip1, jjp1)
    6060  integer :: uhoriid, vhoriid, thoriid
    61   integer :: zvertiid,zvertiidv,zvertiidu
    62   integer :: ii,jj
     61  integer :: zvertiid, zvertiidv, zvertiidu
     62  integer :: ii, jj
    6363  integer :: zan, dayref
    64   integer :: jjb,jje,jjn
     64  integer :: jjb, jje, jjn
    6565
    6666  ! definition du domaine d'ecriture pour le rebuild
    6767
    68   INTEGER,DIMENSION(2) :: ddid
    69   INTEGER,DIMENSION(2) :: dsg
    70   INTEGER,DIMENSION(2) :: dsl
    71   INTEGER,DIMENSION(2) :: dpf
    72   INTEGER,DIMENSION(2) :: dpl
    73   INTEGER,DIMENSION(2) :: dhs
    74   INTEGER,DIMENSION(2) :: dhe
     68  INTEGER, DIMENSION(2) :: ddid
     69  INTEGER, DIMENSION(2) :: dsg
     70  INTEGER, DIMENSION(2) :: dsl
     71  INTEGER, DIMENSION(2) :: dpf
     72  INTEGER, DIMENSION(2) :: dpl
     73  INTEGER, DIMENSION(2) :: dhs
     74  INTEGER, DIMENSION(2) :: dhe
    7575
    7676  INTEGER :: dynhist_domain_id
    … …  
    9595  do jj = 1, jjp1
    9696    do ii = 1, iip1
    97       rlong(ii,jj) = rlonv(ii) * 180. / pi
    98       rlat(ii,jj) = rlatu(jj) * 180. / pi
     97      rlong(ii, jj) = rlonv(ii) * 180. / pi
     98      rlat(ii, jj) = rlatu(jj) * 180. / pi
    9999    enddo
    100100  enddo
    … …  
    105105  ! Grille Scalaire
    106106
    107   jjb=jj_begin
    108   jje=jj_end
    109   jjn=jj_nb
    110 
    111   ddid=(/ 1,2 /)
    112   dsg=(/ iip1,jjp1 /)
    113   dsl=(/ iip1,jjn /)
    114   dpf=(/ 1,jjb /)
    115   dpl=(/ iip1,jje /)
    116   dhs=(/ 0,0 /)
    117   dhe=(/ 0,0 /)
    118 
    119 
    120   CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    121         'box',dynhist_domain_id)
    122 
    123   CALL histbeg(dynhist_file,iip1, rlong(:,1), jjn, &
    124         rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
    125         zjulian, tstep, thoriid, &
    126         histid,dynhist_domain_id)
     107  jjb = jj_begin
     108  jje = jj_end
     109  jjn = jj_nb
     110
     111  ddid = (/ 1, 2 /)
     112  dsg = (/ iip1, jjp1 /)
     113  dsl = (/ iip1, jjn /)
     114  dpf = (/ 1, jjb /)
     115  dpl = (/ iip1, jje /)
     116  dhs = (/ 0, 0 /)
     117  dhe = (/ 0, 0 /)
     118
     119  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
     120          'box', dynhist_domain_id)
     121
     122  CALL histbeg(dynhist_file, iip1, rlong(:, 1), jjn, &
     123          rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, &
     124          zjulian, tstep, thoriid, &
     125          histid, dynhist_domain_id)
    127126
    128127
    … …  
    132131  ! Grille V
    133132
    134   jjb=jj_begin
    135   jje=jj_end
    136   jjn=jj_nb
    137   IF (pole_sud) jjn=jjn-1
    138   IF (pole_sud) jje=jje-1
     133  jjb = jj_begin
     134  jje = jj_end
     135  jjn = jj_nb
     136  IF (pole_sud) jjn = jjn - 1
     137  IF (pole_sud) jje = jje - 1
    139138
    140139  do jj = jjb, jje
    141140    do ii = 1, iip1
    142       rlong(ii,jj) = rlonv(ii) * 180. / pi
    143       rlat(ii,jj) = rlatv(jj) * 180. / pi
     141      rlong(ii, jj) = rlonv(ii) * 180. / pi
     142      rlat(ii, jj) = rlatv(jj) * 180. / pi
    144143    enddo
    145144  enddo
    146145
    147   ddid=(/ 1,2 /)
    148   dsg=(/ iip1,jjm /)
    149   dsl=(/ iip1,jjn /)
    150   dpf=(/ 1,jjb /)
    151   dpl=(/ iip1,jje /)
    152   dhs=(/ 0,0 /)
    153   dhe=(/ 0,0 /)
    154 
    155 
    156   CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    157         'box',dynhistv_domain_id)
    158 
    159   CALL histbeg(dynhistv_file,iip1, rlong(:,1), jjn, &
    160         rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
    161         zjulian, tstep, vhoriid, &
    162         histvid,dynhistv_domain_id)
     146  ddid = (/ 1, 2 /)
     147  dsg = (/ iip1, jjm /)
     148  dsl = (/ iip1, jjn /)
     149  dpf = (/ 1, jjb /)
     150  dpl = (/ iip1, jje /)
     151  dhs = (/ 0, 0 /)
     152  dhe = (/ 0, 0 /)
     153
     154  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
     155          'box', dynhistv_domain_id)
     156
     157  CALL histbeg(dynhistv_file, iip1, rlong(:, 1), jjn, &
     158          rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, &
     159          zjulian, tstep, vhoriid, &
     160          histvid, dynhistv_domain_id)
    163161
    164162  ! Grille U
    … …  
    166164  do jj = 1, jjp1
    167165    do ii = 1, iip1
    168       rlong(ii,jj) = rlonu(ii) * 180. / pi
    169       rlat(ii,jj) = rlatu(jj) * 180. / pi
     166      rlong(ii, jj) = rlonu(ii) * 180. / pi
     167      rlat(ii, jj) = rlatu(jj) * 180. / pi
    170168    enddo
    171169  enddo
    172170
    173   jjb=jj_begin
    174   jje=jj_end
    175   jjn=jj_nb
    176 
    177   ddid=(/ 1,2 /)
    178   dsg=(/ iip1,jjp1 /)
    179   dsl=(/ iip1,jjn /)
    180   dpf=(/ 1,jjb /)
    181   dpl=(/ iip1,jje /)
    182   dhs=(/ 0,0 /)
    183   dhe=(/ 0,0 /)
    184 
    185 
    186   CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
    187         'box',dynhistu_domain_id)
    188 
    189   CALL histbeg(dynhistu_file,iip1, rlong(:,1), jjn, &
    190         rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
    191         zjulian, tstep, uhoriid, &
    192         histuid,dynhistu_domain_id)
     171  jjb = jj_begin
     172  jje = jj_end
     173  jjn = jj_nb
     174
     175  ddid = (/ 1, 2 /)
     176  dsg = (/ iip1, jjp1 /)
     177  dsl = (/ iip1, jjn /)
     178  dpf = (/ 1, jjb /)
     179  dpl = (/ iip1, jje /)
     180  dhs = (/ 0, 0 /)
     181  dhe = (/ 0, 0 /)
     182
     183  CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, &
     184          'box', dynhistu_domain_id)
     185
     186  CALL histbeg(dynhistu_file, iip1, rlong(:, 1), jjn, &
     187          rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, &
     188          zjulian, tstep, uhoriid, &
     189          histuid, dynhistu_domain_id)
    193190
    194191
    … …  
    196193  !  Appel a histvert pour la grille verticale
    197194  ! -------------------------------------------------------------
    198   CALL histvert(histid, 'presnivs', 'Niveaux pression','mb', &
    199         llm, presnivs/100., zvertiid,'down')
    200   CALL histvert(histvid, 'presnivs', 'Niveaux pression','mb', &
    201         llm, presnivs/100., zvertiidv,'down')
    202   CALL histvert(histuid, 'presnivs', 'Niveaux pression','mb', &
    203         llm, presnivs/100., zvertiidu,'down')
     195  CALL histvert(histid, 'presnivs', 'Niveaux pression', 'mb', &
     196          llm, presnivs / 100., zvertiid, 'down')
     197  CALL histvert(histvid, 'presnivs', 'Niveaux pression', 'mb', &
     198          llm, presnivs / 100., zvertiidv, 'down')
     199  CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', &
     200          llm, presnivs / 100., zvertiidu, 'down')
    204201
    205202  !
    … …  
    210207  !  Vents U
    211208  !
    212   jjn=jj_nb
     209  jjn = jj_nb
    213210  CALL histdef(histuid, 'u', 'vent u', &
    214         'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, &
    215         32, 'inst(X)', t_ops, t_wrt)
     211          'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, &
     212          32, 'inst(X)', t_ops, t_wrt)
    216213
    217214  !
    218215  !  Vents V
    219216  !
    220   if (pole_sud) jjn=jj_nb-1
     217  if (pole_sud) jjn = jj_nb - 1
    221218  CALL histdef(histvid, 'v', 'vent v', &
    222         'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
    223         32, 'inst(X)', t_ops, t_wrt)
     219          'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
     220          32, 'inst(X)', t_ops, t_wrt)
    224221
    225222  !
    226223  !  Temperature
    227224  !
    228   jjn=jj_nb
     225  jjn = jj_nb
    229226  CALL histdef(histid, 'temp', 'temperature', 'K', &
    230         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    231         32, 'inst(X)', t_ops, t_wrt)
     227          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     228          32, 'inst(X)', t_ops, t_wrt)
    232229  !
    233230  !  Temperature potentielle
    234231  !
    235232  CALL histdef(histid, 'theta', 'temperature potentielle', 'K', &
    236         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    237         32, 'inst(X)', t_ops, t_wrt)
     233          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     234          32, 'inst(X)', t_ops, t_wrt)
    238235
    239236
    … …  
    242239  !
    243240  CALL histdef(histid, 'phi', 'geopotentiel', '-', &
    244         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    245         32, 'inst(X)', t_ops, t_wrt)
     241          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     242          32, 'inst(X)', t_ops, t_wrt)
    246243  !
    247244  !  Traceurs
    … …  
    257254  !
    258255  CALL histdef(histid, 'masse', 'masse', 'kg', &
    259         iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
    260         32, 'inst(X)', t_ops, t_wrt)
     256          iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     257          32, 'inst(X)', t_ops, t_wrt)
    261258  !
    262259  !  Pression au sol
    263260  !
    264261  CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', &
    265         iip1, jjn, thoriid, 1, 1, 1, -99, &
    266         32, 'inst(X)', t_ops, t_wrt)
     262          iip1, jjn, thoriid, 1, 1, 1, -99, &
     263          32, 'inst(X)', t_ops, t_wrt)
    267264  !
    268265  !  Geopotentiel au sol

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

    r5113 r5114  
    4040          using_xios
    4141  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO
     42  USE lmdz_description, ONLY: descript
    4243
    4344  IMPLICIT NONE
    … …  
    7879  include "comdissnew.h"
    7980  include "comgeom.h"
    80   include "description.h"
    8181  include "iniprint.h"
    8282  include "academic.h"

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

    r5113 r5114  
    1 
    21! $Id$
    32
    4       SUBROUTINE writedyn_xios( vcov, ucov,teta,ppk,phi,q, &
    5                              masse,ps,phis)
     3SUBROUTINE writedyn_xios(vcov, ucov, teta, ppk, phi, q, &
     4        masse, ps, phis)
    65
    7       USE lmdz_xios
    8       USE parallel_lmdz
    9       USE misc_mod
    10       USE infotrac, ONLY: nqtot
    11       use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid
    12       USE comconst_mod, ONLY: cpp
    13       USE temps_mod, ONLY: itau_dyn
    14       USE mod_xios_dyn3dmem, ONLY: writefield_dyn_u, writefield_dyn_v
    15      
    16       IMPLICIT NONE
     6  USE lmdz_xios
     7  USE parallel_lmdz
     8  USE misc_mod
     9  USE infotrac, ONLY: nqtot
     10  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
     11  USE comconst_mod, ONLY: cpp
     12  USE temps_mod, ONLY: itau_dyn
     13  USE mod_xios_dyn3dmem, ONLY: writefield_dyn_u, writefield_dyn_v
     14  USE lmdz_description, ONLY: descript
    1715
    18 !   Ecriture du fichier histoire au format xios
     16  IMPLICIT NONE
     17
     18  !   Ecriture du fichier histoire au format xios
    1919
    2020
    21 !   Entree:
    22 !      vcov: vents v covariants
    23 !      ucov: vents u covariants
    24 !      teta: temperature potentielle
    25 !      phi : geopotentiel instantane
    26 !      q   : traceurs
    27 !      masse: masse
    28 !      ps   :pression au sol
    29 !      phis : geopotentiel au sol
     21  !   Entree:
     22  !      vcov: vents v covariants
     23  !      ucov: vents u covariants
     24  !      teta: temperature potentielle
     25  !      phi : geopotentiel instantane
     26  !      q   : traceurs
     27  !      masse: masse
     28  !      ps   :pression au sol
     29  !      phis : geopotentiel au sol
    3030
    31 !   L. Fairhead, LMD, 03/21
     31  !   L. Fairhead, LMD, 03/21
    3232
    33 ! =====================================================================
     33  ! =====================================================================
    3434
    35 !   Declarations
    36       include "dimensions.h"
    37       include "paramet.h"
    38       include "comgeom.h"
    39       include "description.h"
    40       include "iniprint.h"
     35  !   Declarations
     36  include "dimensions.h"
     37  include "paramet.h"
     38  include "comgeom.h"
     39  include "iniprint.h"
    4140
    42 !   Arguments
     41  !   Arguments
    4342
    44       REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    45       REAL teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
    46       REAL ppk(ijb_u:ije_u,llm)                 
    47       REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)                   
    48       REAL phis(ijb_u:ije_u)                 
    49       REAL q(ijb_u:ije_u,llm,nqtot)
    50       integer time
     43  REAL vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
     44  REAL teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
     45  REAL ppk(ijb_u:ije_u, llm)
     46  REAL ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
     47  REAL phis(ijb_u:ije_u)
     48  REAL q(ijb_u:ije_u, llm, nqtot)
     49  integer time
    5150
    5251
    53 !   Variables locales
     52  !   Variables locales
    5453
    55       INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
    56       INTEGER :: iq, ii, ll
    57       REAL,SAVE,ALLOCATABLE :: tm(:,:)
    58       REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
    59       REAL,SAVE,ALLOCATABLE :: vbuffer(:,:)
    60       logical ok_sync
    61       integer itau_w
    62       integer :: ijb,ije,jjn
    63       LOGICAL,SAVE :: first=.TRUE.
    64       LOGICAL,SAVE :: debuglf=.TRUE.
    65 !$OMP THREADPRIVATE(debuglf)
    66 !$OMP THREADPRIVATE(first)
     54  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
     55  INTEGER :: iq, ii, ll
     56  REAL, SAVE, ALLOCATABLE :: tm(:, :)
     57  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
     58  REAL, SAVE, ALLOCATABLE :: vbuffer(:, :)
     59  logical ok_sync
     60  integer itau_w
     61  integer :: ijb, ije, jjn
     62  LOGICAL, SAVE :: first = .TRUE.
     63  LOGICAL, SAVE :: debuglf = .TRUE.
     64  !$OMP THREADPRIVATE(debuglf)
     65  !$OMP THREADPRIVATE(first)
    6766
    68 !  Initialisations
     67  !  Initialisations
    6968
    70 !      WRITE(*,*)'IN WRITEDYN_XIOS'
    71       IF (first) THEN
    72 !$OMP BARRIER
    73 !$OMP MASTER
    74         ALLOCATE(unat(ijb_u:ije_u,llm))
    75         ALLOCATE(vnat(ijb_v:ije_v,llm))
    76         IF (pole_sud) THEN
    77            ALLOCATE(vbuffer(ijb_v:ije_v+iip1,llm))
    78         ELSE
    79            ALLOCATE(vbuffer(ijb_v:ije_v+iip1,llm))
    80         ENDIF
    81         ALLOCATE(tm(ijb_u:ije_u,llm))
    82         ALLOCATE(ndex2d(ijnb_u*llm))
    83         ALLOCATE(ndexu(ijnb_u*llm))
    84         ALLOCATE(ndexv(ijnb_v*llm))
    85         unat = 0.; vnat = 0.; tm = 0. ;
    86         ndex2d = 0
    87         ndexu = 0
    88         ndexv = 0
    89         vbuffer=0.
    90 !$OMP END MASTER
    91 !$OMP BARRIER
    92         first=.FALSE.
    93       ENDIF
    94      
    95       ok_sync = .TRUE.
    96       itau_w = itau_dyn + time
     69  !      WRITE(*,*)'IN WRITEDYN_XIOS'
     70  IF (first) THEN
     71    !$OMP BARRIER
     72    !$OMP MASTER
     73    ALLOCATE(unat(ijb_u:ije_u, llm))
     74    ALLOCATE(vnat(ijb_v:ije_v, llm))
     75    IF (pole_sud) THEN
     76      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
     77    ELSE
     78      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
     79    ENDIF
     80    ALLOCATE(tm(ijb_u:ije_u, llm))
     81    ALLOCATE(ndex2d(ijnb_u * llm))
     82    ALLOCATE(ndexu(ijnb_u * llm))
     83    ALLOCATE(ndexv(ijnb_v * llm))
     84    unat = 0.; vnat = 0.; tm = 0. ;
     85    ndex2d = 0
     86    ndexu = 0
     87    ndexv = 0
     88    vbuffer = 0.
     89    !$OMP END MASTER
     90    !$OMP BARRIER
     91    first = .FALSE.
     92  ENDIF
    9793
    98 ! Passage aux composantes naturelles du vent
    99       CALL covnat_loc(llm, ucov, vcov, unat, vnat)
     94  ok_sync = .TRUE.
     95  itau_w = itau_dyn + time
    10096
    101 !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     97  ! Passage aux composantes naturelles du vent
     98  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
    10299
    103 !  Vents U
     100  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
    104101
    105       ijb=ij_begin
    106       ije=ij_end
    107       jjn=jj_nb
    108      
    109       CALL writefield_dyn_u('U', unat(ijb:ije,:))
     102  !  Vents U
    110103
    111 !  Vents V
     104  ijb = ij_begin
     105  ije = ij_end
     106  jjn = jj_nb
    112107
    113       ije=ij_end
    114       IF (pole_sud) THEN
    115          jjn=jj_nb-1
    116          ije=ij_end-iip1
    117       ENDIF
    118       vbuffer(ijb:ije,:)=vnat(ijb:ije,:)
     108  CALL writefield_dyn_u('U', unat(ijb:ije, :))
    119109
     110  !  Vents V
    120111
    121       IF (pole_sud) THEN
    122          CALL writefield_dyn_v('V', vbuffer(ijb:ije+iip1,:))
    123       ELSE
    124          CALL writefield_dyn_v('V', vbuffer(ijb:ije,:))
    125       ENDIF
     112  ije = ij_end
     113  IF (pole_sud) THEN
     114    jjn = jj_nb - 1
     115    ije = ij_end - iip1
     116  ENDIF
     117  vbuffer(ijb:ije, :) = vnat(ijb:ije, :)
    126118
    127 !  Temperature potentielle moyennee
     119  IF (pole_sud) THEN
     120    CALL writefield_dyn_v('V', vbuffer(ijb:ije + iip1, :))
     121  ELSE
     122    CALL writefield_dyn_v('V', vbuffer(ijb:ije, :))
     123  ENDIF
    128124
    129       ijb=ij_begin
    130       ije=ij_end
    131       jjn=jj_nb
    132      CALL writefield_dyn_u('THETA', teta(ijb:ije,:))
     125  !  Temperature potentielle moyennee
    133126
    134 !  Temperature moyennee
     127  ijb = ij_begin
     128  ije = ij_end
     129  jjn = jj_nb
     130  CALL writefield_dyn_u('THETA', teta(ijb:ije, :))
    135131
    136 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    137       do ll=1,llm
    138         do ii = ijb, ije
    139           tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
    140         enddo
    141       enddo
    142 !$OMP ENDDO
    143       CALL writefield_dyn_u('TEMP', tm(ijb:ije,:))
     132  !  Temperature moyennee
    144133
    145 !  Geopotentiel
     134  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     135  do ll = 1, llm
     136    do ii = ijb, ije
     137      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
     138    enddo
     139  enddo
     140  !$OMP ENDDO
     141  CALL writefield_dyn_u('TEMP', tm(ijb:ije, :))
    146142
    147       CALL writefield_dyn_u('PHI', phi(ijb:ije,:))
     143  !  Geopotentiel
    148144
    149 ! Tracers?
     145  CALL writefield_dyn_u('PHI', phi(ijb:ije, :))
    150146
    151 !        DO iq=1,nqtot
    152 !        ENDDO
     147  ! Tracers?
    153148
    154 !  Masse
     149  !        DO iq=1,nqtot
     150  !        ENDDO
    155151
    156       CALL writefield_dyn_u('MASSE', masse(ijb:ije,:))
     152  !  Masse
    157153
    158 !  Pression au sol
     154  CALL writefield_dyn_u('MASSE', masse(ijb:ije, :))
    159155
    160       CALL writefield_dyn_u('PS', ps(ijb:ije))
     156  !  Pression au sol
    161157
    162       END
     158  CALL writefield_dyn_u('PS', ps(ijb:ije))
     159
     160END

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

    r5113 r5114  
    1 
    21! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    32
    4 SUBROUTINE writedynav_loc( time, vcov, ucov,teta,ppk,phi,q, &
    5         masse,ps,phis)
     3SUBROUTINE writedynav_loc(time, vcov, ucov, teta, ppk, phi, q, &
     4        masse, ps, phis)
    65
    76  ! This routine needs IOIPSL
    … …  
    109  USE misc_mod
    1110  USE infotrac, ONLY: nqtot
    12   use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid
     11  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
    1312  USE comconst_mod, ONLY: cpp
    1413  USE temps_mod, ONLY: itau_dyn
     14  USE lmdz_description, ONLY: descript
    1515
    1616  IMPLICIT NONE
    … …  
    4545  include "paramet.h"
    4646  include "comgeom.h"
    47   include "description.h"
    4847  include "iniprint.h"
    4948
    … …  
    5251  !
    5352
    54   REAL :: vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    55   REAL :: teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
    56   REAL :: ppk(ijb_u:ije_u,llm)
    57   REAL :: ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)
     53  REAL :: vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
     54  REAL :: teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
     55  REAL :: ppk(ijb_u:ije_u, llm)
     56  REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
    5857  REAL :: phis(ijb_u:ije_u)
    59   REAL :: q(ijb_u:ije_u,llm,nqtot)
     58  REAL :: q(ijb_u:ije_u, llm, nqtot)
    6059  integer :: time
    6160
    … …  
    6463  !   Variables locales
    6564  !
    66   INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
     65  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
    6766  INTEGER :: iq, ii, ll
    68   REAL,SAVE,ALLOCATABLE :: tm(:,:)
    69   REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
     67  REAL, SAVE, ALLOCATABLE :: tm(:, :)
     68  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
    7069  logical :: ok_sync
    7170  integer :: itau_w
    72   integer :: ijb,ije,jjn
    73   LOGICAL,SAVE :: first=.TRUE.
    74 !$OMP THREADPRIVATE(first)
     71  integer :: ijb, ije, jjn
     72  LOGICAL, SAVE :: first = .TRUE.
     73  !$OMP THREADPRIVATE(first)
    7574
    7675  !
    … …  
    8079
    8180  IF (first) THEN
    82 !$OMP BARRIER
    83 !$OMP MASTER
    84     ALLOCATE(unat(ijb_u:ije_u,llm))
    85     ALLOCATE(vnat(ijb_v:ije_v,llm))
    86     ALLOCATE(tm(ijb_u:ije_u,llm))
    87     ALLOCATE(ndex2d(ijnb_u*llm))
    88     ALLOCATE(ndexu(ijnb_u*llm))
    89     ALLOCATE(ndexv(ijnb_v*llm))
     81    !$OMP BARRIER
     82    !$OMP MASTER
     83    ALLOCATE(unat(ijb_u:ije_u, llm))
     84    ALLOCATE(vnat(ijb_v:ije_v, llm))
     85    ALLOCATE(tm(ijb_u:ije_u, llm))
     86    ALLOCATE(ndex2d(ijnb_u * llm))
     87    ALLOCATE(ndexu(ijnb_u * llm))
     88    ALLOCATE(ndexv(ijnb_v * llm))
    9089    ndex2d = 0
    9190    ndexu = 0
    9291    ndexv = 0
    93 !$OMP END MASTER
    94 !$OMP BARRIER
    95     first=.FALSE.
     92    !$OMP END MASTER
     93    !$OMP BARRIER
     94    first = .FALSE.
    9695  ENDIF
    9796
    … …  
    108107  !
    109108
    110 !$OMP BARRIER
    111 !$OMP MASTER
    112   ijb=ij_begin
    113   ije=ij_end
    114   jjn=jj_nb
    115 
    116   CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:), &
    117         iip1*jjn*llm, ndexu)
    118 !$OMP END MASTER
     109  !$OMP BARRIER
     110  !$OMP MASTER
     111  ijb = ij_begin
     112  ije = ij_end
     113  jjn = jj_nb
     114
     115  CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije, :), &
     116          iip1 * jjn * llm, ndexu)
     117  !$OMP END MASTER
    119118
    120119  !
    121120  !  Vents V
    122121  !
    123   ije=ij_end
    124   if (pole_sud) jjn=jj_nb-1
    125   if (pole_sud) ije=ij_end-iip1
    126 !$OMP BARRIER
    127 !$OMP MASTER
    128   CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:), &
    129         iip1*jjn*llm, ndexv)
    130 !$OMP END MASTER
     122  ije = ij_end
     123  if (pole_sud) jjn = jj_nb - 1
     124  if (pole_sud) ije = ij_end - iip1
     125  !$OMP BARRIER
     126  !$OMP MASTER
     127  CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije, :), &
     128          iip1 * jjn * llm, ndexv)
     129  !$OMP END MASTER
    131130
    132131
    … …  
    134133  !  Temperature potentielle moyennee
    135134  !
    136   ijb=ij_begin
    137   ije=ij_end
    138   jjn=jj_nb
    139 !$OMP MASTER
    140   CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:), &
    141         iip1*jjn*llm, ndexu)
    142 !$OMP END MASTER
     135  ijb = ij_begin
     136  ije = ij_end
     137  jjn = jj_nb
     138  !$OMP MASTER
     139  CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije, :), &
     140          iip1 * jjn * llm, ndexu)
     141  !$OMP END MASTER
    143142
    144143  !
    … …  
    146145  !
    147146
    148 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    149   do ll=1,llm
     147  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     148  do ll = 1, llm
    150149    do ii = ijb, ije
    151       tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
     150      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
    152151    enddo
    153152  enddo
    154 !$OMP ENDDO
    155 
    156 !$OMP MASTER
    157   CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:), &
    158         iip1*jjn*llm, ndexu)
    159 !$OMP END MASTER
     153  !$OMP ENDDO
     154
     155  !$OMP MASTER
     156  CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije, :), &
     157          iip1 * jjn * llm, ndexu)
     158  !$OMP END MASTER
    160159
    161160
    … …  
    163162  !  Geopotentiel
    164163  !
    165 !$OMP MASTER
    166   CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:), &
    167         iip1*jjn*llm, ndexu)
    168 !$OMP END MASTER
     164  !$OMP MASTER
     165  CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije, :), &
     166          iip1 * jjn * llm, ndexu)
     167  !$OMP END MASTER
    169168
    170169
    … …  
    183182  !  Masse
    184183  !
    185 !$OMP MASTER
    186    CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:), &
    187          iip1*jjn*llm, ndexu)
    188 !$OMP END MASTER
     184  !$OMP MASTER
     185  CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije, :), &
     186          iip1 * jjn * llm, ndexu)
     187  !$OMP END MASTER
    189188
    190189
    … …  
    192191  !  Pression au sol
    193192  !
    194 !$OMP MASTER
    195 
    196    CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), &
    197          iip1*jjn, ndex2d)
    198 !$OMP END MASTER
     193  !$OMP MASTER
     194
     195  CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), &
     196          iip1 * jjn, ndex2d)
     197  !$OMP END MASTER
    199198
    200199  !
    201200  !  Geopotentiel au sol
    202201  !
    203 !$OMP MASTER
    204     ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
     202  !$OMP MASTER
     203  ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
    205204  ! .                 iip1*jjn, ndex2d)
    206 !$OMP END MASTER
     205  !$OMP END MASTER
    207206
    208207  !
    209208  !  Fin
    210209  !
    211 !$OMP MASTER
     210  !$OMP MASTER
    212211  if (ok_sync) then
    213       CALL histsync(histaveid)
    214       CALL histsync(histvaveid)
    215       CALL histsync(histuaveid)
     212    CALL histsync(histaveid)
     213    CALL histsync(histvaveid)
     214    CALL histsync(histuaveid)
    216215  ENDIF
    217 !$OMP END MASTER
     216  !$OMP END MASTER
    218217end subroutine writedynav_loc

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

    r5113 r5114  
    1 
    21! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    32
    4 SUBROUTINE writehist_loc( time, vcov, ucov,teta,ppk,phi,q, &
    5         masse,ps,phis)
    6 
    7   ! This routine needs IOIPSL
     3SUBROUTINE writehist_loc(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
    84  USE ioipsl
    95  USE parallel_lmdz
    106  USE misc_mod
    117  USE infotrac, ONLY: nqtot
    12   use com_io_dyn_mod, ONLY: histid,histvid,histuid
     8  use com_io_dyn_mod, ONLY: histid, histvid, histuid
    139  USE comconst_mod, ONLY: cpp
    1410  USE temps_mod, ONLY: itau_dyn
     11  USE lmdz_description, ONLY: descript
    1512
    1613  IMPLICIT NONE
    … …  
    4542  include "paramet.h"
    4643  include "comgeom.h"
    47   include "description.h"
    4844  include "iniprint.h"
    4945
    … …  
    5248  !
    5349
    54   REAL :: vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    55   REAL :: teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
    56   REAL :: ppk(ijb_u:ije_u,llm)
    57   REAL :: ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)
     50  REAL :: vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
     51  REAL :: teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
     52  REAL :: ppk(ijb_u:ije_u, llm)
     53  REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
    5854  REAL :: phis(ijb_u:ije_u)
    59   REAL :: q(ijb_u:ije_u,llm,nqtot)
     55  REAL :: q(ijb_u:ije_u, llm, nqtot)
    6056  integer :: time
    6157
    … …  
    6460  !   Variables locales
    6561  !
    66   INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
     62  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
    6763  INTEGER :: iq, ii, ll
    68   REAL,SAVE,ALLOCATABLE :: tm(:,:)
    69   REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
     64  REAL, SAVE, ALLOCATABLE :: tm(:, :)
     65  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
    7066  logical :: ok_sync
    7167  integer :: itau_w
    72   integer :: ijb,ije,jjn
    73   LOGICAL,SAVE :: first=.TRUE.
    74 !$OMP THREADPRIVATE(first)
     68  integer :: ijb, ije, jjn
     69  LOGICAL, SAVE :: first = .TRUE.
     70  !$OMP THREADPRIVATE(first)
    7571
    7672  !
    … …  
    8076
    8177  IF (first) THEN
    82 !$OMP BARRIER
    83 !$OMP MASTER
    84     ALLOCATE(unat(ijb_u:ije_u,llm))
    85     ALLOCATE(vnat(ijb_v:ije_v,llm))
    86     ALLOCATE(tm(ijb_u:ije_u,llm))
    87     ALLOCATE(ndex2d(ijnb_u*llm))
    88     ALLOCATE(ndexu(ijnb_u*llm))
    89     ALLOCATE(ndexv(ijnb_v*llm))
     78    !$OMP BARRIER
     79    !$OMP MASTER
     80    ALLOCATE(unat(ijb_u:ije_u, llm))
     81    ALLOCATE(vnat(ijb_v:ije_v, llm))
     82    ALLOCATE(tm(ijb_u:ije_u, llm))
     83    ALLOCATE(ndex2d(ijnb_u * llm))
     84    ALLOCATE(ndexu(ijnb_u * llm))
     85    ALLOCATE(ndexv(ijnb_v * llm))
    9086    ndex2d = 0
    9187    ndexu = 0
    9288    ndexv = 0
    93 !$OMP END MASTER
    94 !$OMP BARRIER
    95     first=.FALSE.
     89    !$OMP END MASTER
     90    !$OMP BARRIER
     91    first = .FALSE.
    9692  ENDIF
    9793
    … …  
    108104  !
    109105
    110 !$OMP BARRIER
    111 !$OMP MASTER
    112   ijb=ij_begin
    113   ije=ij_end
    114   jjn=jj_nb
    115 
    116   CALL histwrite(histuid, 'u', itau_w, unat(ijb:ije,:), &
    117         iip1*jjn*llm, ndexu)
    118 !$OMP END MASTER
     106  !$OMP BARRIER
     107  !$OMP MASTER
     108  ijb = ij_begin
     109  ije = ij_end
     110  jjn = jj_nb
     111
     112  CALL histwrite(histuid, 'u', itau_w, unat(ijb:ije, :), &
     113          iip1 * jjn * llm, ndexu)
     114  !$OMP END MASTER
    119115
    120116  !
    121117  !  Vents V
    122118  !
    123   ije=ij_end
    124   if (pole_sud) jjn=jj_nb-1
    125   if (pole_sud) ije=ij_end-iip1
    126 !$OMP BARRIER
    127 !$OMP MASTER
    128   CALL histwrite(histvid, 'v', itau_w, vnat(ijb:ije,:), &
    129         iip1*jjn*llm, ndexv)
    130 !$OMP END MASTER
     119  ije = ij_end
     120  if (pole_sud) jjn = jj_nb - 1
     121  if (pole_sud) ije = ij_end - iip1
     122  !$OMP BARRIER
     123  !$OMP MASTER
     124  CALL histwrite(histvid, 'v', itau_w, vnat(ijb:ije, :), &
     125          iip1 * jjn * llm, ndexv)
     126  !$OMP END MASTER
    131127
    132128
    … …  
    134130  !  Temperature potentielle
    135131  !
    136   ijb=ij_begin
    137   ije=ij_end
    138   jjn=jj_nb
    139 !$OMP MASTER
    140   CALL histwrite(histid, 'theta', itau_w, teta(ijb:ije,:), &
    141         iip1*jjn*llm, ndexu)
    142 !$OMP END MASTER
     132  ijb = ij_begin
     133  ije = ij_end
     134  jjn = jj_nb
     135  !$OMP MASTER
     136  CALL histwrite(histid, 'theta', itau_w, teta(ijb:ije, :), &
     137          iip1 * jjn * llm, ndexu)
     138  !$OMP END MASTER
    143139
    144140  !
    … …  
    146142  !
    147143
    148 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    149   do ll=1,llm
     144  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     145  do ll = 1, llm
    150146    do ii = ijb, ije
    151       tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
     147      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
    152148    enddo
    153149  enddo
    154 !$OMP ENDDO
    155 
    156 !$OMP MASTER
    157   CALL histwrite(histid, 'temp', itau_w, tm(ijb:ije,:), &
    158         iip1*jjn*llm, ndexu)
    159 !$OMP END MASTER
     150  !$OMP ENDDO
     151
     152  !$OMP MASTER
     153  CALL histwrite(histid, 'temp', itau_w, tm(ijb:ije, :), &
     154          iip1 * jjn * llm, ndexu)
     155  !$OMP END MASTER
    160156
    161157
    … …  
    163159  !  Geopotentiel
    164160  !
    165 !$OMP MASTER
    166   CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije,:), &
    167         iip1*jjn*llm, ndexu)
    168 !$OMP END MASTER
     161  !$OMP MASTER
     162  CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije, :), &
     163          iip1 * jjn * llm, ndexu)
     164  !$OMP END MASTER
    169165
    170166
    … …  
    183179  !  Masse
    184180  !
    185 !$OMP MASTER
    186    CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije,:), &
    187          iip1*jjn*llm, ndexu)
    188 !$OMP END MASTER
     181  !$OMP MASTER
     182  CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije, :), &
     183          iip1 * jjn * llm, ndexu)
     184  !$OMP END MASTER
    189185
    190186
    … …  
    192188  !  Pression au sol
    193189  !
    194 !$OMP MASTER
    195    CALL histwrite(histid, 'ps', itau_w, ps(ijb:ije), &
    196          iip1*jjn, ndex2d)
    197 !$OMP END MASTER
     190  !$OMP MASTER
     191  CALL histwrite(histid, 'ps', itau_w, ps(ijb:ije), &
     192          iip1 * jjn, ndex2d)
     193  !$OMP END MASTER
    198194
    199195  !
    200196  !  Geopotentiel au sol
    201197  !
    202 !$OMP MASTER
    203     ! CALL histwrite(histid, 'phis', itau_w, phis(ijb:ije),
     198  !$OMP MASTER
     199  ! CALL histwrite(histid, 'phis', itau_w, phis(ijb:ije),
    204200  ! .                 iip1*jjn, ndex2d)
    205 !$OMP END MASTER
     201  !$OMP END MASTER
    206202
    207203  !
    208204  !  Fin
    209205  !
    210 !$OMP MASTER
     206  !$OMP MASTER
    211207  if (ok_sync) then
    212208    CALL histsync(histid)
    … …  
    214210    CALL histsync(histuid)
    215211  endif
    216 !$OMP END MASTER
     212  !$OMP END MASTER
    217213end subroutine writehist_loc

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90

    r5113 r5114  
    1 module coefpoly_m
     1module lmdz_coefpoly
    22
    33  IMPLICIT NONE
    … …  
    2727    use nrtype, only: k8
    2828
    29     REAL(K8), intent(in):: xf1, xf2, xprim1, xprim2, xtild1, xtild2
    30     REAL(K8), intent(out):: a0, a1, a2, a3
     29    REAL(K8), intent(in) :: xf1, xf2, xprim1, xprim2, xtild1, xtild2
     30    REAL(K8), intent(out) :: a0, a1, a2, a3
    3131
    3232    ! Local:
    … …  
    3838    xtil2car = xtild2 * xtild2
    3939
    40     derr = 2. * (xf2-xf1)/(xtild1-xtild2)
     40    derr = 2. * (xf2 - xf1) / (xtild1 - xtild2)
    4141
    42     x1x2car = (xtild1-xtild2) * (xtild1-xtild2)
     42    x1x2car = (xtild1 - xtild2) * (xtild1 - xtild2)
    4343
    44     a3 = (derr+xprim1+xprim2)/x1x2car
    45     a2 = (xprim1-xprim2+3. * a3 * (xtil2car-xtil1car))/(2. * (xtild1-xtild2))
     44    a3 = (derr + xprim1 + xprim2) / x1x2car
     45    a2 = (xprim1 - xprim2 + 3. * a3 * (xtil2car - xtil1car)) / (2. * (xtild1 - xtild2))
    4646
    4747    a1 = xprim1 - 3. * a3 * xtil1car - 2. * a2 * xtild1
    … …  
    5050  END SUBROUTINE coefpoly
    5151
    52 end module coefpoly_m
     52end module lmdz_coefpoly

  • LMDZ6/branches/Amaury_dev/libf/misc/lmdz_description.f90

    r5105 r5114  
     1! Replaces description.h
    12
    2 ! $Header$
    3 
    4       character (len=120) :: descript
    5       common /titre/descript
     3MODULE lmdz_description
     4  IMPLICIT NONE; PRIVATE
     5  PUBLIC descript
     6  CHARACTER (LEN = 120) :: descript
     7END MODULE lmdz_description
Note: See TracChangeset for help on using the changeset viewer.