source: LMDZ5/trunk/libf/phylmd/iniphysiq.F90 @ 2046

! $Id: iniphysiq.F90 1993 2014-03-05 14:38:40Z fhourdin $



SUBROUTINE iniphysiq(ngrid, nlayer, punjours, pdayref, ptimestep, plat, plon, &
    parea, pcu, pcv, prad, pg, pr, pcpp, iflag_phys)
  USE dimphy, ONLY: klev
  USE mod_grid_phy_lmdz, ONLY: klon_glo
  USE mod_phys_lmdz_para, ONLY: klon_omp, klon_omp_begin, klon_omp_end, &
    klon_mpi_begin
  USE comgeomphy, ONLY: airephy, cuphy, cvphy, rlond, rlatd
  USE phyaqua_mod, ONLY: iniaqua
  IMPLICIT NONE

  ! =======================================================================

  ! Initialisation of the physical constants and some positional and
  ! geometrical arrays for the physics


  ! ngrid                 Size of the horizontal grid.
  ! All internal loops are performed on that grid.
  ! nlayer                Number of vertical layers.
  ! pdayref               Day of reference for the simulation

  ! =======================================================================

  ! ym#include "dimensions.h"
  ! ym#include "dimphy.h"
  ! ym#include "comgeomphy.h"
  include "YOMCST.h"
  include "iniprint.h"

  REAL, INTENT (IN) :: prad ! radius of the planet (m)
  REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
  REAL, INTENT (IN) :: pr ! ! reduced gas constant R/mu
  REAL, INTENT (IN) :: pcpp ! specific heat Cp
  REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
  INTEGER, INTENT (IN) :: ngrid ! number of horizontal grid points in the physics
  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
  REAL, INTENT (IN) :: plat(ngrid) ! latitudes of the physics grid
  REAL, INTENT (IN) :: plon(ngrid) ! longitudes of the physics grid
  REAL, INTENT (IN) :: parea(klon_glo) ! area (m2)
  REAL, INTENT (IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
  REAL, INTENT (IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
  INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
  REAL, INTENT (IN) :: ptimestep !physics time step (s)
  INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called

  INTEGER :: ibegin, iend, offset
  CHARACTER (LEN=20) :: modname = 'iniphysiq'
  CHARACTER (LEN=80) :: abort_message

  IF (nlayer/=klev) THEN
    WRITE (lunout, *) 'STOP in ', trim(modname)
    WRITE (lunout, *) 'Problem with dimensions :'
    WRITE (lunout, *) 'nlayer     = ', nlayer
    WRITE (lunout, *) 'klev   = ', klev
    abort_message = ''
    CALL abort_gcm(modname, abort_message, 1)
  END IF

  IF (ngrid/=klon_glo) THEN
    WRITE (lunout, *) 'STOP in ', trim(modname)
    WRITE (lunout, *) 'Problem with dimensions :'
    WRITE (lunout, *) 'ngrid     = ', ngrid
    WRITE (lunout, *) 'klon   = ', klon_glo
    abort_message = ''
    CALL abort_gcm(modname, abort_message, 1)
  END IF

  !$OMP PARALLEL PRIVATE(ibegin,iend) &
  !$OMP          SHARED(parea,pcu,pcv,plon,plat)

  offset = klon_mpi_begin - 1
  airephy(1:klon_omp) = parea(offset+klon_omp_begin:offset+klon_omp_end)
  cuphy(1:klon_omp) = pcu(offset+klon_omp_begin:offset+klon_omp_end)
  cvphy(1:klon_omp) = pcv(offset+klon_omp_begin:offset+klon_omp_end)
  rlond(1:klon_omp) = plon(offset+klon_omp_begin:offset+klon_omp_end)
  rlatd(1:klon_omp) = plat(offset+klon_omp_begin:offset+klon_omp_end)

    ! suphel => initialize some physical constants (orbital parameters,
    !           geoid, gravity, thermodynamical constants, etc.) in the
    !           physics
  CALL suphel

  !$OMP END PARALLEL

    ! check that physical constants set in 'suphel' are coherent
    ! with values set in the dynamics:
  IF (rday/=punjours) THEN
    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
    WRITE (lunout, *) '  in the dynamics punjours=', punjours
    WRITE (lunout, *) '   but in the physics RDAY=', rday
    IF (abs(rday-punjours)>0.01) THEN
        ! stop here if the relative difference is more than 1%
      abort_message = 'length of day discrepancy'
      CALL abort_gcm(modname, abort_message, 1)
    END IF
  END IF
  IF (rg/=pg) THEN
    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
    WRITE (lunout, *) '     in the dynamics pg=', pg
    WRITE (lunout, *) '  but in the physics RG=', rg
    IF (abs(rg-pg)>0.01) THEN
        ! stop here if the relative difference is more than 1%
      abort_message = 'gravity discrepancy'
      CALL abort_gcm(modname, abort_message, 1)
    END IF
  END IF
  IF (ra/=prad) THEN
    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
    WRITE (lunout, *) '   in the dynamics prad=', prad
    WRITE (lunout, *) '  but in the physics RA=', ra
    IF (abs(ra-prad)>0.01) THEN
        ! stop here if the relative difference is more than 1%
      abort_message = 'planet radius discrepancy'
      CALL abort_gcm(modname, abort_message, 1)
    END IF
  END IF
  IF (rd/=pr) THEN
    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
    WRITE (lunout, *) '     in the dynamics pr=', pr
    WRITE (lunout, *) '  but in the physics RD=', rd
    IF (abs(rd-pr)>0.01) THEN
        ! stop here if the relative difference is more than 1%
      abort_message = 'reduced gas constant discrepancy'
      CALL abort_gcm(modname, abort_message, 1)
    END IF
  END IF
  IF (rcpd/=pcpp) THEN
    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
    IF (abs(rcpd-pcpp)>0.01) THEN
        ! stop here if the relative difference is more than 1%
      abort_message = 'specific heat discrepancy'
      CALL abort_gcm(modname, abort_message, 1)
    END IF
  END IF

  ! Additional initializations for aquaplanets
  !$OMP PARALLEL
  IF (iflag_phys>=100) THEN
    CALL iniaqua(klon_omp, rlatd, rlond, iflag_phys)
  END IF
  !$OMP END PARALLEL

  ! RETURN
  ! 9999  CONTINUE
  ! abort_message ='Cette version demande les fichier rnatur.dat
  ! & et surf.def'
  ! CALL abort_gcm (modname,abort_message,1)

END SUBROUTINE iniphysiq