source: LMDZ6/trunk/libf/dyn3dmem/mod_xios_dyn3dmem.F90 @ 4643

Last change on this file since 4643 was 4619, checked in by yann meurdesoif, 17 months ago

Suppress usage of preprocessing key CPP_XIOS.
Wrapper file is used to suppress XIOS symbol when xios is not linked and not used (-io ioipsl)
The CPP_XIOS key is replaced in model by "using_xios" boolean variable to switch between IOIPSL or XIOS output.

YM

File size: 7.1 KB
RevLine 
[4146]1!
2! $Id$
3!
4! This module contains the interface between the LMDZ dynamics dyn3dmem module and XIOS.
5!
6! Lists of subroutines
7!      xios_dyn3dmem_init : context / calendar / domain / axis initialisations
8!
9! Initialisation of communicator between LMDZ and XIOS is done elsewhere: wxios_init called by init_const_mpi
10!                                                                         (one of the first calls in gcm.F90)
11! L. Fairhead 11/2017
12!
13!
14
15MODULE mod_xios_dyn3dmem
16
[4619]17     USE lmdz_xios
[4146]18     USE wxios, ONLY : g_comm
19     CHARACTER(len=100), SAVE :: dyn3d_ctx_name = "LMDZDYN"
20     TYPE(xios_context), SAVE :: dyn3d_ctx_handle
21!$OMP THREADPRIVATE(dyn3d_ctx_name, dyn3d_ctx_handle)
22 
23  INTERFACE writefield_dyn_u
24     MODULE PROCEDURE writefield_dyn1d_u, writefield_dyn2d_u
25  END INTERFACE writefield_dyn_u
26
27  INTERFACE writefield_dyn_v
28     MODULE PROCEDURE writefield_dyn1d_v, writefield_dyn2d_v
29  END INTERFACE writefield_dyn_v
[4371]30
31     REAL, ALLOCATABLE, SAVE :: NewField_U(:,:,:), NewField_V(:,:,:)
[4146]32 
33
34   CONTAINS
35
36   SUBROUTINE xios_dyn3dmem_init(xios_cal_type, anref, moisref, jourref,heureref, an, mois, jour, heure, zdtvr)
37
38
39     USE comvert_mod, ONLY: presnivs
40     USE parallel_lmdz
41
42     IMPLICIT NONE
43
44     INCLUDE 'dimensions.h'
45     INCLUDE "paramet.h"
46     INCLUDE 'comgeom.h'
47
48     TYPE(xios_duration) :: tstep_xios
49     TYPE(xios_date)                :: start_date
50     TYPE(xios_date)                :: time_origin
51     INTEGER :: an, mois, jour
52     REAL :: heure
53     CHARACTER (len=10) :: xios_cal_type
54     INTEGER :: anref, moisref, jourref
55     REAL :: heureref
56     REAL :: zdtvr
57     TYPE(xios_domain) :: dom_grid_U, dom_grid_V, dom_grid_T
58     REAL :: rlong(iip1), rlat(jjp1)
59     REAL :: pi
60     INTEGER :: ii, jj, jjb, jje, jjn
61
62!      WRITE(*,*)'Entree mod_xios_dyn3dmem'
63
64! 0 Initialisations
65     pi = 4. * ATAN (1.)
[4371]66! allocation of fields passed to xios
67!$OMP BARRIER
68!$OMP MASTER
69     allocate(NewField_U(iip1, jj_begin:jj_end, llm))
70     allocate(NewField_V(iip1, jj_begin:jj_end, llm))     
71!$OMP END MASTER
72!$OMP BARRIER
[4146]73
74! 1 Context initialisation
75!$OMP MASTER
76     CALL xios_context_initialize(dyn3d_ctx_name, g_comm)
77     CALL xios_get_handle(dyn3d_ctx_name, dyn3d_ctx_handle)
78     CALL xios_set_current_context(dyn3d_ctx_handle) 
79
80!     WRITE(*,*)'apres context initialisation mod_xios_dyn3dmem'
81
82! 2 calendar stuff
83
84     tstep_xios%second=zdtvr
85     CALL xios_define_calendar(type=xios_cal_type, start_date=xios_date(an, mois, jour,INT(heure),0,0), &
86            time_origin=xios_date(anref,moisref,jourref,INT(heureref),0,0), timestep=tstep_xios)
87
88!     WRITE(*,*)'apres  calendrier mod_xios_dyn3dmem'
89
90! 3 domain / grids / axis
91! Domains:
92      rlong(:) = rlonu(:) * 180. / pi
93      rlat(:) = rlatu(:) * 180. / pi
94
95      CALL xios_set_domain_attr("domain_U", ni_glo=iip1, nj_glo=jjp1,          &
96          type="rectilinear",ibegin=0, ni=iip1, jbegin=jj_begin-1, nj=jj_nb,   &
97          data_dim = 2, lonvalue_1d=rlong(1:iip1), latvalue_1d=rlat(jj_begin:jj_end))
98
99      jjb=jj_begin
100      jje=jj_end
101      jjn=jj_nb
102      IF (pole_sud) jjn=jjn-1
103      IF (pole_sud) jje=jje-1
104
105
106      rlong(:) = rlonv(:) * 180. / pi
107      do jj = jjb, jje
108        rlat(jj) = rlatv(jj) * 180. / pi
109      enddo
110     
111      CALL xios_set_domain_attr("domain_V", ni_glo=iip1, nj_glo=jjm,            &
112          type="rectilinear",ibegin=0, ni=iip1, jbegin=jj_begin-1, nj=jjn,   &
113          data_dim = 2, lonvalue_1d=rlong(1:iip1), latvalue_1d=rlat(jjb:jje))
114
115
116      rlong(:) = rlonv(:) * 180. / pi
117      rlat(:) = rlatu(:) * 180. / pi
118      CALL xios_set_domain_attr("domain_T", ni_glo=iip1, nj_glo=jjp1,          &
119          type="rectilinear",ibegin=0, ni=iip1, jbegin=jj_begin-1, nj=jj_nb,   &
120          data_dim = 2, lonvalue_1d=rlong(1:iip1), latvalue_1d=rlat(jj_begin:jj_end))
121     
122!     WRITE(*,*)'apres  domaine mod_xios_dyn3dmem'
123! Vertical axis
124       CALL xios_set_axis_attr("presnivs",n_glo=llm,value=presnivs)
125!     WRITE(*,*)'apres  vertical axis mod_xios_dyn3dmem'
126! 4 end of context definition
127       CALL xios_close_context_definition()
128!     WRITE(*,*)'apres close context init. axis mod_xios_dyn3dmem'
129!$OMP END MASTER
130   END SUBROUTINE xios_dyn3dmem_init
131
132   SUBROUTINE  writefield_dyn1d_u(name,Field)
133
134     USE parallel_lmdz
135     IMPLICIT NONE
136     include 'dimensions.h'
137     include 'paramet.h'
138     CHARACTER(LEN=*)   :: name
139     REAL, DIMENSION(ij_begin:ij_end) :: Field
140     REAL, DIMENSION(iip1,  jj_begin:jj_end) :: NewField
141      LOGICAL,SAVE :: debuglf=.true.
142!$OMP THREADPRIVATE(debuglf)
143     
144     NewField(:,jj_begin:jj_end)=reshape(Field(ij_begin:ij_end),(/iip1,jj_nb/))
145
146!$OMP BARRIER       
147!$OMP MASTER
148     CALL xios_send_field(name, NewField)
149!$OMP END MASTER   
150 
151   END SUBROUTINE  writefield_dyn1d_u
152
153   SUBROUTINE  writefield_dyn2d_u(name,Field)
154
155     USE parallel_lmdz
156     IMPLICIT NONE
157     include 'dimensions.h'
158     include 'paramet.h'
159     CHARACTER(LEN=*)   :: name
160     REAL, DIMENSION(ij_begin:ij_end,llm) :: Field
[4371]161!     REAL, ALLOCATABLE, SAVE :: NewField(:,:,:)
[4146]162     INTEGER :: i,j,l, count
163
[4371]164!!!!!$OMP BARRIER
165!!!!!$OMP MASTER
166!!!!     allocate(NewField(iip1, jj_begin:jj_end, llm))
167!!!!!$OMP END MASTER
168!!!!!$OMP BARRIER
169
170
171!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[4146]172     DO l = 1, llm
[4371]173       NewField_U(:,jj_begin:jj_end,l)=reshape(Field(ij_begin:ij_end,l),(/iip1,jj_nb/))
[4146]174     ENDDO
175!$OMP ENDDO
176!$OMP BARRIER
177
178!$OMP MASTER
[4371]179     CALL xios_send_field(name, NewField_U)
180!!!!     DEALLOCATE(NewField)
[4146]181!$OMP END MASTER   
[4371]182!$OMP BARRIER
[4146]183 
184   END SUBROUTINE  writefield_dyn2d_u
185
186   SUBROUTINE  writefield_dyn1d_v(name,Field)
187
188     USE parallel_lmdz
189     IMPLICIT NONE
190     include 'dimensions.h'
191     include 'paramet.h'
192     CHARACTER(LEN=*)   :: name
193     REAL, DIMENSION(ij_begin:ij_end) :: Field
194     REAL, DIMENSION(iip1,  jj_begin:jj_end) :: NewField
195     INTEGER ::  jje, ije, jjn
196
197     IF (pole_sud) THEN
198       jje=jj_end-1
199       ije=ij_end-iip1
200       jjn=jj_nb-1
201     ELSE
202       jje=jj_end
203       ije=ij_end
204       jjn=jj_nb
205     ENDIF
206
207     NewField(:,jj_begin:jje)=reshape(Field(ij_begin:ije),(/iip1,jjn/))
208
209!$OMP BARRIER       
210!$OMP MASTER
211     CALL xios_send_field(name, NewField(:,jj_begin:jje))
212!$OMP END MASTER   
213 
214   END SUBROUTINE  writefield_dyn1d_v
215
216   SUBROUTINE  writefield_dyn2d_v(name,Field)
217
218     USE parallel_lmdz
219     IMPLICIT NONE
220     include 'dimensions.h'
221     include 'paramet.h'
222     CHARACTER(LEN=*)   :: name
223     REAL, DIMENSION(ij_begin:ij_end,llm) :: Field
[4371]224!!!!     REAL, ALLOCATABLE, SAVE :: NewField(:,:,:)
[4146]225     INTEGER :: l, jje, ije, jjn
226
[4371]227!!!!!$OMP BARRIER
228!!!!!$OMP MASTER
229!!!!     allocate(NewField(iip1,  jj_begin:jj_end,llm))
230!!!!!$OMP END MASTER
231!!!!!$OMP BARRIER
232
[4146]233     IF (pole_sud) THEN
234       jje=jj_end-1
235       ije=ij_end-iip1
236       jjn=jj_nb-1
237     ELSE
238       jje=jj_end
239       ije=ij_end
240       jjn=jj_nb
241     ENDIF
242
243
244!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
245     DO l = 1, llm
[4371]246        NewField_V(:,jj_begin:jje,l)=reshape(Field(ij_begin:ije,l),(/iip1,jjn/))
[4146]247     ENDDO
248!$OMP ENDDO
[4371]249!$OMP BARRIER       
[4146]250
251!$OMP MASTER
[4371]252     CALL xios_send_field(name, NewField_V(:,jj_begin:jje,:))
253!!!!     DEALLOCATE(NewField)
[4146]254!$OMP END MASTER   
[4371]255!$OMP BARRIER
[4146]256 
257   END SUBROUTINE  writefield_dyn2d_v
258   
259END MODULE mod_xios_dyn3dmem
260
Note: See TracBrowser for help on using the repository browser.