source: LMDZ5/branches/testing/libf/phylmd/iniphysiq.F90 @ 1999

Last change on this file since 1999 was 1999, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes r1920:1997 into testing branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1
2! $Id: iniphysiq.F90 1999 2014-03-20 09:57:19Z fairhead $
3
4
5
6SUBROUTINE iniphysiq(ngrid, nlayer, punjours, pdayref, ptimestep, plat, plon, &
7    parea, pcu, pcv, prad, pg, pr, pcpp, iflag_phys)
8  USE dimphy, ONLY: klev
9  USE mod_grid_phy_lmdz, ONLY: klon_glo
10  USE mod_phys_lmdz_para, ONLY: klon_omp, klon_omp_begin, klon_omp_end, &
11    klon_mpi_begin
12  USE comgeomphy, ONLY: airephy, cuphy, cvphy, rlond, rlatd
13  USE phyaqua_mod, ONLY: iniaqua
14  IMPLICIT NONE
15
16  ! =======================================================================
17
18  ! Initialisation of the physical constants and some positional and
19  ! geometrical arrays for the physics
20
21
22  ! ngrid                 Size of the horizontal grid.
23  ! All internal loops are performed on that grid.
24  ! nlayer                Number of vertical layers.
25  ! pdayref               Day of reference for the simulation
26
27  ! =======================================================================
28
29  ! ym#include "dimensions.h"
30  ! ym#include "dimphy.h"
31  ! ym#include "comgeomphy.h"
32  include "YOMCST.h"
33  include "iniprint.h"
34
35  REAL, INTENT (IN) :: prad ! radius of the planet (m)
36  REAL, INTENT (IN) :: pg ! gravitational acceleration (m/s2)
37  REAL, INTENT (IN) :: pr ! ! reduced gas constant R/mu
38  REAL, INTENT (IN) :: pcpp ! specific heat Cp
39  REAL, INTENT (IN) :: punjours ! length (in s) of a standard day
40  INTEGER, INTENT (IN) :: ngrid ! number of horizontal grid points in the physics
41  INTEGER, INTENT (IN) :: nlayer ! number of atmospheric layers
42  REAL, INTENT (IN) :: plat(ngrid) ! latitudes of the physics grid
43  REAL, INTENT (IN) :: plon(ngrid) ! longitudes of the physics grid
44  REAL, INTENT (IN) :: parea(klon_glo) ! area (m2)
45  REAL, INTENT (IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
46  REAL, INTENT (IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
47  INTEGER, INTENT (IN) :: pdayref ! reference day of for the simulation
48  REAL, INTENT (IN) :: ptimestep !physics time step (s)
49  INTEGER, INTENT (IN) :: iflag_phys ! type of physics to be called
50
51  INTEGER :: ibegin, iend, offset
52  CHARACTER (LEN=20) :: modname = 'iniphysiq'
53  CHARACTER (LEN=80) :: abort_message
54
55  IF (nlayer/=klev) THEN
56    WRITE (lunout, *) 'STOP in ', trim(modname)
57    WRITE (lunout, *) 'Problem with dimensions :'
58    WRITE (lunout, *) 'nlayer     = ', nlayer
59    WRITE (lunout, *) 'klev   = ', klev
60    abort_message = ''
61    CALL abort_gcm(modname, abort_message, 1)
62  END IF
63
64  IF (ngrid/=klon_glo) THEN
65    WRITE (lunout, *) 'STOP in ', trim(modname)
66    WRITE (lunout, *) 'Problem with dimensions :'
67    WRITE (lunout, *) 'ngrid     = ', ngrid
68    WRITE (lunout, *) 'klon   = ', klon_glo
69    abort_message = ''
70    CALL abort_gcm(modname, abort_message, 1)
71  END IF
72
73  !$OMP PARALLEL PRIVATE(ibegin,iend) &
74  !$OMP          SHARED(parea,pcu,pcv,plon,plat)
75
76  offset = klon_mpi_begin - 1
77  airephy(1:klon_omp) = parea(offset+klon_omp_begin:offset+klon_omp_end)
78  cuphy(1:klon_omp) = pcu(offset+klon_omp_begin:offset+klon_omp_end)
79  cvphy(1:klon_omp) = pcv(offset+klon_omp_begin:offset+klon_omp_end)
80  rlond(1:klon_omp) = plon(offset+klon_omp_begin:offset+klon_omp_end)
81  rlatd(1:klon_omp) = plat(offset+klon_omp_begin:offset+klon_omp_end)
82
83    ! suphel => initialize some physical constants (orbital parameters,
84    !           geoid, gravity, thermodynamical constants, etc.) in the
85    !           physics
86  CALL suphel
87
88  !$OMP END PARALLEL
89
90    ! check that physical constants set in 'suphel' are coherent
91    ! with values set in the dynamics:
92  IF (rday/=punjours) THEN
93    WRITE (lunout, *) 'iniphysiq: length of day discrepancy!!!'
94    WRITE (lunout, *) '  in the dynamics punjours=', punjours
95    WRITE (lunout, *) '   but in the physics RDAY=', rday
96    IF (abs(rday-punjours)>0.01) THEN
97        ! stop here if the relative difference is more than 1%
98      abort_message = 'length of day discrepancy'
99      CALL abort_gcm(modname, abort_message, 1)
100    END IF
101  END IF
102  IF (rg/=pg) THEN
103    WRITE (lunout, *) 'iniphysiq: gravity discrepancy !!!'
104    WRITE (lunout, *) '     in the dynamics pg=', pg
105    WRITE (lunout, *) '  but in the physics RG=', rg
106    IF (abs(rg-pg)>0.01) THEN
107        ! stop here if the relative difference is more than 1%
108      abort_message = 'gravity discrepancy'
109      CALL abort_gcm(modname, abort_message, 1)
110    END IF
111  END IF
112  IF (ra/=prad) THEN
113    WRITE (lunout, *) 'iniphysiq: planet radius discrepancy !!!'
114    WRITE (lunout, *) '   in the dynamics prad=', prad
115    WRITE (lunout, *) '  but in the physics RA=', ra
116    IF (abs(ra-prad)>0.01) THEN
117        ! stop here if the relative difference is more than 1%
118      abort_message = 'planet radius discrepancy'
119      CALL abort_gcm(modname, abort_message, 1)
120    END IF
121  END IF
122  IF (rd/=pr) THEN
123    WRITE (lunout, *) 'iniphysiq: reduced gas constant discrepancy !!!'
124    WRITE (lunout, *) '     in the dynamics pr=', pr
125    WRITE (lunout, *) '  but in the physics RD=', rd
126    IF (abs(rd-pr)>0.01) THEN
127        ! stop here if the relative difference is more than 1%
128      abort_message = 'reduced gas constant discrepancy'
129      CALL abort_gcm(modname, abort_message, 1)
130    END IF
131  END IF
132  IF (rcpd/=pcpp) THEN
133    WRITE (lunout, *) 'iniphysiq: specific heat discrepancy !!!'
134    WRITE (lunout, *) '     in the dynamics pcpp=', pcpp
135    WRITE (lunout, *) '  but in the physics RCPD=', rcpd
136    IF (abs(rcpd-pcpp)>0.01) THEN
137        ! stop here if the relative difference is more than 1%
138      abort_message = 'specific heat discrepancy'
139      CALL abort_gcm(modname, abort_message, 1)
140    END IF
141  END IF
142
143  ! Additional initializations for aquaplanets
144  !$OMP PARALLEL
145  IF (iflag_phys>=100) THEN
146    CALL iniaqua(klon_omp, rlatd, rlond, iflag_phys)
147  END IF
148  !$OMP END PARALLEL
149
150  ! RETURN
151  ! 9999  CONTINUE
152  ! abort_message ='Cette version demande les fichier rnatur.dat
153  ! & et surf.def'
154  ! CALL abort_gcm (modname,abort_message,1)
155
156END SUBROUTINE iniphysiq
Note: See TracBrowser for help on using the repository browser.