! ! $Id$ ! ! This module contains the interface between the LMDZ dynamics dyn3dmem module and XIOS. ! ! Lists of subroutines ! xios_dyn3dmem_init : context / calendar / domain / axis initialisations ! ! Initialisation of communicator between LMDZ and XIOS is done elsewhere: wxios_init called by init_const_mpi ! (one of the first calls in gcm.F90) ! L. Fairhead 11/2017 ! ! MODULE mod_xios_dyn3dmem USE lmdz_xios USE wxios, ONLY : g_comm CHARACTER(len=100), SAVE :: dyn3d_ctx_name = "LMDZDYN" TYPE(xios_context), SAVE :: dyn3d_ctx_handle !$OMP THREADPRIVATE(dyn3d_ctx_name, dyn3d_ctx_handle) INTERFACE writefield_dyn_u MODULE PROCEDURE writefield_dyn1d_u, writefield_dyn2d_u END INTERFACE writefield_dyn_u INTERFACE writefield_dyn_v MODULE PROCEDURE writefield_dyn1d_v, writefield_dyn2d_v END INTERFACE writefield_dyn_v REAL, ALLOCATABLE, SAVE :: NewField_U(:,:,:), NewField_V(:,:,:) CONTAINS SUBROUTINE xios_dyn3dmem_init(xios_cal_type, anref, moisref, jourref,heureref, an, mois, jour, heure, zdtvr) USE comgeom_mod_h USE comvert_mod, ONLY: presnivs USE parallel_lmdz USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h IMPLICIT NONE TYPE(xios_duration) :: tstep_xios TYPE(xios_date) :: start_date TYPE(xios_date) :: time_origin INTEGER :: an, mois, jour REAL :: heure CHARACTER (len=10) :: xios_cal_type INTEGER :: anref, moisref, jourref REAL :: heureref REAL :: zdtvr TYPE(xios_domain) :: dom_grid_U, dom_grid_V, dom_grid_T REAL :: rlong(iip1), rlat(jjp1) REAL :: pi INTEGER :: ii, jj, jjb, jje, jjn ! WRITE(*,*)'Entree mod_xios_dyn3dmem' ! 0 Initialisations pi = 4. * ATAN (1.) ! allocation of fields passed to xios !$OMP BARRIER !$OMP MASTER allocate(NewField_U(iip1, jj_begin:jj_end, llm)) allocate(NewField_V(iip1, jj_begin:jj_end, llm)) !$OMP END MASTER !$OMP BARRIER ! 1 Context initialisation !$OMP MASTER CALL xios_context_initialize(dyn3d_ctx_name, g_comm) CALL xios_get_handle(dyn3d_ctx_name, dyn3d_ctx_handle) CALL xios_set_current_context(dyn3d_ctx_handle) ! WRITE(*,*)'apres context initialisation mod_xios_dyn3dmem' ! 2 calendar stuff tstep_xios%second=zdtvr CALL xios_define_calendar(type=xios_cal_type, start_date=xios_date(an, mois, jour,INT(heure),0,0), & time_origin=xios_date(anref,moisref,jourref,INT(heureref),0,0), timestep=tstep_xios) ! WRITE(*,*)'apres calendrier mod_xios_dyn3dmem' ! 3 domain / grids / axis ! Domains: rlong(:) = rlonu(:) * 180. / pi rlat(:) = rlatu(:) * 180. / pi CALL xios_set_domain_attr("domain_U", ni_glo=iip1, nj_glo=jjp1, & type="rectilinear",ibegin=0, ni=iip1, jbegin=jj_begin-1, nj=jj_nb, & data_dim = 2, lonvalue_1d=rlong(1:iip1), latvalue_1d=rlat(jj_begin:jj_end)) jjb=jj_begin jje=jj_end jjn=jj_nb IF (pole_sud) jjn=jjn-1 IF (pole_sud) jje=jje-1 rlong(:) = rlonv(:) * 180. / pi do jj = jjb, jje rlat(jj) = rlatv(jj) * 180. / pi enddo CALL xios_set_domain_attr("domain_V", ni_glo=iip1, nj_glo=jjm, & type="rectilinear",ibegin=0, ni=iip1, jbegin=jj_begin-1, nj=jjn, & data_dim = 2, lonvalue_1d=rlong(1:iip1), latvalue_1d=rlat(jjb:jje)) rlong(:) = rlonv(:) * 180. / pi rlat(:) = rlatu(:) * 180. / pi CALL xios_set_domain_attr("domain_T", ni_glo=iip1, nj_glo=jjp1, & type="rectilinear",ibegin=0, ni=iip1, jbegin=jj_begin-1, nj=jj_nb, & data_dim = 2, lonvalue_1d=rlong(1:iip1), latvalue_1d=rlat(jj_begin:jj_end)) ! WRITE(*,*)'apres domaine mod_xios_dyn3dmem' ! Vertical axis CALL xios_set_axis_attr("presnivs",n_glo=llm,value=presnivs) ! WRITE(*,*)'apres vertical axis mod_xios_dyn3dmem' ! 4 end of context definition CALL xios_close_context_definition() ! WRITE(*,*)'apres close context init. axis mod_xios_dyn3dmem' !$OMP END MASTER END SUBROUTINE xios_dyn3dmem_init SUBROUTINE writefield_dyn1d_u(name,Field) USE parallel_lmdz USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h IMPLICIT NONE CHARACTER(LEN=*) :: name REAL, DIMENSION(ij_begin:ij_end) :: Field REAL, DIMENSION(iip1, jj_begin:jj_end) :: NewField LOGICAL,SAVE :: debuglf=.true. !$OMP THREADPRIVATE(debuglf) NewField(:,jj_begin:jj_end)=reshape(Field(ij_begin:ij_end),(/iip1,jj_nb/)) !$OMP BARRIER !$OMP MASTER CALL xios_send_field(name, NewField) !$OMP END MASTER END SUBROUTINE writefield_dyn1d_u SUBROUTINE writefield_dyn2d_u(name,Field) USE parallel_lmdz USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h IMPLICIT NONE CHARACTER(LEN=*) :: name REAL, DIMENSION(ij_begin:ij_end,llm) :: Field ! REAL, ALLOCATABLE, SAVE :: NewField(:,:,:) INTEGER :: i,j,l, count !!!!!$OMP BARRIER !!!!!$OMP MASTER !!!! allocate(NewField(iip1, jj_begin:jj_end, llm)) !!!!!$OMP END MASTER !!!!!$OMP BARRIER !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, llm NewField_U(:,jj_begin:jj_end,l)=reshape(Field(ij_begin:ij_end,l),(/iip1,jj_nb/)) ENDDO !$OMP ENDDO !$OMP BARRIER !$OMP MASTER CALL xios_send_field(name, NewField_U) !!!! DEALLOCATE(NewField) !$OMP END MASTER !$OMP BARRIER END SUBROUTINE writefield_dyn2d_u SUBROUTINE writefield_dyn1d_v(name,Field) USE parallel_lmdz USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h IMPLICIT NONE CHARACTER(LEN=*) :: name REAL, DIMENSION(ij_begin:ij_end) :: Field REAL, DIMENSION(iip1, jj_begin:jj_end) :: NewField INTEGER :: jje, ije, jjn IF (pole_sud) THEN jje=jj_end-1 ije=ij_end-iip1 jjn=jj_nb-1 ELSE jje=jj_end ije=ij_end jjn=jj_nb ENDIF NewField(:,jj_begin:jje)=reshape(Field(ij_begin:ije),(/iip1,jjn/)) !$OMP BARRIER !$OMP MASTER CALL xios_send_field(name, NewField(:,jj_begin:jje)) !$OMP END MASTER END SUBROUTINE writefield_dyn1d_v SUBROUTINE writefield_dyn2d_v(name,Field) USE parallel_lmdz USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h IMPLICIT NONE CHARACTER(LEN=*) :: name REAL, DIMENSION(ij_begin:ij_end,llm) :: Field !!!! REAL, ALLOCATABLE, SAVE :: NewField(:,:,:) INTEGER :: l, jje, ije, jjn !!!!!$OMP BARRIER !!!!!$OMP MASTER !!!! allocate(NewField(iip1, jj_begin:jj_end,llm)) !!!!!$OMP END MASTER !!!!!$OMP BARRIER IF (pole_sud) THEN jje=jj_end-1 ije=ij_end-iip1 jjn=jj_nb-1 ELSE jje=jj_end ije=ij_end jjn=jj_nb ENDIF !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, llm NewField_V(:,jj_begin:jje,l)=reshape(Field(ij_begin:ije,l),(/iip1,jjn/)) ENDDO !$OMP ENDDO !$OMP BARRIER !$OMP MASTER CALL xios_send_field(name, NewField_V(:,jj_begin:jje,:)) !!!! DEALLOCATE(NewField) !$OMP END MASTER !$OMP BARRIER END SUBROUTINE writefield_dyn2d_v END MODULE mod_xios_dyn3dmem