prep_hor_ocean_field.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
SUBROUTINE prep_hor_ocean_field (DTCO, UG, U, &
                                  o, or, sg, &
                                 hprogram,                       &
                                 hfile,hfiletype,kluout,ounif,   &
                                 hsurf,hncvarname                )
!     #######################################################
!
!!****  *PREP_HOR_OCEAN_FIELD* -reads, interpolates and prepares oceanic fields
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     C. Lebeaupin Brossier
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2008
!!      Modified    07/2012, P. Le Moigne : CMO1D phasing
!!------------------------------------------------------------------
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_ocean_n, ONLY : ocean_t
USE modd_ocean_rel_n, ONLY : ocean_rel_t
USE modd_seaflux_grid_n, ONLY : seaflux_grid_t
!
USE modd_csts,           ONLY : xtt
USE modd_surf_par,       ONLY : xundef
USE modd_ocean_grid,   ONLY : nockmin,nockmax
USE modd_prep,           ONLY : cingrid_type, cinterp_type, xlat_out, xlon_out,&
                                xx_out, xy_out
!
USE modi_prep_ocean_unif
USE modi_prep_ocean_netcdf
USE modi_prep_ocean_ascllv
!
USE modi_hor_interpol
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
TYPE(ocean_t), INTENT(INOUT) :: o
TYPE(ocean_rel_t), INTENT(INOUT) :: or
TYPE(seaflux_grid_t), INTENT(INOUT) :: sg
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=28),  INTENT(IN)  :: hfile     ! file name
 CHARACTER(LEN=6),   INTENT(IN)  :: hfiletype ! file type
INTEGER,            INTENT(IN)  :: kluout    ! logical unit of output listing
LOGICAL,            INTENT(IN)  :: ounif     ! flag for prescribed uniform field
 CHARACTER(LEN=7)                :: hsurf   ! type of field
 CHARACTER(LEN=28),  INTENT(IN), OPTIONAL :: hncvarname!var to read 
!
!
!*      0.2    declarations of local variables
!
REAL, POINTER, DIMENSION(:,:,:)    ::zfieldin!field to interpolate horizontally
REAL, POINTER, DIMENSION(:,:)      ::zfield  !field to interpolate horizontally
REAL, ALLOCATABLE, DIMENSION(:,:,:)::zfieldout!field interpolated horizontally
!
INTEGER                       :: jlev    ! loop on oceanic vertical level
INTEGER                       :: ik1
REAL(KIND=JPRB) :: zhook_handle
!----------------------------------------------------------------------------
!*      1.     Does the field exist?
!
!*      2.     Reading of input  configuration (Grid and interpolation type)
!
IF (lhook) CALL dr_hook('PREP_HOR_OCEAN_FIELD',0,zhook_handle)
!
IF (ounif) THEN
   WRITE(kluout,*) '*****warning*****: you ask for uniform oceanic variables'
   CALL prep_ocean_unif(kluout,hsurf,zfieldin)
ELSE IF (hfiletype=='NETCDF') THEN
   CALL prep_ocean_netcdf(hprogram,hsurf,hfile,hfiletype,kluout,&
                         hncvarname,zfieldin)
ELSE IF (hfiletype=='ASCII') THEN
   WRITE(kluout,*) 'PERSONAL LIB TEST FOR READING ',hfiletype,'file type'
   WRITE(kluout,*) 'ASCII FILE MUST CONTAIN LAT,LON,DEPTH,T,S,U,V'
   CALL prep_ocean_ascllv(dtco, ug, u, &
                          hprogram,hsurf,hfile,kluout,zfieldin)                         
ELSE
  CALL abor1_sfx('PREP_OCEAN_HOR_FIELD: data file type not supported : '//hfiletype)
END IF
!
!-------------------------------------------------------------------------------
!
!*      3.     Horizontal interpolation
!
ALLOCATE(zfieldout(SIZE(sg%XLAT),SIZE(zfieldin,2),SIZE(zfieldin,3)) )
ALLOCATE(zfield(SIZE(zfieldin,1),SIZE(zfieldin,3)))
!
DO jlev=1,SIZE(zfieldin,2)
  zfield(:,:)=zfieldin(:,jlev,:)
  CALL hor_interpol(dtco, u, &
                    kluout,zfield,zfieldout(:,jlev,:))
ENDDO
!
!*      5.     Return to historical variable
!
ik1=nockmin+1
SELECT CASE (hsurf)
  CASE('TEMP_OC') 
    ALLOCATE(o%XSEAT(SIZE(zfieldout,1),nockmin:nockmax))
    ALLOCATE(or%XSEAT_REL(SIZE(zfieldout,1),nockmin:nockmax))
    DO jlev=ik1,nockmax
      o%XSEAT(:,jlev) = zfieldout(:,jlev,1)
      !prevoir interpolation sur la grille verticale si niveau différents
    ENDDO
    o%XSEAT(:,nockmin)=o%XSEAT(:,ik1)
    !
    ! Relaxation Profile = initial profile for the steady regime
    ! Change it for seasonal cycle!! 
    or%XSEAT_REL(:,:) = o%XSEAT(:,:)
    !    
  CASE('SALT_OC') 
    ALLOCATE(o%XSEAS(SIZE(zfieldout,1),nockmin:nockmax))
    ALLOCATE(or%XSEAS_REL(SIZE(zfieldout,1),nockmin:nockmax))
    DO jlev=ik1,nockmax
      o%XSEAS(:,jlev) = zfieldout(:,jlev,1)
    ENDDO
    o%XSEAS(:,nockmin)=o%XSEAS(:,ik1)
    !
    ! Relaxation Profile = initial profile for the steady regime
    ! Change it for seasonal cycle!! 
    or%XSEAS_REL(:,:) = o%XSEAS(:,:)
    !    
  CASE('UCUR_OC') 
    ALLOCATE(o%XSEAU(SIZE(zfieldout,1),nockmin:nockmax))
    ALLOCATE(or%XSEAU_REL(SIZE(zfieldout,1),nockmin:nockmax))
    DO jlev=ik1,nockmax
      o%XSEAU(:,jlev) = zfieldout(:,jlev,1)
    ENDDO
    o%XSEAU(:,nockmin)=o%XSEAU(:,ik1)
    ! 
    IF (.NOT.o%LCURRENT) o%XSEAU(:,:)=0.
    !
    or%XSEAU_REL(:,:) = o%XSEAU(:,:)
    !
  CASE('VCUR_OC') 
    ALLOCATE(o%XSEAV(SIZE(zfieldout,1),nockmin:nockmax))
    ALLOCATE(or%XSEAV_REL(SIZE(zfieldout,1),nockmin:nockmax))
    DO jlev=ik1,nockmax
      o%XSEAV(:,jlev) = zfieldout(:,jlev,1)
    ENDDO
    o%XSEAV(:,nockmin)=o%XSEAV(:,ik1)    
    !
    IF (.NOT.o%LCURRENT) o%XSEAV(:,:)=0.
    !
    or%XSEAV_REL(:,:) = o%XSEAV(:,:)
    !
END SELECT
!
!------------------------------------------------------------------------------
!
!*      6.     Deallocations
!
DEALLOCATE(zfield   )
DEALLOCATE(zfieldout)
IF (lhook) CALL dr_hook('PREP_HOR_OCEAN_FIELD',1,zhook_handle)
!
END SUBROUTINE prep_hor_ocean_field