source: LMDZ6/branches/Portage_acc/libf/dyn3dmem/mod_xios_dyn3dmem.F90 @ 4446

!
! $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
!
!
#ifdef CPP_XIOS

MODULE mod_xios_dyn3dmem

     USE 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 comvert_mod, ONLY: presnivs
     USE parallel_lmdz

     IMPLICIT NONE

     INCLUDE 'dimensions.h'
     INCLUDE "paramet.h"
     INCLUDE 'comgeom.h'

     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
     IMPLICIT NONE
     include 'dimensions.h'
     include 'paramet.h'
     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
     IMPLICIT NONE
     include 'dimensions.h'
     include 'paramet.h'
     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
     IMPLICIT NONE
     include 'dimensions.h'
     include 'paramet.h'
     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
     IMPLICIT NONE
     include 'dimensions.h'
     include 'paramet.h'
     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 
#endif