allocate_field_mod.f90 Source File

MODULE allocate_field_mod
  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
  USE paramet_mod_h

  IMPLICIT NONE; PRIVATE
  PUBLIC allocate_u, switch_u, switch_v, allocate_v, allocate2d_u, allocate2d_v, &
          switch2d_u, switch2d_v, init_nan

  INTERFACE allocate_u
    MODULE PROCEDURE allocate1d_u1d,allocate2d_u1d,allocate3d_u1d
  END INTERFACE allocate_u

  INTERFACE switch_u
    MODULE PROCEDURE switch1d_u1d,switch2d_u1d,switch3d_u1d
  END INTERFACE switch_u

  INTERFACE switch_v
    MODULE PROCEDURE switch1d_v1d,switch2d_v1d,switch3d_v1d
  END INTERFACE switch_v

  INTERFACE allocate_v
    MODULE PROCEDURE allocate1d_v1d,allocate2d_v1d,allocate3d_v1d
  END INTERFACE allocate_v

  INTERFACE allocate2d_u
    MODULE PROCEDURE allocate1d_u2d,allocate2d_u2d,allocate3d_u2d
  END INTERFACE allocate2d_u

  INTERFACE allocate2d_v
    MODULE PROCEDURE allocate1d_v2d,allocate2d_v2d,allocate3d_v2d
  END INTERFACE allocate2d_v

  INTERFACE switch2d_u
    MODULE PROCEDURE switch1d_u2d,switch2d_u2d,switch3d_u2d
  END INTERFACE switch2d_u

  INTERFACE switch2d_v
    MODULE PROCEDURE switch1d_v2d,switch2d_v2d,switch3d_v2d
  END INTERFACE switch2D_v

  REAL :: nan

CONTAINS

  SUBROUTINE Init_nan
  IMPLICIT NONE
    REAL*8 :: rnan
    INTEGER :: inan(2)
    EQUIVALENCE(rnan,inan)
    
    inan(1)=2147483647
    inan(2)=2147483647
    
    nan=rnan
  
  END SUBROUTINE Init_nan

  SUBROUTINE allocate1d_u1d(field,d)
  USE parallel_lmdz
  IMPLICIT NONE
  REAL,POINTER :: field(:)
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(d%ijb_u:d%ije_u))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate1d_u1d


  SUBROUTINE allocate2d_u1d(field,dim1,d)
  USE parallel_lmdz
  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  INTEGER      :: dim1
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(d%ijb_u:d%ije_u,dim1))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate2d_u1d 

  SUBROUTINE allocate3d_u1d(field,dim1,dim2,d)
  USE parallel_lmdz
  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  INTEGER      :: dim1,dim2
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(d%ijb_u:d%ije_u,dim1,dim2))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate3d_u1d   



  SUBROUTINE allocate1d_v1d(field,d)
  USE parallel_lmdz
  IMPLICIT NONE
  REAL,POINTER :: field(:)
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(d%ijb_v:d%ije_v))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate1d_v1d


  SUBROUTINE allocate2d_v1d(field,dim1,d)
  USE parallel_lmdz
  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  INTEGER      :: dim1
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(d%ijb_v:d%ije_v,dim1))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate2d_v1d 

  SUBROUTINE allocate3d_v1d(field,dim1,dim2,d)
  USE parallel_lmdz
  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  INTEGER      :: dim1,dim2
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(d%ijb_v:d%ije_v,dim1,dim2))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate3d_v1d   









  SUBROUTINE allocate1d_u2d(field,d)
  USE parallel_lmdz
  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(iip1,d%jjb_u:d%jje_u))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate1d_u2d


  SUBROUTINE allocate2d_u2d(field,dim1,d)
  USE parallel_lmdz

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  INTEGER      :: dim1
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(iip1,d%jjb_u:d%jje_u,dim1))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate2d_u2d

  SUBROUTINE allocate3d_u2d(field,dim1,dim2,d)
  USE parallel_lmdz

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:,:)
  INTEGER      :: dim1,dim2
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(iip1,d%jjb_u:d%jje_u,dim1,dim2))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate3d_u2d   



  SUBROUTINE allocate1d_v2d(field,d)
  USE parallel_lmdz

  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(iip1,d%jjb_v:d%jje_v))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate1d_v2d


  SUBROUTINE allocate2d_v2d(field,dim1,d)
  USE parallel_lmdz

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  INTEGER      :: dim1
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(iip1,d%jjb_v:d%jje_v,dim1))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate2d_v2d

  SUBROUTINE allocate3d_v2d(field,dim1,dim2,d)
  USE parallel_lmdz

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:,:)
  INTEGER      :: dim1,dim2
  TYPE(distrib),INTENT(IN) :: d

!$OMP BARRIER
!$OMP MASTER    
    IF (ASSOCIATED(field)) DEALLOCATE(field)
    ALLOCATE(field(iip1,d%jjb_v:d%jje_v,dim1,dim2))
!$OMP END MASTER
!$OMP BARRIER

  END SUBROUTINE allocate3d_v2d   



















  SUBROUTINE switch1d_u1d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo
  IMPLICIT NONE
  REAL,POINTER :: field(:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down
  
  REAL,POINTER,SAVE :: new_field(:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(new_dist%ijb_u:new_dist%ije_u))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField_u(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
   
    CALL barrier
  END SUBROUTINE switch1d_u1d  
  
  SUBROUTINE switch2d_u1d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo
  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(new_dist%ijb_u:new_dist%ije_u,size(field,2)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField_u(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch2d_u1d  

  SUBROUTINE switch3d_u1d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo
  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(new_dist%ijb_u:new_dist%ije_u,size(field,2),size(field,3)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField_u(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch3d_u1d  




  SUBROUTINE switch1d_v1d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo
  IMPLICIT NONE
  REAL,POINTER :: field(:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(new_dist%ijb_v:new_dist%ije_v))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField_v(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER

    CALL barrier
  END SUBROUTINE switch1d_v1d  
  
  SUBROUTINE switch2d_v1d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo
  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(new_dist%ijb_v:new_dist%ije_v,size(field,2)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField_v(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch2d_v1d  

  SUBROUTINE switch3d_v1d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo
  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(new_dist%ijb_v:new_dist%ije_v,size(field,2),size(field,3)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField_v(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch3d_v1d  












  SUBROUTINE switch1d_u2d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo

  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(iip1,new_dist%jjb_u:new_dist%jje_u))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField2d_u(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch1d_u2d  
  
  SUBROUTINE switch2d_u2d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(iip1,new_dist%jjb_u:new_dist%jje_u,size(field,3)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField2d_u(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch2d_u2d  

  SUBROUTINE switch3d_u2d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:,:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(iip1,new_dist%jjb_u:new_dist%jje_u,size(field,3),size(field,4)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField2d_u(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch3d_u2d  




  SUBROUTINE switch1d_v2d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo

  IMPLICIT NONE
  REAL,POINTER :: field(:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(iip1,new_dist%jjb_v:new_dist%jje_v))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField2d_v(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER
    CALL barrier

  END SUBROUTINE switch1d_v2d  
  
  SUBROUTINE switch2d_v2d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(iip1,new_dist%jjb_v:new_dist%jje_v,size(field,3)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField2d_v(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER

    CALL barrier
  END SUBROUTINE switch2d_v2d  

  SUBROUTINE switch3d_v2d(field,old_dist,new_dist,up,down)
  USE parallel_lmdz
  USE mod_hallo

  IMPLICIT NONE
  REAL,POINTER :: field(:,:,:,:)
  TYPE(distrib),INTENT(IN) :: old_dist
  TYPE(distrib),INTENT(IN) :: new_dist
  INTEGER, OPTIONAL,INTENT(IN) :: up
  INTEGER, OPTIONAL,INTENT(IN) :: down

  REAL,POINTER,SAVE :: new_field(:,:,:,:)
  TYPE(request) :: req
  
  !$OMP BARRIER
  !$OMP MASTER    
    ALLOCATE(new_field(iip1,new_dist%jjb_v:new_dist%jje_v,size(field,3),size(field,4)))
    new_field=nan
  !$OMP END MASTER
  !$OMP BARRIER
    CALL Register_SwapField2d_v(field,new_field,new_dist,req,old_dist=old_dist,up=up,down=down)
  
    CALL SendRequest(req)

  !$OMP BARRIER
    CALL WaitRequest(req)     
  !$OMP BARRIER
    
  !$OMP MASTER
    DEALLOCATE(field)
    field=>new_field
  !$OMP END MASTER
  !$OMP BARRIER

    CALL barrier
  END SUBROUTINE switch3d_v2d 

END MODULE allocate_field_mod