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

File:
1 edited

Legend:

Unmodified
Added
Removed

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