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

Last change on this file since 5118 was 5118, checked in by abarral, 4 months ago

Replace iniprint.h by lmdz_iniprint.f90
(lint) along the way

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
[5099]16
[5114]17  IMPLICIT NONE
[5099]18
[5114]19  !   Ecriture du fichier histoire au format xios
[5099]20
21
[5114]22  !   Entree:
23  !      vcov: vents v covariants
24  !      ucov: vents u covariants
25  !      teta: temperature potentielle
26  !      phi : geopotentiel instantane
27  !      q   : traceurs
28  !      masse: masse
29  !      ps   :pression au sol
30  !      phis : geopotentiel au sol
[5099]31
[5114]32  !   L. Fairhead, LMD, 03/21
[5099]33
[5114]34  ! =====================================================================
[4146]35
[5114]36  !   Declarations
37  include "dimensions.h"
38  include "paramet.h"
39  include "comgeom.h"
[4146]40
[5114]41  !   Arguments
[4146]42
[5114]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)
[5117]49  INTEGER time
[4146]50
[5099]51
[5114]52  !   Variables locales
[4146]53
[5114]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(:, :)
[5117]59  LOGICAL ok_sync
60  INTEGER itau_w
[5116]61  INTEGER :: ijb, ije, jjn
[5114]62  LOGICAL, SAVE :: first = .TRUE.
63  LOGICAL, SAVE :: debuglf = .TRUE.
64  !$OMP THREADPRIVATE(debuglf)
65  !$OMP THREADPRIVATE(first)
[4146]66
[5114]67  !  Initialisations
[4146]68
[5114]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
[4146]93
[5114]94  ok_sync = .TRUE.
95  itau_w = itau_dyn + time
[5099]96
[5114]97  ! Passage aux composantes naturelles du vent
98  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
[5099]99
[5114]100  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
[4146]101
[5114]102  !  Vents U
[5099]103
[5114]104  ijb = ij_begin
105  ije = ij_end
106  jjn = jj_nb
[4146]107
[5114]108  CALL writefield_dyn_u('U', unat(ijb:ije, :))
[4146]109
[5114]110  !  Vents V
[4146]111
[5114]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, :)
[5099]118
[5114]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
[4146]124
[5114]125  !  Temperature potentielle moyennee
[4146]126
[5114]127  ijb = ij_begin
128  ije = ij_end
129  jjn = jj_nb
130  CALL writefield_dyn_u('THETA', teta(ijb:ije, :))
[4146]131
[5114]132  !  Temperature moyennee
[4146]133
[5114]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, :))
[4146]142
[5114]143  !  Geopotentiel
[4146]144
[5114]145  CALL writefield_dyn_u('PHI', phi(ijb:ije, :))
[4146]146
[5114]147  ! Tracers?
[4146]148
[5114]149  !        DO iq=1,nqtot
150  !        ENDDO
[4146]151
[5114]152  !  Masse
[4146]153
[5114]154  CALL writefield_dyn_u('MASSE', masse(ijb:ije, :))
[4146]155
[5114]156  !  Pression au sol
157
158  CALL writefield_dyn_u('PS', ps(ijb:ije))
159
160END
Note: See TracBrowser for help on using the repository browser.