Ignore:
Timestamp:
Jul 24, 2024, 1:27:51 PM (2 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/dyn3dmem
Files:
11 edited

Legend:

Unmodified
Added
Removed

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