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

Last change on this file since 5179 was 5159, checked in by abarral, 16 months ago

Put dimensions.h and paramet.h into modules

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
9  USE 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
14  USE lmdz_description, ONLY: descript
[5118]15  USE lmdz_iniprint, ONLY: lunout, prt_level
[5136]16  USE lmdz_comgeom
[5099]17
[5159]18  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
19  USE lmdz_paramet
[5114]20  IMPLICIT NONE
[5099]21
[5114]22  !   Ecriture du fichier histoire au format xios
[5099]23
24
[5114]25  !   Entree:
26  !      vcov: vents v covariants
27  !      ucov: vents u covariants
28  !      teta: temperature potentielle
29  !      phi : geopotentiel instantane
30  !      q   : traceurs
31  !      masse: masse
32  !      ps   :pression au sol
33  !      phis : geopotentiel au sol
[5099]34
[5114]35  !   L. Fairhead, LMD, 03/21
[5099]36
[5114]37  ! =====================================================================
[4146]38
[5114]39  !   Declarations
[4146]40
[5159]41
42
[5114]43  !   Arguments
[4146]44
[5114]45  REAL vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm)
46  REAL teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm)
47  REAL ppk(ijb_u:ije_u, llm)
48  REAL ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm)
49  REAL phis(ijb_u:ije_u)
50  REAL q(ijb_u:ije_u, llm, nqtot)
[5117]51  INTEGER time
[4146]52
[5099]53
[5114]54  !   Variables locales
[4146]55
[5114]56  INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:)
57  INTEGER :: iq, ii, ll
58  REAL, SAVE, ALLOCATABLE :: tm(:, :)
59  REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :)
60  REAL, SAVE, ALLOCATABLE :: vbuffer(:, :)
[5117]61  LOGICAL ok_sync
62  INTEGER itau_w
[5116]63  INTEGER :: ijb, ije, jjn
[5114]64  LOGICAL, SAVE :: first = .TRUE.
65  LOGICAL, SAVE :: debuglf = .TRUE.
66  !$OMP THREADPRIVATE(debuglf)
67  !$OMP THREADPRIVATE(first)
[4146]68
[5114]69  !  Initialisations
[4146]70
[5114]71  !      WRITE(*,*)'IN WRITEDYN_XIOS'
72  IF (first) THEN
73    !$OMP BARRIER
74    !$OMP MASTER
75    ALLOCATE(unat(ijb_u:ije_u, llm))
76    ALLOCATE(vnat(ijb_v:ije_v, llm))
77    IF (pole_sud) THEN
78      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
79    ELSE
80      ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm))
81    ENDIF
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))
86    unat = 0.; vnat = 0.; tm = 0. ;
87    ndex2d = 0
88    ndexu = 0
89    ndexv = 0
90    vbuffer = 0.
91    !$OMP END MASTER
92    !$OMP BARRIER
93    first = .FALSE.
94  ENDIF
[4146]95
[5114]96  ok_sync = .TRUE.
97  itau_w = itau_dyn + time
[5099]98
[5114]99  ! Passage aux composantes naturelles du vent
100  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
[5099]101
[5114]102  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
[4146]103
[5114]104  !  Vents U
[5099]105
[5114]106  ijb = ij_begin
107  ije = ij_end
108  jjn = jj_nb
[4146]109
[5114]110  CALL writefield_dyn_u('U', unat(ijb:ije, :))
[4146]111
[5114]112  !  Vents V
[4146]113
[5114]114  ije = ij_end
115  IF (pole_sud) THEN
116    jjn = jj_nb - 1
117    ije = ij_end - iip1
118  ENDIF
119  vbuffer(ijb:ije, :) = vnat(ijb:ije, :)
[5099]120
[5114]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
[4146]126
[5114]127  !  Temperature potentielle moyennee
[4146]128
[5114]129  ijb = ij_begin
130  ije = ij_end
131  jjn = jj_nb
132  CALL writefield_dyn_u('THETA', teta(ijb:ije, :))
[4146]133
[5114]134  !  Temperature moyennee
[4146]135
[5114]136  !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[5158]137  DO ll = 1, llm
138    DO ii = ijb, ije
[5114]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, :))
[4146]144
[5114]145  !  Geopotentiel
[4146]146
[5114]147  CALL writefield_dyn_u('PHI', phi(ijb:ije, :))
[4146]148
[5114]149  ! Tracers?
[4146]150
[5114]151  !        DO iq=1,nqtot
152  !        ENDDO
[4146]153
[5114]154  !  Masse
[4146]155
[5114]156  CALL writefield_dyn_u('MASSE', masse(ijb:ije, :))
[4146]157
[5114]158  !  Pression au sol
159
160  CALL writefield_dyn_u('PS', ps(ijb:ije))
161
162END
Note: See TracBrowser for help on using the repository browser.