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

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

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d_common
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • 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
Note: See TracChangeset for help on using the changeset viewer.