source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90 @ 5411

Last change on this file since 5411 was 5195, checked in by abarral, 3 months ago

Correct r5192, some lmdz_description cases were missing

File size: 3.5 KB
RevLine 
[4146]1! $Id$
[5099]2
[5114]3SUBROUTINE writedyn_xios(vcov, ucov, teta, ppk, phi, q, &
4        masse, ps, phis)
[4146]5
[5114]6  USE lmdz_xios
7  USE parallel_lmdz
8  USE misc_mod
[5182]9  USE lmdz_infotrac, ONLY: nqtot
[5117]10  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
[5114]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
[5118]14  USE lmdz_iniprint, ONLY: lunout, prt_level
[5136]15  USE lmdz_comgeom
[5099]16
[5159]17  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
18  USE lmdz_paramet
[5114]19  IMPLICIT NONE
[5099]20
[5114]21  !   Ecriture du fichier histoire au format xios
[5099]22
23
[5114]24  !   Entree:
25  !      vcov: vents v covariants
26  !      ucov: vents u covariants
27  !      teta: temperature potentielle
28  !      phi : geopotentiel instantane
29  !      q   : traceurs
30  !      masse: masse
31  !      ps   :pression au sol
32  !      phis : geopotentiel au sol
[5099]33
[5114]34  !   L. Fairhead, LMD, 03/21
[5099]35
[5114]36  ! =====================================================================
[4146]37
[5114]38  !   Declarations
[4146]39
[5159]40
41
[5114]42  !   Arguments
[4146]43
[5114]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)
[5117]50  INTEGER time
[4146]51
[5099]52
[5114]53  !   Variables locales
[4146]54
[5114]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(:, :)
[5117]60  LOGICAL ok_sync
61  INTEGER itau_w
[5116]62  INTEGER :: ijb, ije, jjn
[5114]63  LOGICAL, SAVE :: first = .TRUE.
64  LOGICAL, SAVE :: debuglf = .TRUE.
65  !$OMP THREADPRIVATE(debuglf)
66  !$OMP THREADPRIVATE(first)
[4146]67
[5114]68  !  Initialisations
[4146]69
[5114]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
[4146]94
[5114]95  ok_sync = .TRUE.
96  itau_w = itau_dyn + time
[5099]97
[5114]98  ! Passage aux composantes naturelles du vent
99  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
[5099]100
[5114]101  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
[4146]102
[5114]103  !  Vents U
[5099]104
[5114]105  ijb = ij_begin
106  ije = ij_end
107  jjn = jj_nb
[4146]108
[5114]109  CALL writefield_dyn_u('U', unat(ijb:ije, :))
[4146]110
[5114]111  !  Vents V
[4146]112
[5114]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, :)
[5099]119
[5114]120  IF (pole_sud) THEN
121    CALL writefield_dyn_v('V', vbuffer(ijb:ije + iip1, :))
122  ELSE
123    CALL writefield_dyn_v('V', vbuffer(ijb:ije, :))
124  ENDIF
[4146]125
[5114]126  !  Temperature potentielle moyennee
[4146]127
[5114]128  ijb = ij_begin
129  ije = ij_end
130  jjn = jj_nb
131  CALL writefield_dyn_u('THETA', teta(ijb:ije, :))
[4146]132
[5114]133  !  Temperature moyennee
[4146]134
[5114]135  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[5158]136  DO ll = 1, llm
137    DO ii = ijb, ije
[5114]138      tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp
139    enddo
140  enddo
141  !$OMP ENDDO
142  CALL writefield_dyn_u('TEMP', tm(ijb:ije, :))
[4146]143
[5114]144  !  Geopotentiel
[4146]145
[5114]146  CALL writefield_dyn_u('PHI', phi(ijb:ije, :))
[4146]147
[5114]148  ! Tracers?
[4146]149
[5114]150  !        DO iq=1,nqtot
151  !        ENDDO
[4146]152
[5114]153  !  Masse
[4146]154
[5114]155  CALL writefield_dyn_u('MASSE', masse(ijb:ije, :))
[4146]156
[5114]157  !  Pression au sol
158
159  CALL writefield_dyn_u('PS', ps(ijb:ije))
160
161END
Note: See TracBrowser for help on using the repository browser.