source: LMDZ6/branches/DYNAMICO-conv/libf/phylmd/create_etat0_unstruct.F90 @ 3356

MODULE create_etat0_unstruct_mod






CONTAINS

  SUBROUTINE create_etat0_unstruct
  USE dimphy
#ifdef CPP_XIOS
  USE xios
  USE infotrac_phy
  USE fonte_neige_mod
  USE pbl_surface_mod
  USE phys_state_var_mod
  USE indice_sol_mod
  USE mod_phys_lmdz_para
  IMPLICIT NONE
  INCLUDE 'dimsoil.h'

    REAL,    DIMENSION(klon)                 :: tsol
    REAL,    DIMENSION(klon)                 :: sn
    REAL,    DIMENSION(klon)                 :: rugmer
    REAL,    DIMENSION(klon)                 :: run_off_lic_0
    REAL,    DIMENSION(klon)                 :: lic
    REAL,    DIMENSION(klon)                 :: fder

    REAL,    DIMENSION(klon,nbsrf)           :: qsolsrf, snsrf
    REAL,    DIMENSION(klon,nsoilmx,nbsrf)   :: tsoil
    
    REAL,    DIMENSION(klon_mpi)             :: tsol_mpi, qsol_mpi, zmasq_mpi, lic_mpi
    REAL,    DIMENSION(klon_mpi)             :: zmea_mpi, zstd_mpi, zsig_mpi, zgam_mpi, zthe_mpi

    INTEGER :: ji,j,i
 
    IF (is_omp_master) THEN
      CALL xios_recv_field("ts",tsol_mpi)
      CALL xios_recv_field("qs",qsol_mpi)
      CALL xios_recv_field("mask",zmasq_mpi)
      CALL xios_recv_field("landice",lic_mpi)
      CALL xios_recv_field("zmea",zmea_mpi)
      CALL xios_recv_field("zstd",zstd_mpi)
      CALL xios_recv_field("zsig",zsig_mpi)
      CALL xios_recv_field("zgam",zgam_mpi)
      CALL xios_recv_field("zthe",zthe_mpi)
    ENDIF
    CALL scatter_omp(tsol_mpi,tsol)
    CALL scatter_omp(qsol_mpi,qsol)
    CALL scatter_omp(zmasq_mpi,zmasq)
    CALL scatter_omp(lic_mpi,lic)
    CALL scatter_omp(zmea_mpi,zmea)
    CALL scatter_omp(zstd_mpi,zstd)
    CALL scatter_omp(zsig_mpi,zsig)
    CALL scatter_omp(zgam_mpi,zgam)
    CALL scatter_omp(zthe_mpi,zthe)

    radsol(:)   = 0.0
    rugmer(:) = 0.001
    sn(:)     = 0

    WHERE(qsol(:)<0) qsol(:)=0 
        
    WHERE(   zmasq(:)<EPSFRA) zmasq(:)=0.
    WHERE(1.-zmasq(:)<EPSFRA) zmasq(:)=1.

    pctsrf(:,:) = 0
    pctsrf(:,is_lic)=lic
    WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0. 
    WHERE(zmasq(:)<EPSFRA)         pctsrf(:,is_lic)=0.

    pctsrf(:,is_ter)=zmasq(:)

!--- Adequation with soil/sea mask
    DO ji=1,klon
      IF(zmasq(ji)>EPSFRA) THEN 
        IF(pctsrf(ji,is_lic)>=zmasq(ji)) THEN
          pctsrf(ji,is_lic)=zmasq(ji)
          pctsrf(ji,is_ter)=0.
        ELSE
          pctsrf(ji,is_ter)=zmasq(ji)-pctsrf(ji,is_lic)
          IF(pctsrf(ji,is_ter)<EPSFRA) THEN
            pctsrf(ji,is_ter)=0.
            pctsrf(ji,is_lic)=zmasq(ji)
          END IF 
        END IF 
      END IF 
    END DO 
    
! sub-surface ocean and sea ice (sea ice set to zero for start)
!*******************************************************************************
    pctsrf(:,is_oce)=(1.-zmasq(:))
    WHERE(pctsrf(:,is_oce)<EPSFRA) pctsrf(:,is_oce)=0.
    
    zval(:)=max(0.,zmea-2*zstd(:))
    zpic(:)=zmea+2*zstd(:)
    
!! WARNING    DON'T FORGET FOR LATER
!!ym  IF(couple) pctsrf(:,is_oce)=ocemask_fi(:)
!! 
    
! Init: tsol, qsol, sn, evap, tsoil, rain_fall, snow_fall, solsw, sollw, frugs
!*******************************************************************************
    DO i=1,nbsrf
     ftsol(:,i) = tsol
    END DO
  
    DO i=1,nbsrf
     snsrf(:,i) = sn
    END DO
!albedo SB >>>
!ym error : the sub surface dimension is the third not second
!    falb_dir(:,is_ter,:)=0.08; falb_dir(:,is_lic,:)=0.6
!    falb_dir(:,is_oce,:)=0.5;  falb_dir(:,is_sic,:)=0.6
    falb_dir(:,:,is_ter)=0.08; falb_dir(:,:,is_lic)=0.6
    falb_dir(:,:,is_oce)=0.5;  falb_dir(:,:,is_sic)=0.6

!ym falb_dif has been forgotten, initialize with defaukt value found in phyetat0 or 0 ?
!ym probably the uninitialized value was 0 for standard (regular grid) case
    falb_dif(:,:,:)=0

!albedo SB <<<
    fevap(:,:) = 0.
    DO i=1,nbsrf
     qsolsrf(:,i)=150.
    END DO
 
    DO i=1,nbsrf 
      DO j=1,nsoilmx
        tsoil(:,j,i) = tsol
      END DO
    END DO
 
    rain_fall = 0.; snow_fall = 0.
    solsw = 165.;   sollw = -53.
    t_ancien = 273.15
    u_ancien=0
    v_ancien=0
    q_ancien = 0.
    agesno = 0.

    z0m(:,is_oce) = rugmer(:)

   z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
   z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)

   z0m(:,is_sic) = 0.001
   z0h(:,:)=z0m(:,:)

    fder = 0.0
    clwcon = 0.0
    rnebcon = 0.0
    ratqs = 0.0
    run_off_lic_0 = 0.0 
    rugoro = 0.0

! Before phyredem calling, surface modules and values to be saved in startphy.nc
! are initialized
!*******************************************************************************
    pbl_tke(:,:,:) = 1.e-8 
    zmax0(:) = 40.
    f0(:) = 1.e-5
    sig1(:,:) = 0.
    w01(:,:) = 0.
    wake_deltat(:,:) = 0.
    wake_deltaq(:,:) = 0.
    wake_s(:) = 0.
    wake_cstar(:) = 0.
    wake_fip(:) = 0.
    wake_pe = 0.
    fm_therm = 0.
    entr_therm = 0.
    detr_therm = 0.
    ale_bl = 0.
    ale_bl_trig =0. 
    alp_bl =0.
    CALL fonte_neige_init(run_off_lic_0)
    CALL pbl_surface_init( fder, snsrf, qsolsrf, tsoil )
    CALL phyredem( "startphy.nc" )

#endif
  END SUBROUTINE create_etat0_unstruct


END MODULE create_etat0_unstruct_mod