conf_dat_m.F90

Go to the documentation of this file.

MODULE conf_dat_m
!
!*******************************************************************************

  PRIVATE
  PUBLIC :: conf_dat2d, conf_dat3d


CONTAINS


!-------------------------------------------------------------------------------
!
SUBROUTINE conf_dat2d(title, xd, yd, xf, yf, champd, interbar)
!
!-------------------------------------------------------------------------------
! Author: P. Le Van
!-------------------------------------------------------------------------------
! Purpose: Configure the 2D data field "champd" so that:
!     - Longitudes are in [ -pi     pi   ]
!     - Latitudes  are in [  pi/2. -pi/2 ]
!  * xd / yd are initial lon / lats.
!  * xf / yf are output  lon / lats, possibly modified to satisfy configuration.
!  * interbar is TRUE for barycentric interpolation.
!-------------------------------------------------------------------------------
  USE assert_eq_m, ONLY: assert_eq
  IMPLICIT NONE
!-------------------------------------------------------------------------------
! Arguments:
  CHARACTER(LEN=*), INTENT(IN)    :: title
  REAL,             INTENT(IN)    :: xd(:), yd(:)  ! dim (lons) (lats)
  REAL,             INTENT(INOUT) :: xf(:), yf(:)  ! dim (lons) (lats)
  REAL,             INTENT(INOUT) :: champd(:,:)   ! dim (lons,lats)
  LOGICAL,          INTENT(IN)    :: interbar
!-------------------------------------------------------------------------------
! Local variables:
  CHARACTER(LEN=256) :: modname="conf_dat2d"
  INTEGER :: i, j, ip180, ind, lons, lats
  LOGICAL :: radlon, invlon ,radlat, invlat
  REAL    :: pi, pis2, depi, rlatmin, rlatmax, oldxd1
  REAL, ALLOCATABLE :: xtemp(:) , ytemp(:), champf(:,:)
!-------------------------------------------------------------------------------
  lons=assert_eq(SIZE(xd),SIZE(xf),SIZE(champd,1),trim(modname)//" lons")
  lats=assert_eq(SIZE(yd),SIZE(yf),SIZE(champd,2),trim(modname)//" lats")
  ALLOCATE(xtemp(lons),ytemp(lats)); xtemp(:)=xd(:); ytemp(:)=yd(:)
  ALLOCATE(champf(lons,lats))
  pi = 2. * asin(1.) 
  pis2 = pi/2.
  depi = 2. * pi
  radlon=.false.; invlon=.false.
  IF     (xtemp(1)>=-pi-0.5.AND.xtemp(lons)<=  pi+0.5) THEN
    radlon = .true.;  invlon = .false.
  ELSE IF(xtemp(1)>=   -0.5.AND.xtemp(lons)<=depi+0.5) THEN
    radlon = .true.;  invlon = .true.
  ELSE IF(xtemp(1)>= -180.5.AND.xtemp(lons)<=   180.5) THEN
    radlon = .false.; invlon = .false.
  ELSE IF(xtemp(1)>=   -0.5.AND.xtemp(lons)<=   360.5) THEN
    radlon = .false.; invlon = .true.
  else; WRITE(6,*) 'Problems with data longitudes for file '//trim(title)
  END IF
  invlat = ytemp(1)<ytemp(lats)
  rlatmin = min( ytemp(1), ytemp(lats) )
  rlatmax = max( ytemp(1), ytemp(lats) )
      
  IF     (rlatmin>=-pis2-0.5.AND.rlatmax<=pis2+0.5) then; radlat = .true.
  ELSE IF(rlatmin>= -90.-0.5.AND.rlatmax<= 90.+0.5) then; radlat = .false.
  else; WRITE(6,*) 'Problems with data latitudes for file '//trim(title)
  END IF

  IF(.NOT.radlon) xtemp(:)=xtemp(:)*pi/180.
  IF(.NOT.radlat) ytemp(:)=ytemp(:)*pi/180.

!--- FLIPPED LONGITUDES
  IF(invlon) THEN
    champf(:,:)=champd(:,:); xf(:)=xtemp(:)

  !--- Longitudes rotated to get them in [ -pi pi] interval.
    DO i=1,lons;      IF(xf(i)>pi) exit;                   end do; ip180 = i
    DO i=1,lons;      IF(xf(i)>pi) xf(i)=xf(i)-depi;       END DO
    DO i= ip180,lons; ind=i-ip180+1; xtemp(ind)=xf(i);     END DO
    DO i= ind+1,lons;                xtemp(i  )=xf(i-ind); END DO

  !--- Longitudes rotated in champf
    DO j=1,lats
      DO i=ip180,lons; ind=i-ip180+1; champd(ind,j)=champf(i    ,j); END DO
      DO i=ind+1,lons;                champd(i  ,j)=champf(i-ind,j); END DO
    END DO
  END IF

!--- FLIPPED LATITUDES
  IF(invlat) THEN
    yf(:)=ytemp(:)
    champf(:,:)=champd(:,:)
    ytemp(lats:1:-1)=yf(:)
    DO j=1,lats; champd(:,lats-j+1)=champf(:,j); END DO
  END IF

!--- FOR BARYCENTRIC INTERPOLATION
  IF(interbar) THEN
    oldxd1 = xtemp(1)
    xtemp(1:lons-1)=0.5*(xtemp(1:lons-1)+xtemp(2:lons))
    xtemp(  lons  )=0.5*(xtemp(  lons  )+oldxd1+depi)
    ytemp(1:lats-1)=0.5*(ytemp(1:lats-1)+ytemp(2:lats))
  END IF
  DEALLOCATE(champf)
  xf(:)=xtemp(:); DEALLOCATE(xtemp)
  yf(:)=ytemp(:); DEALLOCATE(ytemp)

END SUBROUTINE conf_dat2d
!
!-------------------------------------------------------------------------------


!-------------------------------------------------------------------------------
!
SUBROUTINE conf_dat3d(title, xd, yd, zd, xf, yf, zf, champd, interbar)
!
!-------------------------------------------------------------------------------
! Author: P. Le Van
!-------------------------------------------------------------------------------
! Purpose: Configure the 3D data field "champd" so that:
!     - Longitudes are in [ -pi     pi   ]
!     - Latitudes  are in [  pi/2. -pi/2 ]
!     - Vertical levels from ground to model top (in Pascals)
!  * xd / yd are initial lon / lats.
!  * xf / yf are output  lon / lats, possibly modified to satisfy configuration.
!  * zf      are output pressures
!  * interbar is TRUE for barycentric interpolation.
!-------------------------------------------------------------------------------
  USE assert_eq_m, ONLY: assert_eq
  IMPLICIT NONE
!-------------------------------------------------------------------------------
! Arguments:
  CHARACTER(LEN=*), INTENT(IN)    :: title
  REAL,             INTENT(IN)    :: xd(:), yd(:), zd(:) ! (lons) (lats) (levs)
  REAL,             INTENT(INOUT) :: xf(:), yf(:), zf(:) ! (lons) (lats) (levs)
  REAL,             INTENT(INOUT) :: champd(:,:,:)       ! (lons,lats,levs)
  LOGICAL,          INTENT(IN)    :: interbar
!-------------------------------------------------------------------------------
! Local variables:
  CHARACTER(LEN=256) :: modname="conf_dat3d"
  INTEGER :: i, j, l, ip180, ind, lons, lats, levs
  LOGICAL :: radlon, invlon ,radlat, invlat, invlev
  REAL    :: pi, pis2, depi, presmax, rlatmin, rlatmax, oldxd1
  REAL, ALLOCATABLE :: xtemp(:) , ytemp(:), ztemp(:), champf(:,:,:)
!-------------------------------------------------------------------------------
  lons=assert_eq(SIZE(xd),SIZE(xf),SIZE(champd,1),trim(modname)//" lons")
  lats=assert_eq(SIZE(yd),SIZE(yf),SIZE(champd,2),trim(modname)//" lats")
  levs=assert_eq(SIZE(zd),SIZE(zf),SIZE(champd,3),trim(modname)//" levs")
  ALLOCATE(xtemp(lons),ytemp(lats),ztemp(levs),champf(lons,lats,levs))
  xtemp(:)=xd(:); ytemp(:)=yd(:); ztemp(:)=zd(:)
  pi = 2. * asin(1.) 
  pis2 = pi/2.
  depi = 2. * pi
  radlon=.false.; invlon=.false.
  IF     (xtemp(1)>=-pi-0.5.AND.xtemp(lons)<=  pi+0.5) THEN
    radlon = .true.;  invlon = .false.
  ELSE IF(xtemp(1)>=   -0.5.AND.xtemp(lons)<=depi+0.5) THEN
    radlon = .true.;  invlon = .true.
  ELSE IF(xtemp(1)>= -180.5.AND.xtemp(lons)<=   180.5) THEN
    radlon = .false.; invlon = .false.
  ELSE IF(xtemp(1)>=   -0.5.AND.xtemp(lons)<=   360.5) THEN
    radlon = .false.; invlon = .true.
  else; WRITE(6,*) 'Problems with data longitudes for file '//trim(title)
  END IF
  invlat = ytemp(1)<ytemp(lats)
  rlatmin = min( ytemp(1), ytemp(lats) )
  rlatmax = max( ytemp(1), ytemp(lats) )
      
  IF     (rlatmin>=-pis2-0.5.AND.rlatmax<=pis2+0.5) then; radlat = .true.
  ELSE IF(rlatmin>= -90.-0.5.AND.rlatmax<= 90.+0.5) then; radlat = .false.
  else; WRITE(6,*) 'Problems with data latitudes for file '//trim(title)
  END IF

  IF(.NOT.radlon) xtemp(:)=xtemp(:)*pi/180.
  IF(.NOT.radlat) ytemp(:)=ytemp(:)*pi/180.

!--- FLIPPED LONGITUDES
  IF(invlon) THEN
    champf(:,:,:)=champd(:,:,:); xf(:)=xtemp(:)

  !--- Longitudes rotated to get them in [ -pi pi] interval.
    DO i=1,lons;      IF(xf(i)>pi) exit;                   end do; ip180 = i
    DO i=1,lons;      IF(xf(i)>pi) xf(i)=xf(i)-depi;       END DO
    DO i= ip180,lons; ind=i-ip180+1; xtemp(ind)=xf(i);     END DO
    DO i= ind+1,lons;                xtemp(i  )=xf(i-ind); END DO

  !--- Longitudes rotated in champf
    DO l=1,levs
    DO j=1,lats
      DO i=ip180,lons; ind=i-ip180+1; champd(ind,j,l)=champf(i    ,j,l); END DO
      DO i=ind+1,lons;                champd(i  ,j,l)=champf(i-ind,j,l); END DO
    END DO
    END DO
  END IF

!--- FLIPPED LATITUDES
  IF(invlat) THEN
    yf(:)=ytemp(:)
    champf(:,:,:)=champd(:,:,:)
    ytemp(lats:1:-1)=yf(:)
    DO l=1,levs
      DO j=1,lats; champd(:,lats-j+1,l)=champf(:,j,l); END DO
    END DO
  END IF

!--- FOR BARYCENTRIC INTERPOLATION
  IF(interbar) THEN
    oldxd1 = xtemp(1)
    xtemp(1:lons-1)=0.5*(xtemp(1:lons-1)+xtemp(2:lons))
    xtemp(  lons  )=0.5*(xtemp(  lons  )+oldxd1+depi)
    ytemp(1:lats-1)=0.5*(ytemp(1:lats-1)+ytemp(2:lats))
  END IF

!--- FLIPPED LEVELS
  invlev=ztemp(1)<ztemp(levs)
  IF(max(ztemp(1),ztemp(levs))<1200.) ztemp(:)=ztemp(:)*100.
  IF(invlev) THEN
    zf(:)=ztemp(:)
    champf(:,:,:)=champd(:,:,:)
    ztemp(levs:1:-1)=zf(:)
    DO l=1,levs; champd(:,:,levs+1-l)=champf(:,:,l); END DO
  END IF

  DEALLOCATE(champf)
  xf(:)=xtemp(:); DEALLOCATE(xtemp)
  yf(:)=ytemp(:); DEALLOCATE(ytemp)
  zf(:)=ztemp(:); DEALLOCATE(ztemp)

END SUBROUTINE conf_dat3d
!
!-------------------------------------------------------------------------------

END MODULE conf_dat_m